Index: /palm/tags/release-3.4a/DOC/app/chapter_1.0.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_1.0.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_1.0.html (revision 141)
@@ -0,0 +1,69 @@
+
+
+PALM chapter 1.0
+
+1.0
+Introduction
+This documentation wants to
+give
+assistance how to carry out runs with the large eddy simulation
+model PALM.
+It contains
+instructions for
+the installation of the model (chapter
+5.0 ), for the practical execution of application runs (chapter
+3.0 ) and for the steering of the model by parameters (chapter
+4.0 ). New users should first of all read chapters
+2.0 and 3.0
+(up to and including 3.5 ).
+
+This documentation
+does not explain
+the mathematical,
+numerical and physical
+background of large eddy simulation models and it also does not
+provide appropriate meteorological background knowledge. Good
+knowledge concerning this is presupposed and is indispensable for a
+successful application of the model. In addition to this,
+knowledge of the operating system
+Unix, the Queueing
+System (NQS, PBS, Load Leveler, etc.) to generate batch
+jobs,
+the basic functionality of parallel
+computers
+ and the programming language FORTRAN90
+(particularly , if code extensions are to be written by the
+user) are presupposed. Programming user-defined software usually
+requires exact knowledge of the internal model structure. First insight
+herein
+is
+given in chapter
+2.0 and in the technical/numerical
+documentation . The information obtained there is usually not
+sufficient and has to
+be accompanied by
+detailed study of the source code of the model. Additional
+ experience in parallel programming with the
+message passing interface
+(MPI) maybe presupposed.
+A documentation lives on
+criticism and
+suggestions by users. Thi s
+is expressly
+requested. Please contact the PALM group
+(see
+members ).
+The model documentation is regularly maintained and brought up-to-date
+by the PALM group. The date of the last code
+revision is specified at the top of the table of contents of this
+documentation.
+
+
+
+Last change:
+$Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_2.0.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_2.0.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_2.0.html (revision 141)
@@ -0,0 +1,141 @@
+
+
+PALM chapter 2.0
+
+2.0
+Basic techniques of
+the LES model and its parallelization
+LES models
+generally permit the
+simulation of turbulent flows, whereby those eddies, that carry the
+main energy are resolved by the numerical grid. Only the
+effect of such turbulence elements with diameter equal to or smaller
+than the grid spacing are parameterized in the model and
+by so-called subgrid-scale (SGS) transport. Larger structures are
+simulated directly (they are explicitly resolved) and their effects are
+represented by the advection terms.
+PALM is
+based on the
+non-hydrostatic incompressible Boussinesq equations. It contains a
+water cycle with cloud formation and takes into account infrared
+radiative cooling in cloudy conditions. The model has six prognostic
+quantities in total – u,v,w, liquid water potential
+temperature
+Θ l
+ (BETTS,
+1973), total water content q and subgrid-scale turbulent kinetic energy
+e. The
+subgrid-scale turbulence is modeled according to DEARDOFF (1980) and
+requires the solution of an additional prognostic equation for the
+turbulent kinetic energy e. The long wave radiation scheme is based
+on the parametrization of cloud effective emissivity (e.g. Cox, 1976)
+and condensation is considered by a simple '0%-or-100%'-scheme, which
+assumes that within each grid box the air is either entirely
+unsaturated or entirely saturated ( see e.g., CUIJPERS and DUYNKERKE,
+1993). The water cycle is closed by using a simplified version of
+KESSLERs scheme (KESSLER, 1965; 1969) to parameterize precipitation
+processes (MÜLLER and CHLOND, 1996). Incompressibility is
+applied by means of a Poisson equation for pressure, which is solved
+with a direct method (SCHUMANN and SWEET, 1988). The Poisson equation
+is Fourier transformed in both horizontal directions and the
+resulting tridiagonal matrix is solved for the transformed pressure
+which is then transformed back. Alternatively, a multigrid method can
+also be used. Lateral boundary conditions of the model are cyclic and
+MONIN-OBUKHOV similarity is assumed between the surface and the first
+computational grid level above. Alternatively, noncyclic boundary
+conditions
+(Dirichlet/Neumann) can be used along one of the
+horizontal directions. At the lower surface, either temperature/
+humidity or their respective fluxes can be prescribed.
+The
+advection terms
+are treated by the scheme proposed by PIACSEK and WILLIAMS (1970),
+which conserves the integral of linear and quadratic quantities up to
+very small errors. The advection of scalar quantities can optionally
+be performed by the monotone, locally modified version of Botts
+advection scheme (CHLOND, 1994). The time integration is performed
+with the third-order Runge-Kutta scheme. A second-order Runge-Kutta
+scheme, a leapfrog scheme and an Euler scheme are also implemented.
+By default, the time step is
+computed
+with respect to the different criteria (CFL, diffusion) and adapted
+automatically. In case of a non-zero geostrophic
+wind the coordinate system can be moved along with the mean wind in
+order to maximize the time step (Galilei-Transformation).
+In
+principle a model
+run is carried out in the following way: After reading the control
+parameters given by the user, all prognostic variables are
+initialized. Initial values can be e.g. vertical profiles of the
+horizontal wind, calculated using a 1D subset of the 3D prognostic
+equation and are set in the 3D-Model as horizontally homogeneous
+initial values. Temperature profiles can only be prescribed linear
+(with constant gradients, which may change for different vertical
+height intervals) and they are assumed in the 1D-Model as stationary.
+After the initialization phase during which also different kinds of
+disturbances may be imposed to the prognostic fields, the time
+integration begins. Here for each individual time step the prognostic
+equations are successively solved for the velocity components u, v and
+w
+as well as for the potential temperature and possibly for the TKE.
+After the calculation of the boundary values in accordance with the
+given boundary conditions the provisional velocity fields are
+corrected with the help of the pressure solver. Following this, all
+diagnostic turbulence quantities including possible
+Prandtl-layer–quantities are computed. At the end of a time
+step the data output requested by the user is made
+(e.g. statistic of analyses for control purposes or profiles and/or
+graphics data). If the given end-time was reached, binary data maybe
+be saved for restart.
+The
+model is based
+on the originally non-parallel LES model which has been operated at the
+institute since 1989
+and which was parallelized for massively parallel computers with
+distributed memory using the Message-Passing-Standard MPI. It is
+still applicable on a single processor and also well optimized for
+vector machines. The parallelization takes place via a so-called domain
+decomposition, which divides the entire model
+domain into individual, vertically standing cubes, which extend from
+the bottom to the top of the model domain. One processor (processing
+element, PE) is assigned to each cube, which
+accomplishes the computations on all grid points of the subdomain.
+Users can choose between a two- and a one-dimensional domain
+decomposition. A 1D-decomposition is preferred on machines with a
+slow network interconnection. In case of a 1D-decomposition,
+the
+grid points along x direction are
+distributed among the individual processors, but in y- and z-direction
+all respective grid points belong to the same PE.
+The calculation of central
+differences or
+non-local arithmetic operations (e.g. global
+sums, FFT) demands communication and an appropriate data exchange
+between the PEs. As a substantial innovation in relation to
+the non-parallel model version the individual subdomains are
+surrounded by so-called ghost points, which contain the grid point
+information of the neighbor processors. The appropriate grid point
+values must be exchanged after each change (i.e. in particular after
+each time step). For this purpose MPI routines (MPI_SENDRCV )
+are used. For the solution of the FFT conventional (non-parallelized)
+procedures are used. Given that the FFTs are used in x and/or
+y-direction, the data which lie distributed on the individual central
+processing elements, have to be collected and/or relocated before.
+This happens by means of the routine MPI_ALLTOALLV .
+Certain
+global operations like e.g. the search for absolute maxima or minima
+within the 3D-arrays likewise require the employment of special MPI
+routines (MPI_ALLREDUCE ).
+Further details of the
+internal model
+structure are described in the technical/numerical
+documentation .
+
+
+Last
+change: $Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_3.0.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_3.0.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_3.0.html (revision 141)
@@ -0,0 +1,90 @@
+
+
+PALM chapter 3.0
+3.0
+Execution of model runs
+Given that the model was
+installed by the user (look at chapter
+5.0 ) and that it is clear, which phenomenon is to be
+simulated,
+there is a whole set of questions which must be answered before
+executing
+the actual application run, e.g.:
+ How
+large does the model domain have to be and what grid size does
+phenomenon to be simulated require?
+How
+long is the time which should be simulated, i.e. which typical time
+scale does the phenomenon have?
Which
+boundary conditions and initial conditions are to be selected?
+ Which model
+output data are necessary at which points in time, in order to be able
+to analyze the phenomenon afterwards?
+ The answers to
+these questions
+substantially determine the choice of values for the most important
+model parameters, with which the model run is steered. All possible
+parameters are described in chapters 4.1 ,
+4.2
+and 4.3 .
+The basic steering of the model with these parameters is explained in
+the introduction to chapter
+4 . The user will rarely use all model parameters, since many
+are
+preset with consistent default values and therefore do not have to be
+changed by the user. Some of the most important parameters are not
+preset with default values and must be adjusted by the user in each
+case. Such a typical, minimum parameter set is described in chapter
+4.4.1 . For the subsequent analysis of model runs, graphical
+visualization of model data is particularly important. Chapter
+4.5 describes, how such outputs are produced with the model.
+The selected parameters and
+their values
+have to be supplied to the model as an input file. The
+structure of this file is described in the introduction to chapter
+4 . The data, produced by the model, are located in a number
+of
+different output files. The model works with relative file names
+(i.e. without absolute path information). Thus all input and output
+files are
+expected and put in the directory, in which the actual model (the
+executable program created from the FORTRAN source code) is started
+(but also see next paragraph).
+All user-relevant input and output files are described in chapter
+3.4 .
+The actual model (the
+executable
+program) is not started directly via the user, but with the help of
+the shell script mrun ,which
+can be called by the user. This script takes over the entire pre- and
+postprocessing work, which is necessary for a model run. In addition
+to this, it generates e.g. automatically batch jobs for model runs on
+remote computers, provides for the appropriate file transfers of the
+input and output files to these computers, secures data on existing
+archives systems, starts if necessary restart jobs, and much more.
+mrun allows
+to specify
+individual path names for each simulation and
+for the different types of input/output files. The start of model runs
+with mrun is described in chapter
+3.1 .
+The implementation of user
+code
+extensions in
+the model is made possible by a set of defined interfaces. You will
+find references to the programming of such extensions in chapter
+3.5 . Frequently errors arise during the execution of the
+model
+after such changes, which can often be found only by interactive
+model steering and error tracing (debugging), which are described in
+chapter
+3.6 .
+
+
+
Last change:
+$Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_3.1.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_3.1.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_3.1.html (revision 141)
@@ -0,0 +1,117 @@
+
+
+PALM
+chapter 3.1
+
+3.1 Job control with mrun
+The start of model runs in
+principle
+takes place via executing the shell script mrun.
+With this script it is possible to operate the model both
+interactively and in batch mode. Batch operation is possible on the
+local computer as well as on a remote computer (supposed that a batch
+queuing system is available). Here only the batch operation on a remote
+computer is
+described, because this represents the usual mode of operation due to
+the large computing time requirements of the model. The interactive
+execution differs only in some points and is described in chapter
+3.6 .
+By the call of mrun
+ a complete
+batch job is produced, transferred to the user determined remote
+computer
+and submitted to its queuing system (LoadLeveler, PBS, etc.).
+After processing of the job, the so-called job protocol is sent back
+to the local computer of the user (the local computer is the
+computer, on which the user calls mrun ). The
+following actions
+are implemented by the job, amongst other:
+ Change to a
+temporary working directory.
The input
+files
+needed by the model are copied into this directory. These files are
+transferred from the local computer.
+Execute
+the
+model.
Copy the
+output
+files produced by the model into the directories determined by the user
+(these are also allowed to lie on the local computer). Depending on the
+choice of the user, the files may also be saved on an archiving system
+(if existing).
Delete the
+temporary working direction.
Transfer the job protocol to the
+local computer.
+ From this list it
+becomes clear that two
+of the substantial functions of mrun are the supply
+of input
+files for the model and the storage of output files produced by the
+model. The model exclusively works with so-called local files, which
+lie in the temporary working directory created by mrun.
+The
+“local” names of these files are determined by the
+model
+(in the appropriate OPEN instructions). In chapter
+3.4 all possible input and output filenames are specified. In
+contrast to this, the input files, made available by the user,
+usually lie in permanent directories (e.g. in the /home directory) and
+the output data, produced by the model, may also be
+stored there. The directory names are arbitrary. The actual file name
+(without path) of these input and output files is specified by an
+option of mrun . All input and output files of the
+model
+receive this file name (e.g. abcde ), but each
+individual file
+is still provided with an extension (e.g. abcde_par ,
+etc.
+abcde_dat ) - otherwise the files would not be
+distinguishable.
+The linkage of local file names with the names of the permanent
+directories and the file name extensions takes place in a
+configuration file, which mrun expects to find in
+the
+respective current working directory of the user. A detailed
+description of this configuration file - which still offers a variety
+of further functions – is found in the
+documentation of the shell script mrun
+(sorry: this is only available in German, so far. If you think that you
+would profit from an English version, please give a message to the PALM
+group).
+In the next chapter a simple example of a minimum configuration file
+is described.
+A simple call of mrun
+could read
+as follows:
+ mrun -
+h ibmh -d abcde
+ The model is
+started by option -h
+ibmh on the IBM Regatta hanni at the
+HLRN, i.e. on the
+local computer a batch job is generated, transferred to the remote
+computer (IBM) and submitted to a suitable queue of the queuing system.
+With the
+option -d the so-called basis file name (abcde )
+is
+specified, from which, together with the path names and file name
+extensions, the complete file names (including the path) of the
+permanent input and output files are formed.
+ Usually the specification of a set of further options is
+necessary, e.g. the CPU time needed by the model and the memory size
+needed as well as, on parallel computers, the number of processing
+elements which are to be used (options -t , -m
+and
+-X ). A precondition for the call of mrun
+of course is
+that the installation of the model on the local computer and the
+remote machine is complete (see chapter
+5.0 ).
+Beyond these options a variety of further options for model
+steering can be used in the call of mrun . These are
+fully
+described in the mrun
+documentation (in German).
+
+
+Last change: $Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_3.2.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_3.2.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_3.2.html (revision 141)
@@ -0,0 +1,315 @@
+
+
+PALM chapter 3.2
+3.2 Example of a minimum
+configuration
+file
+In this chapter a sample
+configuration
+file is described. It contains only instructions which are really
+necessary for the execution of a simple model run (configuration
+files can be much more complex). The example presented here is stored
+in an appropriate example
+file (containing more than the configuration data presented
+here)
+and can be used, together with the parameter
+file presented in chapter
+4.4.1 , for the execution of a simple model run. In chapter 4.4.1
+the
+complete mrun options which are necessary for the
+appropriate
+parameter file are described. Furthermore not all details of the
+configuration file are described here. Therefore you should take a
+look at the mrun
+documentation (sorry: this is only available in German, so far. If you
+think that you
+would profit from an English version, please give a message to the PALM
+group).
+The following configuration
+data
+exclusively applies to model runs on the IBM Regatta hanni of the
+HLRN when using several processing elements (i.e. for the parallel
+version of the model). The proper installation of the model is
+presumed (see chapter
+5.0 ). Furthermore it is supposed that the user is located in
+the
+directory $HOME/palm/current_version/SOURCE
+on its local computer. There are the FORTRAN source codes of the
+model (*.f90 )
+as
+well as the configuration file (name: .mrun.config )
+and the make file (name: Makefile ).
+The configuration file has the following contents (among other things):
+
+
% source_path $HOME/palm/current_version/SOURCE % mainprog palm.f90 % use_makefile true % fopts -O3:-g:-qrealsize=8:-Q:-q64:-qmaxmem=-1:-qtune=pwr4:-qarch=pwr4:-qnosave:-qnoescape ibmh parallel % lopts -O3:-g:-qrealsize=8:-Q:-q64:-qmaxmem=-1:-qtune=pwr4:-qarch=pwr4:-qnosave:-qnoescape:-lesslsmp ibmh parallel # EC:[[ \$locat = execution]] & & cat RUN_CONTROL # PARIN in:job:npe d3# ~/palm/current_version/JOBS/$fname/INPUT _p3d # RUN_CONTROL out:loc:tr d3# ~/palm/current_version/JOBS/$fname/MONITORING _rc HEADER out:loc:tr d3# ~/palm/current_version/JOBS/$fname/MONITORING _header PLOT1D_PAR out:loc:tr pr# ~/palm/current_version/JOBS/$fname/OUTPUT _pr_par PLOT1D_DATA out:loc:tr pr# ~/palm/current_version/JOBS/$fname/OUTPUT _pr_in
+The first
+five lines specify values of
+so-called environment variables. Such lines begin with a
+“%”-
+sign. After at least one blank the name of the variable (e.g.
+ source_path )
+follows and then seperated by at least one blank the value of the
+variable. Again separated by blank the
+so-called validity domain can be indicated (later more).
+With the first three variables mrun gets to know in
+which
+directory the source code lies ( source_path ),
+the file name of the main program ( mainprog )
+and that the make mechanism
+should be
+used for compiling ( use_makefile
+= true ). mrun
+ needs these information, because
+for each
+model run the executable is created by compiling the source files.
+Normally, only the main program (palm.f90) will be compiled while all
+other object files are just linked. These object files have already
+been created from the source code files during the installation of the
+model
+(see chapter
+5.0 ).
+mrun uses
+certain standard options for the compilation process. Beyond that you
+can
+declare additional options with the environment variable fopts .
+Within the value assignment of an environment variable in the
+configuration file no blanks must be
+used. If blanks are necessary they must be
+replaced by colons (“:”). mrun
+will
+interpret these colons as blanks (2 colons written one behind the
+other will be interpreted as a colon). Thus in the example above fopts
+has the value “-O3
+-g
+-qrealsize=8 -Q -q64 -qmaxmem=-1 -qtune=pwr4 -qarch=pwr4 -qnosave
+-qnoescape ” .
+Thus a PALM executable is generated using high level optimization ( -O3 ).
+For all other options
+see the compiler manual on the IBM ( man
+f90 ).
+Additional libraries
+which the compiler should use are described by
+the environment variable lopts
+(loader options).
+ Here you
+have to indicate a special IBM library (ESSL, Engineering
+and Scientific Subroutine Library).
+ On the
+IBM-Regatta, all compiler options have also to be given to the linker.
+
Compiler and
+loader options usually differ from computer to computer. In the
+configuration file therefore several value assignments for the
+variables fopts
+and lopts
+exist which become active for different computers.
+Which value assignment is used is
+described by
+the so-called validity domain which follows in the appropriate
+variable lines after the value of variables.
+In the example above the entry “ ibmh
+ parallel ”
+stands for fopts
+and lopts .
+These lines only become active if a run on the parallel computer of
+the HLRN ( ibmh )
+on several ( parallel )
+ processors is started. The activation takes place when you
+appropriately specify the mrun
+options -h
+and -K
+(see below). This way, the validity domain can be limited also for all
+other environment-variables. If no validity domain
+is indicated then the given values of variables are valid on all
+computers.
+
After the value
+assignment for the
+variables the so-called error commands follow which have to begin with
+“EC: ”
+in the first column (comment lines begin with “# ”).
+Directly
+after the colon Unix commands follow (korn shell syntax) which are
+processed by mrun if errors arise during
+the model run. The command described in the example (cat
+RUN_CONTROL ) is executed thereby only on the
+condition that errors during the execution of the model (execution )
+arise. An mrun internal environment variable which
+indicates
+the
+respective abort place in case of errors is locat .
+In order to determine the actual value of this variable at the
+execution of mrun the “$ ”
+- prefix
+must be protected by a “\” since the configuration
+file has been
+already interpreted once when reading in through mrun
+and the
+value from
+locat would then supply the empty character
+string. If
+errors arise during the model run this command
+copies the data written by the model up to then to the local file
+RUN_CONTROL
+on the standard output where they can be checked after
+job end. RUN_CONTROL is an output
+file of the
+model which has to be copied according to the default configuration
+file
+(see below) after the end of the model run to a permanent file of the
+user but this action would not be performed in case of errors
+in the model run, so that the file content would be lost.
+With
+the help of the error command one can secure it nevertheless.
+Before and/or after
+the error commands in the example file you can find the so-called input
+and/or output commands which are implemented before and/or after the
+model run.
+After the output commands
+in the example file t he
+so-called file
+connection statements follow
+ via
+which tell mrun
+how to connect
+the local files in the temporary working
+directory of the model with the respective permanent files of the user.
+mrun copies the input and output files in accordance
+with the
+data in these connection statements. The file connection statements are
+explained in detail in the mrun
+description (chapter
+6.3 , in German) and are described here only as far as
+necessary. A
+file connection statement usually consists of entries in 5 columns
+whereby all columns are separated from each other by one or more blanks
+(the blanks define the individual columns). In the
+first column the local file name (e.g. PARIN )
+is given as it is addressed by the model. It must begin directly at
+the start of the line. In the second column the so-called file
+attributes
+are given. These determine whether the file is an input file (in )
+or an output file (out ),
+whether output
+files are to be transferred to the local computer of the user (tr )
+or whether they are to be archived (fl ).
+If a file has several attributes then they are separated by a colon
+in each case .
+With the entries in the
+third column one
+specifies the conditions under which a file connection statement
+becomes active i.e. under
+which circumstances it is executed by mrun . Then mrun
+copies the appropriate in or output files only if at least one of the
+character strings registered in column 3 (again two or more character
+strings have to be separated from each other by a colon) is
+indicated within the mrun call by the option -r .
+Thus a call of the form
+mrun - h ibmh -d abcde -r d3
+would lead to the fact that
+the input
+file with the local name PARIN is made available and the output files
+RUN_CONTROL and HEADER are copied to permanent files. The output
+files PLOT1D_PAR and PLOT1D_DATA are not copied so that their
+contents are not available to the user after the end of the job. If
+these files are to be copied of mrun then the call
+must be
+mrun -h ibmh -d abcde -r "d3 pr"
+Instead of the option -r you
+can
+separately address the file connection statements for input and/or
+output files with the options -i and -o. If one likes to make sure with
+these two options that in the example configuration
+file all file connection statements are actually executed then
+the call must be:
+mrun -h ibmh -d abcde -i d3 -o "d3 pr"
+The
+names of the
+local files assigned permanent files are build from the entries in
+the 4th and 5th column of the file connection statements and the
+value of the mrun
+option -d
+in the following way:
+
File
+name (inclusive path) = “value of
+the 4th column” + “value of the option -d ”
++ “value of the 5th column”.
+ The 4th column
+contains the path name
+whereby $fname
+is replaced by the value indicated for the option -d .
+The 5th column contains the so-called file name extension. The name
+of the permanent file which was copied by mrun to
+the local
+file PARIN thereby reads:
+~/palm/current_version/JOBS/abcde/INPUT/abcde_p3d.
+In the same way the names of
+the
+permanent files of the remaining file
+connection statements can be formed.
+With this example
+configuration file
+exactly one input file is copied into the temporary working directory
+of the model. This file has the local name PARIN
+and contains the steering parameters for the model and has to be
+provided by the user for each model run.
+The example configuration
+file also
+instructs mrun to copy four output files of the
+model to
+appropriate permanent files of the user at the end of the run.
+There are timestep information (local file name RUN_CONTROL ),
+the so-called header file, in which the values of the most selected
+parameters for this run (HEADER )
+are located, as well as a file with data of horizontally averaged
+vertical profiles
+(PLOT1D_DATA )
+and an associated parameter file (PLOT1D_PAR ),
+which can be used as input files for the plot program profil .
+A model run does not presuppose neither the file connection statements
+for
+output files nor their activation. But without declaring AND activating
+them usually the data produced by the model
+are lost after the end of the model run!
+As already mentioned the
+configuration
+file offers a variety of further possibilities to steer the
+execution of the model run. Some of them are described in the next
+chapter. Same applies to possible other options of the mrun
+call. For these please refer to the mrun
+documentation (in German). An mrun call for the
+execution of a
+model run
+on several processors on the IBM Regatta "hanni" of the HLRN must be
+supplemented by the following options in each case:
+mrun - K parallel -X … -t … -m …
+Only the indication of -K
+parallel causes the parallel execution of the
+run on
+several processors (otherwise a scalar execution on one processor is
+accomplished). In addition to this the number of the
+processing elements which shall be used has to be pre-scribed with the
+option -X
+( e.g.
+ -X
+4 ).
+In each case the permitted CPU time in seconds and the required memory
+size in MB must be indicated by the options -t
+and -m ,
+respectively.
+Alternatively, these can be set by the appropriate environment
+variables in the configuration file:
+%
+memory 1630 ibmh parallel %
+cputime 1000 ibmh parallel
+The values indicated there
+can be
+overridden with the values of the options -t
+and/or -m ,
+respectivly.
+
+
Last change:
+$Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_3.3.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_3.3.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_3.3.html (revision 141)
@@ -0,0 +1,257 @@
+
+
+PALM
+chapter 3.3
+
+3.3 Initialization and restart
+runs
+A job started by mrun
+will
+- according to its requested computing time, its memory size
+requirement and
+the number of necessary processing elements (on parallel computers) -
+be queued by the queuing-system of the remote computer into a suitable
+job
+class which fulfills these requirements. Each job class permits only
+jobs with certain maximum requirements (e.g.
+the job class cdev
+on the IBM Regatta "hanni" of the HLRN permits only jobs with no more
+than 7200 seconds required computing time and with using no more than
+32
+processing elements). The job classes are important for the scheduling
+process of the computer. Jobs with small requirements usually
+come to execution
+very fast, jobs with higher requirements must wait longer (sometimes
+several days).
+Before the start of a model
+run the user
+must estimate how much CPU time the model will need for the simulation.
+The necessary time in seconds has to be indicated with the mrun
+option -t
+and has an influence on the job class into which the job is queued. Due
+to the fact that the model usually uses a variable
+time step and thus the number of time steps to be executed and
+consequently the time needed by the model is not
+known at the beginning, this can be measured only very roughly in
+many cases. So it may happen that the model needs more time than
+indicated for the option -t ,
+which normally leads to an abort of the job as soon as the available
+CPU time is consumed. In principle one could solve this problem by
+setting a very generously estimated value for -t ,
+but this will possibly lead to the disadvantage that the queued job has
+to wait longer for execution.
+
To avoid this
+problem mrun offers
+the possibility of so-called restart runs . During
+the model
+run PALM continuously examines how much time is left for the
+execution of the job. If the run is not completed and finished shortly
+before
+expiration of this time, the model stops and writes down the values
+of (nearly) all model variables in binary form to a file (local name
+BINOUT ).
+After copying the output files required by the user, mrun
+automatically starts a restart run. For this purpose a new mrun
+call is set off automatically on the local computer of the user; mrun
+thus calls itself. The options with this call correspond to a large
+extent to those which the user had selected with his initial call of mrun .
+The model restarts and this time at the beginning it reads in the
+binary data written before and continues the run with them. If in
+this job the CPU time is not sufficient either, in order to terminate
+the run, at the end of the job another restart run is started, etc.,
+until the time which shall be simulated by the model, is reached.
+Thus a set of restart runs can develop - a so-called job chain. The
+first run of this chain (model start at t=0) is called
+initial run .
+Working with restart runs
+and their
+generation through mrun requires certain entries in
+the
+mrun-configuration file and in the parameter file, which are
+described and explained in the following. The configuration file must
+contain the following entries (example for the IBM Regatta of the
+HLRN):
+%write_binary true restart # PARIN in:job:npe d3# ~/palm/current_version/JOBS/$fname/INPUT _p3d PARIN in:job:npe d3f ~/palm/current_version/JOBS/$fname/INPUT _p3df BININ in:loc d3f ~/palm/current_version/JOBS/$fname/OUTPUT _d3d # BINOUT out:loc restart ~/palm/current_version/JOBS/$fname/OUTPUT _d3d
+The mrun
+call for the
+initialization run of the job chain must look as follows:
+mrun -h ibmh -d abcde -t 900 -r "d3# restart"
+The specification of the
+environment
+variable writ e_binary , which
+must be
+assigned the value true ,
+is essential. Only in this case the model writes
+binary-coded data for a possible restart run to the local file BINOUT
+at the end of the run. Then of course this output file must be stored
+on a permanent file with an appropriate file connection statement
+(last line of the example above). As you can see, both instructions
+(variable declaration and connection statements) are only carried out
+by mrun , if the character string restart
+is given for the option -r
+ in the mrun
+call. Thus
+the example above can also be used
+if no restart runs are intended. In such cases the character string
+restart
+with the option -r
+can simply be omitted.
+Only by the specification of
+write_binary=true
+ the
+model is
+instructed to compute the remaining CPU time after each time step and
+stop, if the run is not going to be completed and finished briefly
+before expiration of
+this time. Actually the stop takes place when the
+difference from the available job time (determined by the mrun
+option -t )
+and
+the time used so far by the job becomes smaller than the time given
+by the model variable termination_time_needed .
+With the variable termination_time_needed the user
+determines,
+how much time is needed for binary copying of the data for restart
+runs, as
+well as for the following data archiving and transfer of result data
+etc. (as long as this is part of the job). Thus, as soon as the
+remaining job time is less than termination_time_needed ,
+the
+model stops
+the time step procedure and copies the data for a restart run to the
+local binary file BINOUT. The so-called initialization parameters are
+also written to this file (see chapter
+4.0 ). In a last step the model produces another file with the
+local name CONTINUE_RUN. The presence of this file signals mrun
+the fact that a restart run must be started and leads to the
+start of an appropriate job.
+During
+the initial
+phase of a restart ru n different actions than during the
+initial
+phase of an initial run of the model are neccessary. In this
+case the model must read in the binary data written by the preceding
+run at the beginning of the run. Beyond that it also reads the
+initialization parameters from this file. Therefore these do not need
+to be indicated in the parameter file (local name PARIN ).
+If they are indicated nevertheless and if their value deviates from
+their value of the initial run, then this is ignored. There is
+exactly one exception to this rule: with the help of the
+initialization parameter initializing_actions
+it is determined whether the job is a restart run or an
+initial run. If initializing_actions =
+“read_restart_data” , then it is
+a restart
+run, otherwise an initial run. The previous remarks make it
+clear that the model obviously needs two different parameter files
+(local name PARIN) for the case of job chains. One is needed for the
+initial run and contains all initialization parameters set by
+the user and the other one is needed for restart runs. The
+last one only contains the initialization parameter
+initializing_actions (also, initialization
+parameters with values different from the initial run may appear in
+this file, but they will be ignored), which
+must have the value “read_restart_data” .
+Therefore the user must produce two different parameter files if he
+wants to operate job chains. Since the model always expects the
+parameter file on the local file PARIN , two
+different file
+connection statements must be given for this file in the
+configuration file. One may be active only at the initial run,
+the other one only at restart runs. The mrun call
+for the
+initial run shown above activates the first of the two
+specified connection statements, because the character string d3#
+with the option -r
+coincides with the character
+string in the third column of the connection statement. Obviously
+the next statement must be active
+PARIN in:job:npe d3f ~/palm/current_version/JOBS/$fname/INPUT _p3df
+with the restart runs. Given
+that this statement only gets
+active if the option -r is given the value
+d3f
+and that
+the mrun call for this restart run is produced
+automatically (thus not by the user), mrun
+obviously has to
+replace "d3#"
+of the initial run with "d3f"
+ within the call of this restart run. Actually,
+with restart
+runs all "#"
+characters within the strings given for the options -r
+, -i
+and -o
+are
+replaced by “f” .
+
+For example, for the initial
+run
+the permanent file
+~/palm/current_version/JOBS/abcde/INPUT/abcde_p3d
+and for restart runs the
+permanent file
+~/palm/current_version/JOBS/abcde/INPUT/abcde_p3df
+is used. Only with restart
+runs the
+local file BININ is made available as input file,
+because
+the appropriate file connection statement also contains the
+character string "d3f"
+in the third column. This is logical and necessary since in BININ the
+binary data, produced by the model of the preceding job of the chain,
+are expected and the initial run does not need these
+data The permanent names of this input file (local name BININ) and
+the corresponding output file (local name BINOUT) are identical and
+read
+~/palm/current_version/JOBS/abcde/OUTPUT/abcde_d3d.
+However, after the file
+produced by the
+previous job was read in by the model and after at the local file
+BINOUT was produced at the end of the job, the
+restart job does not overwrite this permanent file (…/abcde_d3d )
+with the new data. Instead of that, it is examined whether already
+a permanent file with the name …/abcde_d3d
+exists when
+copying the
+output file (BINOUT )
+of mrun . If this is the case, BINOUT
+is copied to the file
+ …/abcde_d3d.1 .
+Even if this file is already present, …/abcde_d3d.2
+is tried etc. For an input file the highest existing cycle
+of the respective permanent file is copied. In the example above this
+means: the initial run creates the permanent file
+…/abcde_d3d ,
+the first restart run uses this file and creates …/abcde_d3d.1 ,
+the second restart run creates …/abcde_d3d.2
+ etc. After completion of the job chain the user can still
+access all files created by the jobs. This makes it possible for the
+user for example to restart the model run of a certain job of the job
+chain again.
+Therefore restart jobs can
+not only be
+started automatically through mrun , but also
+manually by the
+user. This is necessary e.g. whenever after the end of a job chain
+it is decided that the simulation must be continued further, because
+the phenomenon which should be examined did not reach the desired
+state yet. In such cases the mrun options
+completely
+correspond to those of the initial call; simply the "#"
+characters in the
+arguments of options -r ,
+ -i
+and -o
+must be
+replaced by "f" .
+
+
+
Last change:
+$Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_3.4.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_3.4.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_3.4.html (revision 141)
@@ -0,0 +1,4068 @@
+
+
+
+
+
+
+
+
+ PALM chapter 3.4
+
+
+
+
+3.4
+Input and
+output files
+
+
+
+
+
+The
+model works
+with a set of files, which are all located in the temporary working
+directory and which are either expected at the beginning of the run
+(the so-called input files) or which are
+produced during the run and/or at the end of the simulation (output
+files).
+The following table lists all
+default files
+addressed by the model. They are arranged according to the
+associated FORTRAN unit (unit number). The
+unit 90 is used for different files, which are opened only briefly
+and uniquely in the model and closed directly afterwards.
+Unit numbers 101 - 109, 111 - 113, and 116 refer to data files
+which have NetCDF format.
+These are not opened by a FORTRAN-OPEN-statement but by a corresponding
+NetCDF call (NF90_CREATE or NF90_OPEN). These files are only created on
+machines where a NetCDF library is available.
+
+
+
+
+
+The
+file
+names described in the list correspond to the names indicated in the
+respective OPEN instruction, i.e. the files are expected and saved
+under these names in the temporary working directory of the model. By
+default, file names are always written in capital letters. The
+third column indicates whether it is an input or output file (I
+and/or O). The NetCDF files can be both input and output files (I/O).
+If restart jobs shall append data to an existing NetCDF file (created
+by a previous job of the job chain), the respective file has to be
+given as an input file (see also chapter
+4.5.1 which gives more details about the PALM-NetCDF-output).
+
+
+
+
+
+
+On
+parallel
+computers many of the files are read and/or written by the central
+processing element 0 (PE0) only. These files have processor-independent
+content (and therefore they can be read or written by other
+PEs just as well). However, certain files have processor-dependent
+content. For the binary output of data for restart runs (local file
+BINOUT ),
+for example, each PE outputs only
+the data of
+its subdomain. So each processing element writes
+into its own file with its own file name. These files lie in a
+subdirectory of the temporary working directory. Their names are build
+off from the underline ("_ ") and the four digit
+processor ID. The data written for restart runs would be e.g. on the
+files BINOUT/_0000 (PE0), BINOUT/_0001 (PE1), BINOUT/_0002 (PE2) etc.
+Such files, which have processor-dependent content on parallel
+computers, are marked in the following list by the fact, that to the
+file name a line (”/“) is attached. If appropriate
+output
+files are to be copied through mrun to permanent
+files, and/or
+files with processor-dependent content are supposed to be copied as
+input files into the temporary working directory of the model, you have
+to indicate a special file attribute in the appropriate file
+connection statement (see arpe ,
+flpe
+in the mrun description).
+ Then the permanent file
+name will be
+interpreted as a directory name, in which the input files are
+expected and/or to which output files are written. The file names in
+these directories are always named _0000, _0001, _0002 etc.
+
+
+
+For
+internal use,
+the model may open a set of further files, which are not
+defined by the user but contain no usable information and
+therefore are not included in this list.
+
+
+ In case of coupled atmosphere-ocean
+runs (see chapter 3.8 ),
+both the atmosphere and the ocean executable use
+the same temporary working directory. However, each executable requires its own, unique set of files for I/O. In order to
+distinguish between atmosphere and ocean files, coupled atmosphere-ocean
+ runs use the following
+filename convention . The
+atmosphere executable uses the set of normal filenames given in the
+table below. The ocean executable uses a set of modified filenames that
+have the string '_O' added to their normal name. The coupled
+ocean filenames are given in brackets in the table below where
+applicable. The string '_O' is simply appended to most
+filenames ; exceptions are highlighted in bold face. (Note: uncoupled
+ocean runs use the normal set of filenames without '_O'.)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Unit
+
+
+
+
+
+
+
+ Name
+
+
+
+
+
+
+
+ I/O
+
+
+
+
+
+
+
+ Format
+
+
+
+
+
+
+
+ Description/contents
+
+
+
+
+
+
+
+
+
+
+
+ 11
+
+
+
+
+
+
+
+ PARIN
+
+
+(PARIN_O)
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+ ASCII/
+
+
+NAMELIST
+
+
+
+
+
+
+
+ Parameter
+for model steering. This file
+is needed by the model in each case. Its content and structure is
+described in detail in chapter
+4.0 . Chapter
+4.4.1 shows a simple
+example.
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 13
+
+
+
+
+
+
+
+ BININ/
+
+
+(BININ_O /)
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+ Binary
+
+
+
+
+
+
+
+ Binary data,
+which are read in by the model at the beginning
+of a restart run (see chapter
+3.3 ). The appropriate file must have been written by the
+preceding
+job of the job chain (see BINOUT ).
+This file contains the initial parameters (see chapter
+4.1 ) of the job chain, arrays of the prognostic and
+diagnostic
+variables as well as those parameters and variables for plots of
+horizontally averaged vertical profiles (see data_output_pr ),
+which have been determined by the job chain so far. Concerning runs on
+several processors it has to be noted that each processing element
+reads its own file and the file content is processor-dependent. The
+number of processors which can be used must not be changed during a job
+chain and/or if a job chain is continued.
+
+
+
+ Knowledge
+of the file structure is usually not necessary,
+because the file is produced and also read again by the model, but it
+can be useful for error determination in case of read errors .
+Therefore the file structure is described in the following.
+
+
+
+ The first record of this file contains a version number
+(ten
+character string) of the subroutine, which, which output the data that
+follows (write_var_list.f90). This number has to
+agree with the version number subroutine which is reading the file
+(read_var_list.f90) in case of a restart run. Otherwise the model run
+is aborted. Version numbers are changed whenever new code revisions
+require a change of the file format.
+
+
+
+ Starting
+from the second record, all initial parameters follow
+(exception: initializing_actions ),
+whereby each parameter fills two records. In the first record the name
+of the parameter is saved as a character string (30 characters long,
+short names are filled by trailing blanks, longer names are cut off at
+the end), in the second record the value (or the values) of the
+parameter follow. The sequence of parameters on the file may be
+arbitrary, however the first and second variable must be nz
+and statistic_regions .
+If a variable with unknown name is found the model run is
+aborted.
+
+
+
+ At the end of the initial
+parameters a record with the string "***
+end *** "follows (filled up with trailing blanks up to a
+length of
+30 characters).
+
+
+
+ Afterwards the fields
+of the prognostic and diagnostic
+variables follow. This part of the file also begins with a record
+consisting of a character string of length 10, which contains the
+version number of the subroutine that wrote the arrays that follow
+(write_3d_binary.f90). It must agree with the number of the reading
+subroutine (read_3d_binary.f90).
+
+
+
+ The
+following record contains the number of processors which
+were used in the model run producing this file, the processor ID of the
+special processor, which creates the file, as well as the lower and
+upper array indices of the subdomain belonging to this processing
+element. If no complete agreement with the values of the current model
+run exists, then this is aborted. This examination must be made in
+particular on parallel computers, because the jobs of a job chain
+always have to use the same number of processors and the same virtual
+processor grid.
+
+
+
+ After these tests the
+individual arrays as well as parameters
+and variables for plots of horizontally averaged vertical profiles
+follow. Like the initialization parameters, they consist of two
+records. In the first record, the name of the array or the variable
+(character string, consisting of 20 characters, filled with trailing
+blanks) is located, in the second one its values follow. The sequence
+of the individual variables may be arbitrary again. The parameters for
+the plot and the respective variables are only read in if for the run
+parameter use_prior_plot1d_parameters
+= .TRUE is selected, otherwise they will be
+skipped.
+
+
+
+ At the end of the file there
+has to be a record with the
+character string "***
+end
+*** "(filled up with trailing blanks up to a length of 20
+characters).
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 14
+
+
+
+
+
+
+
+ BINOUT/
+
+
+(BINOUT_O /)
+
+
+
+
+
+
+
+ O
+
+
+
+
+
+
+
+ Binary
+
+
+
+
+
+
+
+ Binary data,
+which are written by the model at the end of the
+run and possibly needed by restart runs (see chapter
+3.3 ) for the initialization. This output file is then read in
+as
+file BININ .
+It contains the initial parameters (see chapter
+4.1 ) of the model run, arrays of the prognostic and
+diagnostic
+variables as well as those parameters determined so far during a job
+chain and variables for plots of horizontally averaged vertical
+profiles (see data_output_pr ).
+With runs on several processors it has to be noted that each processing
+element writes its own file and the file content is
+processor-dependent. A specification of the file format can be found in
+the
+description of the file BININ .
+
+
+
+
+ The file BINOUT is written by the model only if,
+with the help
+of the mrun -configuration file, the value true is
+assigned for the
+environment
+variable write_binary
+(see chapter
+3.3 ).
+
+
+
+ With large grid point
+numbers the file BINOUT (or the
+files residing in directory BINOUT/) will be very large and should
+be stored (if available) on the archive system of the remote computer.
+
+
+
+
+
+
+
+
+
+
+
+ 15
+
+
+
+
+
+ RUN_CONTROL
+
+
+(RUN_CONTROL_O)
+
+
+ O
+
+
+ Ascii
+
+
+
+
+ This file contains
+the so-called time step control output of
+the model. At certain temporal intervals, which are described by the
+run
+parameter dt_run_control ,
+a line with the values of certain control parameters is written into
+this
+file. Additionally, such a control line is always written, whenever the
+time step of the model changes. All data and quantities always refer to
+the entire model domain.
+
+
+
+ If the
+1D-model is switched on for the initialization of the
+3D-models, then control lines are likewise written into this file at
+certain temporal intervals (see dt_run_control_1d ).
+
+
+
+
+ By default, the file RUN_CONTROL only lists
+information
+about the selected model parameters at the beginning of the
+initial run. These informations are written at the beginnning of a run.
+They correspond to those of the file HEADER
+(however without data concerning the consumed CPU time, because these
+are
+only known at the end of a run). With the run parameter force_print_header
+it can be achieved that this information is also written at the
+beginning of the file RUN_CONTROL at restart runs.
+
+
+
+ The individual columns of the 1D - time step control
+output
+have the following meaning (listed by the respective heading of the
+appropriate
+column in the file):
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ITER.
+
+
+ Number of
+time steps
+accomplished so far
+
+
+
+
+
+
+
+
+ HH:MM:SS
+
+
+ Time (in
+hours: minutes:
+seconds)
+
+
+
+
+
+
+
+
+ DT
+
+
+ Time step (in
+s)
+
+
+
+
+
+
+
+
+ UMAX
+
+
+ Maximum
+absolute wind
+velocity
+(u-component) (in m/s)
+
+
+
+
+
+
+
+
+ VMAX
+
+
+ Maximum
+absolute wind
+velocity
+(v-component) (in m/s)
+
+
+
+
+
+
+
+
+ U *
+
+
+ Friction
+velocity (in m/s)
+
+
+
+
+
+
+
+
+ ALPHA
+
+
+ Angle of the
+wind vector
+(to the x-axis) at the top of the
+Prandtl layer (k=1) (in degrees)
+
+
+
+
+
+
+
+
+ ENERG.
+
+
+ Kinetic
+energy of the
+1D-model (in m2 /s2 ),
+averaged over all grid points
+
+
+
+
+
+
+
+
+
+
+
+
+
+The individual columns of the 3D - time step control output
+have the following meaning (listed by the respective heading of the
+appropriate
+column in the file):
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ RUN
+
+
+ Serial-number
+of the job
+in the job chain. The initial
+run has the number 0, restart runs accordingly have larger numbers.
+
+
+
+
+
+
+
+
+ ITER.
+
+
+ Number of
+time steps
+accomplished since starting time t=0 of
+the initial run.
+
+
+
+
+
+
+
+
+ HH:MM:SS
+
+
+ Time (in hours: minutes:
+seconds) since starting time t=0 of the
+initial run.
+
+
+
+
+
+
+
+
+ DT (E)
+
+
+ Time step (in s). The
+following character indicates whether the
+time
+step is limited by the advection criterion (A) or the diffusion
+criterion (D). After changes of the time step a further character
+follows,
+which indicates with which time step procedure the changed time step
+was accomplished (L:
+Leapfrog, E:
+Euler). This
+does
+not apply for the default Runge-Kutta timestep scheme.
+
+
+
+
+
+
+
+
+ UMAX
+
+
+ Maximum
+absolute wind
+velocity (u-component) (in m/s).
+If at
+the
+appropriate output time a random disturbance was added to the
+horizontal velocity field (see create_disturbances ),
+the character D will appear directly after the velocity value.
+
+
+
+
+
+
+
+
+ VMAX
+
+
+ Maximum
+absolute wind
+velocity (v-component) (in m/s).
+If at
+the
+appropriate output time a random disturbance was added to the
+horizontal velocity field (see create_disturbances ),
+the character D will appear directly after the velocity value.
+
+
+
+
+
+
+
+
+ WMAX
+
+
+ Maximum
+absolute wind
+velocity (w-component) (in m/s).
+
+
+
+
+
+
+
+
+ U
+*
+
+
+ Horizontal
+average of the
+friction velocity (in m/s).
+
+
+
+
+
+
+
+
+ W
+*
+
+
+ Convective
+velocity scale
+(in m/s). The assumed
+boundary layer
+height is determined via the heat flux minimum criterion.
+
+
+
+
+
+
+
+
+ THETA *
+
+
+ Characteristic
+temperature
+of the Prandtl - layer (in K).
+
+
+
+
+
+
+
+
+ Z_I
+
+
+ Height of the
+convective
+boundary layer (in m),
+determined via
+the criterion of the heat flux minimum.
+
+
+
+
+
+
+
+
+ ENERG.
+
+
+ Average
+resolved total
+energy of the flow field (in m2 /s2 ),
+normalized with the total number of grid points.
+
+
+
+
+
+
+
+
+ DISTENERG
+
+
+ Average
+resolved
+disturbance energy of flow field (in
+ m2 /s2 ),
+normalized with the total number of grid points.
+
+
+
+
+
+
+
+
+ DIVOLD
+
+
+ Divergence
+of the velocity field (sum of
+the absolute values) ( in
+ 1/s) before
+call of the
+pressure solver,
+normalized with the total number of grid points.
+
+
+
+
+
+
+
+
+ DIVNEW
+
+
+ Divergence
+of the velocity field (sum of
+the absolute values) ( in
+ 1/s) after
+call of the
+pressure solver, normalized
+with the total number of grid points.
+
+
+
+
+
+
+
+
+ UMAX (KJI)
+
+
+ Indices of
+the grid point
+with the maximum absolute
+u-component of the wind velocity (sequence: k, j, i).
+
+
+
+
+
+
+
+
+ VMAX (KJI)
+
+
+ Indices of
+the grid point
+with the maximum absolute
+v-component of the wind velocity (sequence: k, j, i).
+
+
+
+
+
+
+
+
+ WMAX (KJI)
+
+
+ Indices of
+the grid point
+with the maximum absolute
+w-component of the wind velocity (sequence: k, j, i).
+
+
+
+
+
+
+
+
+ ADVECX
+
+
+ Distance (in km) the
+coordinate system has been moved in
+x-direction with Galilei-Transformation switched on (see galilei_transformation ).
+
+
+
+
+
+
+
+
+ ADVECY
+
+
+ Distance (in km) the
+coordinate system has been moved in
+y-direction with Galilei-Transformation switched on (see galilei_transformation ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 16
+
+
+
+
+
+ LIST_PROFIL
+
+
+(LIST_PROFIL_O)
+
+
+ O
+
+
+
+
+
+ Ascii
+
+
+
+
+
+ This file contains
+horizontally
+(and possibly temporally)
+averaged vertical profiles of some model variables. The quantities
+saved are set model-internally and can not be determined by the user.
+At each output time (see dt_dopr_listing )
+two tables are written to the file consecutively. The first contains
+variables which are defined on the scalar / u-v-grid-levels, the
+second table contains variables which are defined on the w-grid-levels.
+If subdomains were defined with the initialization parameter statistic_regions for
+additional statistic evaluation, then the tables
+described above are written for each individual subdomain. The name of
+the respective subdomain (see region )
+appears in the header of the respective table.
+
+
+In each case the tables consist of a header, followed by the
+profiles arranged next to each other in columns. The header contains
+some basic information of the respective run (model version, run
+identifier consisting of
+basic file name and number of the job in the job chain, executing
+computer, date, time of the beginning of the run, name of the
+subdomain, output time, kind of averaging). On the u-v-level the
+following columns are written:
+
+
+
+
+
+
+
+
+
+
+
+
+ k
+
+
+
+
+
+ Vertical
+grid point index.
+
+
+
+
+
+
+
+
+ zu
+
+
+
+
+
+ Height
+of the grid point
+level (in m).
+
+
+
+
+
+
+
+
+ u
+
+
+
+
+
+ u-component
+of the wind
+velocity (in m/s).
+
+
+
+
+
+
+
+
+ du
+
+
+
+
+
+ Deviation
+of the
+u-component from the initial profile at the
+time t=0 (initialization profile) (in
+ m/s).
+
+
+
+
+
+
+
+
+ v
+
+
+
+
+
+ v-component
+of the wind
+velocity (in m/s).
+
+
+
+
+
+
+
+
+ dv
+
+
+
+
+
+ Deviation
+of the
+v-component from the initial profile at the
+time t=0 (initialization profile) (in
+ m/s).
+
+
+
+
+
+
+
+
+ pt
+
+
+
+
+
+
+ Potential
+temperature (in K).
+
+
+
+
+
+
+
+
+ dpt
+
+
+
+
+
+ Deviation
+of potential
+temperature from the initial profile at
+the time t=0 (initialization profile) (in
+ K).
+
+
+
+
+
+
+
+
+ e
+
+
+
+
+
+ Turbulent
+kinetic energy
+(subgrid-scale) (in m2 /s2 ).
+
+
+
+
+
+
+
+
+ Km
+
+
+
+
+
+ Turbulent
+diffusion
+coefficient for momentum (in m2 /s).
+
+
+
+
+
+
+
+
+ Kh
+
+
+
+
+
+ Turbulent
+diffusion
+coefficient for heat (in m2 /s).
+
+
+
+
+
+
+
+
+ l
+
+
+
+
+
+ Mixing
+length (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+On the w-level the following columns are written:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ k
+
+
+
+
+
+ Vertical
+grid point
+index.
+
+
+
+
+
+
+
+
+ zw
+
+
+
+
+
+ Height of
+the grid
+point
+level (in m).
+
+
+
+
+
+
+
+
+ w'pt'
+
+
+ Vertical
+subgrid-scale
+kinematic heat flux (in K
+m/s).
+
+
+
+
+
+
+
+
+ wpt
+
+
+ Vertical
+total (
+subgrid-scale + resolved)
+kinematic heat flux (in K
+m/s).
+
+
+
+
+
+
+
+
+ w'u'
+
+
+ u-component
+of the
+vertical subgrid-scale momentum flux (in
+ m2 /s2 ).
+
+
+
+
+
+
+
+
+ wu
+
+
+ u-component
+of the
+total
+vertical momentum flux (
+subgrid-scale + resolved) (in m2 /s2 ).
+
+
+
+
+
+
+
+
+ w'v'
+
+
+ v-component
+of the
+vertical subgrid-scale momentum flux (in
+ m2 /s2 ).
+
+
+
+
+
+
+
+
+ wv
+
+
+ v-component
+of the
+total
+vertical momentum flux (
+subgrid-scale + resolved) (in m2 /s2 ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 17
+
+
+
+ LIST_PROFIL_1D
+
+
+(LIST_PROFIL_1D_O)
+
+
+ O
+
+
+ Ascii
+
+
+ This file contains
+the vertical
+profiles calculated by the
+1D-model within initial runs. The quantities saved are set
+model-internally and cannot be determined by the user. At the
+respective output times (see dt_pr_1d )
+a table with the following information is written to the file: The
+table header contains some basic information of the respective run
+(model version, run identifier consisting of basic file name and number
+of the job in the
+job chain (this number should always be 00, because the 1D-model is
+only switched on at initial runs), executing computer, date,
+time of the beginning of the run, output time). Afterwards the
+following columns appear:
+
+
+
+
+
+
+
+
+
+
+
+
+ k
+
+
+
+
+
+ Vertical
+grid point index.
+
+
+
+
+
+
+
+
+ zu
+
+
+
+
+
+ Height
+of the grid point
+level (in m).
+
+
+
+
+
+
+
+
+ u
+
+
+
+
+
+ u-component
+of the wind
+velocity (in m/s).
+
+
+
+
+
+
+
+
+ v
+
+
+
+
+
+ v-component
+of the wind
+velocity (in m/s).
+
+
+
+
+
+
+
+
+ pt
+
+
+
+
+
+ Potential
+temperature (in K).
+
+
+
+
+
+
+
+
+ e
+
+
+
+
+
+ Turbulent
+kinetic energy (in m2 /s2 ).
+
+
+
+
+
+
+
+
+ rif
+
+
+
+
+
+ Flux
+Richardson number
+
+
+
+
+
+
+
+
+ Km
+
+
+
+
+
+ Turbulent
+diffusion
+coefficient for momentum (in m2 /s).
+
+
+
+
+
+
+
+
+ Kh
+
+
+
+
+
+ Turbulent
+diffusion
+coefficient for heat (in m2 /s).
+
+
+
+
+
+
+
+
+ l
+
+
+
+
+
+ Mixing
+length ( in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 18
+
+
+
+ CPU_MEASURES
+
+
+(CPU_MEASURES_O)
+
+
+ O
+
+
+ Ascii
+
+
+ Time measurements
+are
+accomplished through the subroutine cpu_log.f90. The file
+CPU_MEASURES contains a header with some basic information of the
+respective run
+(model version, run identifier consisting of basic file name and
+number of the job in the job chain, executing computer, date, time of
+the beginning of the run) and afterwards two tables with data of CPU
+times which have been consumed by certain model parts. The model parts
+analyzed in the first table do not overlap and the CPU times needed for
+them therefore approximately add up to the “total”
+value given in the
+first line of this table. In the second table (heading: special
+measures) overlaps (in particular with the parts described in the first
+table) are possible.
+
+
+For each model part it is indicated in the following columns how much
+CPU time was needed (absolutely and relative), and how often it was
+called. With runs on several processors the average values of
+all
+processors are indicated. In the case of parallel runs information for
+those processors with the largest and smallest CPU time follow as
+well as the standard deviation of all PEs from the average value. With
+good
+parallelization the CPU times on the individual processors should
+differ only little from each other and the standard deviation should be
+small.
+
+
+
+
+
+
+
+
+ 19
+
+
+
+ HEADER
+
+
+(HEADER_O)
+
+
+ O
+
+
+ Ascii
+
+
+
+
+ Information about
+the selected model parameters (physical and
+numerical values) as well as general information about the
+run.
+
+
+
+ This file contains the values of
+all important steering
+parameters
+(numerical procedures, computing grid and model dimensions, boundary
+conditions, physical dimension, turbulence quantities, actions during
+the simulation, 1D-model-parameters) as well as data concerning the
+selected plot and list outputs. The headlines of the file list the
+program version used, date and time of the beginning of the run, the
+name of the executing computer, the run identifier (corresponds to the
+selected base file name) and the number of the run (number of the
+restart run). With parallel runs the number of processors as well as
+the assigned virtual processor net also appear. After these headlines
+run time and time step information appear (point of starting time,
+related to t=0 of the initial run, end-time, time actually reached, CPU
+time, etc.). If a model run is incorrectly terminated (e.g.
+run time error or excess of the permitted CPU time), information over
+the time reached and the necessary CPU time is missing (to understand:
+the file HEADER is written twice by the model; once briefly after
+beginning of the simulation (naturally here the information over the
+time reached is missing etc.) and then briefly before the normal end of
+the simulation. The second, now complete output overwrites the first
+output.).
+
+
+
+ At the end of the file,
+information about the values of user
+parameters (see chapter
+3.7 and chapter
+4.3 ) can be output by the user with the help of the
+subroutine user_header
+(located in
+the file user_interface.f90 ).
+If no user parameters were found, the string “*** no user-defined
+variables found ”
+appears at the end of the file.
+If user parameters were indicated, the string “user-defined
+variables and actions ”
+is printed, followed by informations about the user-defined subdomains
+for which
+profiles and time series are output. All further information to appear
+here, must be provided by the user (by appropriate
+WRITE statements in user_header ).
+
+
+
+
+
+
+
+
+
+
+
+ 21
+
+
+
+ PLOT2D_XY
+
+
+(PLOT2D_XY_O)
+
+
+ O
+
+
+
+
+
+ Binary
+
+
+
+
+
+
+
+ This file
+contains data of the two-dimensional horizontal
+cross sections written by the model (see data_output )
+in a format readable by ISO2D
+(the first record contains the coordinate information dx , eta , hu , ho ,
+then
+the individual arrays follow). The data are visualized with the help of
+ISO2D using
+NAMELIST - parameter sets, which are directly written by the model to
+the
+local files PLOT2D_XY_GLOBAL
+and PLOT2D_XY_LOCAL .
+
+
+
+
+ With parallel runs and choice of data_output_2d_on_each_pe
+= .T. each processing element writes the data of
+its subdomain
+to a separate file with the name
+PLOT2D_XY_<processor-Id>,
+whereby <processor-Id> is a four digit number (e.g.
+PLOT2D_XY_0000). These files are not suitable for ISO2D, but after the
+end
+of the model run they can be combined to one file readable by ISO2D
+with
+the help of the program combine_plot_fields.x .
+This tool expects the files of the individual processing
+elements under the names described above and outputs the combined file
+under the name PLOT2D_XY. Usually it is called by an appropriate OUTPUT
+- command (OC:) in the MRUN-configuration file. The tool writes
+informative messages about the actions accomplished into the job
+protocol (e.g., even if no files were found).
+By the call of combine_plot_fields.x
+possibly existing files of the other cross sections (xz and/or yz)
+and three-dimensional arrays (see PLOT3D_DATA )
+are also combined.
+
+
+
+ Further information
+about the output of plots of
+two-dimensional cross sections is found in the description of the run
+parameter data_output .
+
+
+
+
+
+
+
+
+
+
+
+ 22
+
+
+
+
+
+ PLOT2D_XZ
+
+
+(PLOT2D_XZ_O)
+
+
+ O
+
+
+
+
+
+ Binary
+
+
+
+
+
+
+
+ This file contains
+the data of the xz
+cross sections written by the model.
+
+
+The description of the local file PLOT2D_XY
+applies to this file, respectively
+
+
+
+
+
+
+
+
+ 23
+
+
+
+
+
+ PLOT2D_YZ
+
+
+ (PLOT2D_YZ_O)
+
+
+ O
+
+
+
+
+
+ Binary
+
+
+
+
+
+
+
+ This file contains
+the data of the xz
+cross sections written by the model.
+
+
+The description of the local file PLOT2D_XY
+applies to this file, respectively
+
+
+
+
+
+
+
+
+ 27
+
+
+
+
+
+ PLOT2D_XY_LOCAL
+
+
+(PLOT2D_XY_LOCAL_O)
+
+
+ O
+
+
+
+
+
+ Ascii/ NAMELIST
+
+
+
+
+
+
+
+ NAMELIST -
+parameter sets, with which the plot layout of the
+data in the local file PLOT2D_XY
+can be steered, if they are visualized with the plot program ISO2D .
+This file contains the so-called local parameter set (NAMELIST - group
+name: &LOCAL) required by ISO2D (one parameter set for each
+field
+present at the file PLOT2D_XY). After the model run these parameter
+sets can be edited by the user, if neccessary.
+
+
+
+ Additionally
+ISO2D still needs another so-called global
+parameter set. This is saved by the model to the local file PLOT2D_XY_GLOBAL .
+Due to the fact that ISO2D expects global and local parameter sets on
+one and the same
+file, in fact the global parameter set first, the user has to append
+the
+contents of the file PLOT2D_XY_LOCAL to the file PLOT2D_XY_GLOBAL
+before the call of ISO2D (e.g. by an OUTPUT-command in the
+MRUN-configuration file: “PLOT2D_XY_LOCAL >>
+PLOT2D_XY_GLOBAL”).
+This relatively pedantic proceeding is due to the fact that the model
+can produce the file PLOT2D_XY_GLOBAL only at the end of the simulation
+(only then e.g. when the final value of the global ISO2D - parameter planz
+is known), while the local parameter sets are written continuously
+to the file PLOT2D_XY_LOCAL during the run.
+
+
+
+
+
+
+
+
+
+
+
+ 28
+
+
+
+
+
+ PLOT2D_XZ_LOCAL
+
+
+ (PLOT2D_XZ_LOCAL_O)
+
+
+
+ O
+
+
+
+
+
+ Ascii/ NAMELIST
+
+
+
+
+
+
+
+ NAMELIST -
+parameter sets, with which the plot layout of the
+data in the local file PLOT2D_XZ
+can be steered, if they are visualized with the plot program ISO2D .
+
+
+
+
+ The description of the local file PLOT2D_XY_LOCAL
+applies to this file, respectively.
+
+
+
+
+
+
+
+
+
+
+
+ 29
+
+
+
+
+
+ PLOT2D_YZ_LOCAL
+
+
+ (PLOT2D_YZ_LOCAL_O)
+
+
+ O
+
+
+
+
+
+ Ascii/ NAMELIST
+
+
+
+
+
+
+
+ NAMELIST -
+parameter sets, with which the plot layout of the
+data in the local file PLOT2D_YZ
+can be steered, if they are visualized with the plot program ISO2D .
+
+
+
+
+ The description of the local file PLOT2D_XY_LOCAL
+applies to this file, respectively.
+
+
+
+
+
+
+
+
+
+
+
+ 30
+
+
+
+
+
+ PLOT3D_DATA
+
+
+(PLOT3D_DATA_O)
+
+
+ O
+
+
+
+
+
+ Binary
+
+
+
+
+
+
+
+ This file contains
+the data of the three-dimensional arrays
+(see data_output )
+written by the model in a format readable for the visualization
+software AVS. Beyond that AVS
+needs coordinate information, which are output into the
+local file PLOT3D_COOR ,
+as well as the local files PLOT3D_FLD
+and PLOT3D_FLD_COOR ,
+which describe the structure of the files PLOT3D_DATA and PLOT3D_COOR
+in the so-called AVS-FLD-format. Due to
+the fact that AVS expects these information in only one (so-called FLD
+-) file, the content of the file PLOT3D_FLD_COOR must be appended to
+the file PLOT3D_FLD by the user after the end of the model run (e.g.
+with an appropriate OUTPUT - command in the MRUN - configuration file: "cat PLOT3D_FLD_COOR
+>> PLOT3D_FLD ").
+
+
+
+ With
+parallel runs each processing element writes the data of
+its subdomain to a separate file with the name
+PLOT3D_DATA_<Processor-Id>, where
+<Processor-Id> is a
+four digit number (e.g. PLOT3D_DATA_0000). These files are not suitable
+for AVS, but after the end of the model run they can be combined to one
+file readable for AVS with the help of the program combine_plot_fields.x .
+This tool expects the files of the individual processing
+elements under the names described above and outputs the combined file
+into a new file PLOT3D_DATA. Usually it is called by an appropriate
+OUTPUT - command in the MRUN-configuration file. The tool
+writes informative messages about the accomplished actions into
+the job protocol (e.g., even if no files were
+found). By the call of combine_plot_fields.x
+also possibly existing files with two-dimensional plot data (see e.g. PLOT2D_XY )
+are combined.
+
+
+
+ With parallel runs the
+output of data of large volume is also
+possible in compressed form. For this purpose the initialization
+parameter do3d_compress
+= .TRUE. must be set and the desired output
+accuracy has to be
+indicated
+with the help of do3d_precision .
+In favorable cases the file size can be reduced by
+a factor of up to 5. For the visualization of compressed data a special
+AVS module (read_compressed_field )
+and a further entry in the MRUN-configuration file are needed. More
+details can be found in chapter
+4.5.6 .
+
+
+
+
+
+
+
+
+
+
+
+ 31
+
+
+
+
+
+ PLOT3D_COOR
+
+
+ O
+
+
+
+
+
+ Binary
+
+
+
+
+
+
+
+ Coordinate
+information concerning
+the three-dimensional arrays (see PLOT3D_DATA )
+needed by the visualization software AVS.
+
+
+
+ The
+file PLOT3D_COOR should be saved by the user into the same
+permanent directory as the file PLOT3D_DATA.
+
+
+
+ For
+parallel runs PLOT3D_COOR is written by PE0 only.
+
+
+
+
+
+
+
+
+
+
+
+ 32
+
+
+
+
+
+ PLOT3D_FLD
+
+
+ O
+
+
+
+
+
+ Ascii/
+
+
+AVS-Fld
+
+
+
+
+ AVS-fld-file
+describing the three-dimensional
+array data, saved by the model into the local file PLOT3D_DATA ,
+needed by the visualization software AVS.
+
+
+
+ This
+file describes the structure of the file PLOT3D_DATA
+(e.g. number of arrays, array dimensions, data type etc.). It uses the
+so-called AVS-Fld-format. It also contains the name of the file
+(inclusive cycle number, but without path) under which the local file
+PLOT3D_DATA is saved (this is the file name given in the file
+connection statement of the MRUN – configuration) in the
+permanent
+directory of the user (possibly on remote computers). Under this name
+AVS expects the data which are to be visualized. If there is no file
+connection statement for PLOT3D_DATA indicated in the configuration
+file, that file (filename) is registered “unknown”
+in the file
+PLOT3D_FLD and the
+actual name must be inserted later by hand. The file PLOT3D_FLD should
+be saved by the user in the same permanent directory as PLOT3D_DATA, so
+that AVS can find the file PLOT3D_DATA without any problems. If the two
+files lie in different directories, then the path name of the file
+PLOT3D_DATA must be added.
+
+
+
+ AVS-fld-files
+are expected by AVS to have the
+suffix ".fld ".
+Cycle numbers must not be attached behind this ".fld " suffix.
+This suffix is
+attached to the permanent file names (still after
+possible cycle numbers) by mrun
+if "fld "
+is indicated in the column
+6 of the file connection statement.
+
+
+
+ Likewise,
+AVS expects information about the coordinate
+system underlying the arrays on this file. This information is output
+by the model
+into the local file PLOT3D_FLD_COOR ,
+whose content the user has to append to the file PLOT3D_FLD after the
+end of the model run (e.g. with an appropriate OUTPUT-command in the
+MRUN-configuration file: “cat PLOT3D_FLD_COOR
+>>
+PLOT3D_FLD”).
+
+
+
+ For parallel
+runs, PLOT3D_FLD is produced by PE0 only.
+
+
+
+
+
+
+
+
+
+
+
+ 33
+
+
+
+ PLOT3D_FLD_COOR
+
+
+ O
+
+
+
+
+
+ Ascii/
+
+
+AVS-Fld
+
+
+
+
+ File
+for the description of the coordinate information output
+by the model into the local file PLOT3D_COOR ,
+which is needed for the visualization of three-dimensional array data
+by visualization-software AVS.
+
+
+
+ This
+file describes the structure of the file PLOT3D_COOR
+(e.g. grid spacing, data type etc.) using the so-called AVS-Fld-format.
+It also contains the name of the file (inclusive cycle number, but
+without path) into which the local file PLOT3D_COOR (this is the file
+name described in the file connection statement of the MRUN -
+configuration file) is output in the permanent directory of the user
+(possibly on remote computers). Under this name AVS expects the data
+which are to be visualized. If there is no file connection statement
+for
+PLOT3D_COOR indicated in the configuration file, that file is
+registered as "unknown" in the file
+PLOT3D_FLD_COOR and the actual name
+must be inserted later by hand.
+
+
+
+ AVS
+expects the information contained in the file
+PLOT3D_FLD_COOR, as well as the remaining information about the
+three-dimensional arrays output by the model (see PLOT3D_FLD )
+in one and the same file. This is satisfied by appending the file
+PLOT3D_FLD_COOR after the end of a run are to the
+file PLOT3D_FLD (e.g. with an appropriate OUTPUT-command in the
+MRUN-configuration file: “cat PLOT3D_FLD_COOR
+>>
+PLOT3D_FLD”).
+
+
+
+ For parallel
+runs, PLOT3D_FLD_COOR is written by PE0 only.
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 40
+
+
+
+ and/or
+
+
+possibly
+
+
+
+ 40-49
+
+
+
+
+
+
+
+ PLOT1D_DATA
+
+
+(PLOT1D_DATA_O)
+
+
+
+ and/or
+
+
+possibly
+
+
+PLOT1D_DATA_0
+
+
+PLOT1D_DATA_1
+
+
+...
+
+
+
+
+
+(PLOT1D_DATA_O _0
+
+
+ PLOT1D_DATA_O _1
+
+
+ ...)
+
+
+ O
+
+
+ Ascii
+
+
+
+
+ This file contains
+data (possibly horizontally and/or
+temporally averaged) of the vertical profiles (see data_output_pr )
+written by the model in a format readable by profil .
+It is created only if data_output_format
+= 'profil'
+is assigned. This file's format is suitable to be read by the plot
+software profil .
+Each data point of the profiles is output in one single line (1st
+column: height in m, 2nd column: value of the respective quantity).
+Within the file, data
+of the individual profiles are located one behind the other. The order
+of the data in the file follows the order used in the assignment for data_output_pr
+(data_output_pr = 'u' , 'v' ,…
+means that the file starts with the data of the u-component profile,
+followed by the v-component profile, etc.).
+
+
+
+
+
+
+The data can only be visualized with profil
+using NAMELIST-parameter sets, which are saved by the
+model into the local file PLOT1D_PAR .
+
+
+
+
+ The profile data written to the file are described
+with the
+run parameter data_output_pr .
+Plots produced with these data using the parameter file PLOT1D_PAR do
+not have to contain all these profiles. The profiles which can be drawn
+in the plot are described with run parameter cross_profiles .
+By subsequent editing of the file PLOT1D_PAR all profiles can be
+plotted (also the basic layout of the plots can be
+changed). For orientation, each profile existing on the file
+PLOT1D_DATA, starts with a comment line, which indicates the
+presented variable and the output time. The text of these comment
+lines is used as a legend in the plot. The very first line of the file
+is a
+comment line, containing information about the used model version, the
+run identifier (base file name + number of the respective restart
+run), the name of the executing computer, as well as the date and time
+of the beginning of the run. At the end of this comment line is the
+name
+of the subdomain, to which the profiles belong (see statistic_regions ).
+By default, the profiles present averages of the total model domain. If
+the model has to produce profiles for other subdomains beyond that, up
+to 9 further files (units No. 41-49) are created, whereby the number of
+the respective subdomain is attached
+to the file name (e.g. PLOT1D_DATA_1). The name of the file with the
+data of the total
+domain in this case reads PLOT1D_DATA_0.
+
+
+
+ For
+presentation in the same plot, profile data of the restart
+runs can be attached to existing data of preceding runs of a job chain.
+One can do this with the file attribute tra
+in the file connection statement. The model produces a parameter file
+(PLOT1D_PAR) for these combined data, if the run parameter is set use_prior_plot1d_parameters
+= .T . If this is omitted, then the parameter file
+gives
+wrong plots (i.e. use_prior_plot1d_parameters
+= .T. and "tra "
+must be specified together)!
+
+
+
+ Further
+information about output of
+vertical profile data is given in the description of the run parameter data_output_pr .
+
+
+
+
+
+
+
+
+
+
+
+ 80
+
+
+
+ PARTICLE_INFOS/
+
+
+(PARTICLE_INFOS_O /)
+
+
+
+ O
+
+
+ Ascii
+
+
+ This
+file is created in case of particle transport (see the particles
+package ). It contains statistical informations about the
+number of
+particles used and about the number of particles exchanged between each
+single PE. These informations are output after every timestep if
+switched on by parameter write_particle_statistics .
+
+
+
+
+
+
+
+
+
+ 81
+
+
+
+ PLOTSP_X_PAR
+
+
+(PLOTSP_X_PAR_O)
+
+
+ O
+
+
+ Ascii/
+
+
+NAMELIST
+
+
+ This
+file is created if spectra along x are calculated and output (see the spectra
+package ). It contains the NAMELIST parameter set, with which
+the
+layout of a plot
+of the data in the local file PLOTSP_X_DATA
+can be steered, if these data are plotted with the plot software profil .
+
+
+
+ It contains the so-called RAHMEN (frame)- and
+CROSS-parameter sets (NAMELIST- group names &RAHMEN and/or
+&CROSS )
+needed by profil .
+The user can edit these parameter sets (and thus all details of the
+plot layout) after the run.
+
+
+
+
+
+
+ By default,
+for one quantity, all spectra at different heights
+are plotted into a single panel. Different colors and line styles are
+used for each height. Panels of up to four quantities are arranged on
+one page in two lines (and two columns). More quantities are plotted on
+additional page(s). If there is more than one output time (see dt_dosp ),
+additional pages will be plotted for each single output time.
+
+
+
+
+
+
+
+
+
+
+
+ 82
+
+
+
+
+
+ PLOTSP_X_DATA
+
+
+(PLOTSP_X_DATA_O)
+
+
+ O
+
+
+
+
+
+ Ascii
+
+
+
+
+
+ This
+file is created if spectra along x are calculated and output (see the spectra
+package ). It contains the spectral data along x (see data_output_sp )
+in a format readable by profil .
+The data can only be visualized with profil
+using NAMELIST parameter sets, which are written by
+the model to the local file PLOTSP_X_PAR .
+
+
+
+
+
+Regardless of the (sub)set of spectra specified by plot_spectra_level
+for actual plotting, this file contains all data of spectra specified
+by comp_spectra_level .
+
+
+
+
+
+ Each data point of a spectrum is output in a
+single line
+(1st column:
+wavenumber, 2nd column: spectral coefficient). If spectra are to be
+calculated and output for more than one height (see comp_spectra_level ),
+the spectral coefficients for the further heights can be found in the
+subsequent columns. The order
+of the data in the file follows the order used in the assignment for data_output_sp .
+
+
+
+
+
+For orientation, a header of comment lines (one for each height level)
+is placed in front of the spectral data of each quantity. They indicate
+the respective quantity and the output time. The text of these comment
+lines is used as a legend in the plot.
+
+
+
+
+
+
+
+
+ 83
+
+
+
+
+
+ PLOTSP_Y_PAR
+
+
+(PLOTSP_Y_PAR_O)
+
+
+ O
+
+
+
+
+
+ Ascii
+
+
+
+
+
+ This
+file is created if spectra along y are calculated and output (see the spectra
+package ). It contains the NAMELIST parameter set, with which
+the
+layout of a plot
+of the data in the local file PLOTSP_Y_DATA
+can be steered, if these data are plotted with the plot software profil .
+
+
+
+
+
+For more details see PLOTSP_X_PAR .
+
+
+
+
+
+
+
+
+
+
+
+ 84
+
+
+
+
+
+ PLOTSP_Y_DATA
+
+
+(PLOTSP_Y_DATA_O)
+
+
+ O
+
+
+
+
+
+ Ascii
+
+
+
+
+
+ This
+file is created if spectra along x are calculated and output (see the spectra
+package ). It contains the spectral data along y (see data_output_sp )
+in a format readable by profil .
+The data can only be visualized with profil
+using NAMELIST parameter sets, which are written by
+the model to the local file PLOTSP_Y_PAR .
+
+
+
+
+
+For more details see PLOTSP_X_DATA .
+
+
+
+
+
+
+
+
+ 85
+
+
+
+
+
+ PARTICLE_DATA/
+
+
+(PARTICLE_DATA_O /)
+
+
+ O
+
+
+
+
+
+ Binary
+
+
+
+
+
+ This
+file is created if particle transport is switched on (see the particles
+package ) and contains all particle data for one or several
+output
+times (see dt_write_particle_data ).
+
+
+
+
+
+The first record of this file contains an identification string (PALM
+version number, run identifier, etc., 80 characters long). The second
+record also contains a version string (80 characters long) followed by
+two records with particle group informations (see file check_open.f90 ).
+Then, for each
+output time, two records follow, where the first one gives some general
+information (numbers of particles, etc.) and the second one contains
+the actual particle data. A FORTRAN TYPE structure is used for storing
+the particle attributes. See file advec_particles.f90
+for the detailed format.
+
+
+
+
+
+
+
+
+ 90
+
+
+ PARTICLE_RESTART_
+
+
+DATA_IN/
+
+
+ I
+
+
+
+
+
+ Binary
+
+
+
+
+
+ Binary
+data, which are read in by the model at the beginning
+of a restart run (see chapter
+3.3 ). The appropriate file must have been written by the
+preceding
+job of the job chain (see PARTICLE_RESTART_DATA_OUT ).
+This file is needed if particle transport is switched on (see the particles
+package ) and contains all particle informations (particle
+positions, velocities, etc.) from the end of the preceding run.
+Concerning runs on
+several processors it has to be noted that each processing element
+reads its own file and that the file content is processor-dependent.
+The
+number of processors which can be used must not be changed during a job
+chain and/or if a job chain is continued.
+
+
+
+
+
+The first record of this file contains a version number (four character
+string) of the subroutine, which output the data that follows (write_particles ,
+see end of
+file advec_particles.f90 ).
+This number has to
+agree with the version number of the subroutine which is reading the
+file
+(init_parrticles.f90 )
+in
+case of a restart run. Otherwise the model run
+is aborted. Version numbers are changed whenever new code revisions
+require a change of the file format. Some general informations like the
+number of particles stored in the file, the number of particle groups,
+etc.. are stored in the second record. The third record includes the
+particles to be released at the source and the fourth record contains
+all current particles. In case that particle tails are used (see maximum_number_of_tailpoints ),
+a further record may follow, which contains the particle tail
+informations. A FORTRAN TYPE structure is used for storing the particle
+attributes. For detailed informations about the file format see the
+corresponding READ statements in file init_particles.f90
+.
+
+
+
+
+
+
+
+
+
+
+
+ 90
+
+
+
+
+
+ PARTICLE_RESTART_
+
+
+DATA_OUT/
+
+
+ O
+
+
+
+
+
+ Binary
+
+
+
+
+
+ Binary
+data, which are output at the end of the
+run and possibly needed by restart runs (see chapter
+3.3 ) for the initialization. This output file is then read as
+file PARTICLE_RESTART_DATA_IN .
+The file is only written if particle transport is switched on (see the particles
+package ). For a more detailed description of the file
+structure see PARTICLE_RESTART_DATA_IN .
+
+
+
+
+
+
+
+
+ 90
+
+
+
+
+
+
+
+ PLOT1D_PAR
+
+
+(PLOT1D_PAR_O)
+
+
+
+ and/or
+
+
+possibly
+
+
+
+ PLOT1D_PAR_0
+
+
+PLOT1D_PAR_1
+
+
+
+.
+
+
+
+.
+
+
+
+.
+
+
+PLOT1D_PAR_9
+
+
+
+
+
+
+
+ (PLOT1D_PAR_O _0
+
+
+
+PLOT1D_PAR_O _1
+
+
+
+
+.
+
+
+
+.
+
+
+
+.
+
+
+PLOT1D_PAR_O _9)
+
+
+
+
+
+ O
+
+
+
+
+
+ Ascii/
+NAMELIST
+
+
+
+
+
+
+
+ NAMELIST parameter set, with which the layout of a plot
+of the data in the local file PLOT1D_DATA
+can be steered, if these data are visualized with the plot program profil .
+
+
+
+
+ This file contains the so-called RAHMEN (frame)-
+and
+CROSS-parameter sets (NAMELIST- group names &RAHMEN and/or
+&CROSS )
+needed by profil .
+These parameter sets (and thus all details of the plot layout) can be
+edited after the model run by the user. By default, all profiles of one
+variable saved at different times are drawn into one panel. Different
+colors are used for each output time. Which profiles are drawn
+into which plane and how these planes are arranged on the
+plot, is determined with the parameters cross_profiles ,
+ profile_columns
+and profile_rows .
+
+
+
+
+ The file PLOT1D_PAR is created by the model
+briefly before
+the end of a run. If a model run crashes uncontrolled (run time
+errors or CPU - time exceeded), this file is usually missing, although
+profile data were saved to the file PLOT1D_DATA.
+
+
+
+ If
+the model has to create profiles for different subdomains
+(see statistic_regions ),
+further files are created, whereby the file name includes the number of
+the respective subdomain (e.g. PLOT1D_PAR_1). In this case the name of
+the file with NAMELIST parameters of the total domain is
+PLOT1D_PAR_0.
+
+
+
+ For presentation in the
+same plot, profile data of the restart
+runs can be appended to existing data of preceding runs of a job chain.
+One can do this with the file attribute tra
+in the file connection statement for PLOT1D_DATA. The model produces
+a parameter file PLOT1D_PAR for these combined data, if the run
+parameter is set use_prior_plot1d_parameters
+= .T . If this is omitted, then the parameter file
+gives
+wrong plots (i.e. use_prior_plot1d_parameters
+= .T. and "tra "
+must be specified together)!
+
+
+
+
+
+
+
+
+
+
+
+ 90
+
+
+
+
+
+ PLOT2D_XY_GLOBAL
+
+
+(PLOT2D_XY_GLOBAL_O)
+
+
+ O
+
+
+
+
+
+ Ascii/
+
+
+NAMELIST
+
+
+
+
+ NAMELIST
+parameter set, with which the plot layout
+of the data in local file PLOT2D_XY
+can be steered, if they are visualized with the plot program iso2d .
+This file contains the so-called global parameter set (NAMELIST - group
+name: &GLOBAL) needed by iso2d .
+This parameter set can be edited
+after the model run by the user. By default, the arrays are drawn using
+isolines and each array
+will be drawn onto a separate page (thus no color shading
+presentation, no vector arrows, streamlines etc.).
+
+
+
+ Additionally iso2d
+needs the so-called local parameter
+sets. These are saved by the model to the local file PLOT2D_XY_LOCAL .
+Due to the fact that iso2d
+expects global and local parameter sets on one and the same
+file, in fact the global parameter set first, the user has to append
+the contents of the file PLOT2D_XY_LOCAL to the file PLOT2D_XY_GLOBAL
+before call of iso2d
+(e.g. by
+an OUTPUT - command in the MRUN -
+configuration file: “cat PLOT2D_XY_LOCAL >>
+PLOT2D_XY_GLOBAL”).
+This
+relatively pedantic proceedure is due to the fact that the model can
+create the file PLOT2D_XY_GLOBAL only at the end of the simulation
+(only then, when the final value of the global iso2d -parameter planz
+is known), while the local parameter sets are written continuously
+to the file PLOT2D_XY_LOCAL during the run. Since the file
+PLOT2D_XY_GLOBAL needs to be addressed only briefly once, output-unit
+90 is used, which is also used for other files.
+
+
+
+
+
+
+
+
+
+
+
+ 90
+
+
+
+
+
+ PLOT2D_XZ_GLOBAL
+
+
+(PLOT2D_XZ_GLOBAL_O)
+
+
+ O
+
+
+
+
+
+ Ascii/
+
+
+NAMELIST
+
+
+
+
+ NAMELIST
+parameter set, with which the plot layout of the data
+in the local file PLOT2D_XZ
+can be steered, if they are visualized with the plot program iso2d .
+
+
+
+
+ The description of the local file PLOT2D_XY_GLOBAL
+applies to this file, respectively.
+
+
+
+
+
+
+
+
+
+
+
+ 90
+
+
+
+
+
+ PLOT2D_YZ_GLOBAL
+
+
+(PLOT2D_YZ_GLOBAL_O)
+
+
+ O
+
+
+
+
+
+ Ascii/
+
+
+NAMELIST
+
+
+
+
+ NAMELIST
+parameter set, with which the plot layout of the data
+in the local file PLOT2D_YZ
+can be steered, if they are visualized with the plot program iso2d .
+
+
+
+
+ The description of the local file PLOT2D_XY_GLOBAL
+applies to this file, respectively.
+
+
+
+
+
+
+
+
+
+
+
+ 90
+
+
+ TOPOGRAPHY_DATA
+
+
+ I
+
+
+ Ascii
+
+
+ Two-dimensional topography
+height information
+in m.
+
+
+In case of topography
+= 'read_from_file'
+the subroutine init_grid reads
+the topography height information in m for each grid point in
+a free floating point format. The data on file are laid out naturally,
+i.e. in W-E orientation horizontally and in S-N orientation vertically,
+they must thus be organized as follows:
+
+
+
+
+
+
+ each
+line contains height information in m from i = 0, ..., nx ,
+
+
+ the top line contains height information in m for j = ny (North), the
+bottom line for j = 0
+(South),
+
+
+ individual data must be separated by at
+least one blank.
+
+
+
+
+
+
+Layout sketch:
+
+
+
+
+ N
+
+
+ (0,ny) (1,ny)
+ (2,ny)
+... (nx,ny)
+ top of file
+
+
+
+(0,ny-1) (1,ny-1) (2,ny-1)
+... (nx,ny-1)
+
+
+ W
+(0,ny-2) (1,ny-2) (2,ny-2)
+... (nx,ny-2) E
+
+
+
+
+ :
+
+
+
+
+ :
+
+
+
+
+(0,0) (1,0)
+ (2,0)
+ ... (nx,0)
+ bottom of file
+
+
+
+
+ S
+
+
+ Example for a 50m building surrounded by a 12.5m podium on flat ground:
+
+
+
+ 0 0 0 0 0
+ 0 0 0 0
+ 0 0 0 0 0 12.5 12.5 12.5 12.5 12.5 12.5 12.5 12.5 12.5 12.5 0 0
+ 0 12.5 12.5 12.5 12.5 12.5 12.5 12.5 12.5 12.5 12.5 0 0
+
+ 0 12.5 12.5 50 50 50 50 50
+ 50 12.5 12.5 0 0
+
+ 0 12.5 12.5 50 50 50 50
+50 50 12.5 12.5 0 0
+
+ 0 12.5 12.5 50 50 50 50
+50 50 12.5 12.5 0 0
+ 0 12.5 12.5 50 50 50 50 50 50 12.5 12.5 0 0
+
+ 0 12.5 12.5 50 50 50 50
+50 50 12.5 12.5 0 0
+
+ 0 12.5 12.5 50 50 50 50
+50 50 12.5 12.5 0 0
+ 0 12.5 12.5 12.5 12.5 12.5 12.5 12.5 12.5 12.5 12.5 0 0
+ 0 12.5 12.5 12.5 12.5 12.5 12.5 12.5 12.5 12.5 12.5 0 0
+
+ 0 0 0 0 0
+ 0 0 0 0
+ 0 0 0 0
+
+
+These data must exactly match the horizontal grid. Due to the staggered grid the topography will be displaced by -0.5 dx in x-direction and -0.5 dy in y-direction.
+
+
+Alternatively, the user may add code to the user interface subroutine user_init_grid
+to allow different data formats.
+
+
+
+
+
+
+
+
+
+
+
+ 101
+
+
+ DATA_2D_XY_NETCDF
+
+
+(DATA_2D_XY_NETCDF_O)
+
+
+ I/O
+
+
+ Binary/
+
+
+NetCDF-
+
+
+format
+
+
+ This file
+contains data of the two-dimensional horizontal
+cross sections (see data_output )
+in NetCDF format. The data in this file can be visualized by any
+graphic software which provides a NetCDF interface (e.g. NCL or ferret ).
+
+
+
+
+
+More detailed informations about the PALM-NetCDF-output are given in chapter 4.5.1 .
+
+
+
+
+
+
+
+
+
+
+
+ 102
+
+
+ DATA_2D_XZ_NETCDF
+
+
+(DATA_2D_XZ_NETCDF_O)
+
+
+ I/O
+
+
+ Binary/
+
+
+NetCDF-
+
+
+format
+
+
+ This file
+contains data of the two-dimensional vertical (xz)
+cross sections (see data_output )
+in NetCDF format. The data in this file can be visualized by any
+graphic software which provides a NetCDF interface (e.g. NCL or ferret ).
+
+
+
+
+
+More detailed informations about the PALM-NetCDF-output are given in chapter 4.5.1 .
+
+
+
+
+
+
+
+
+
+
+
+ 103
+
+
+ DATA_2D_YZ_NETCDF
+
+
+(DATA_2D_YZ_NETCDF_O)
+
+
+ I/O
+
+
+ Binary/
+
+
+NetCDF-
+
+
+format
+
+
+ This file
+contains data of the two-dimensional vertical
+(yz) cross sections (see data_output )
+in NetCDF format. The data in this file can be visualized by any
+graphic software which provides a NetCDF interface (e.g. NCL or ferret ).
+
+
+
+
+
+More detailed informations about the PALM-NetCDF-output are given in chapter 4.5.1 .
+
+
+
+
+
+
+
+
+
+
+
+ 104
+
+
+ DATA_1D_PR_NETCDF
+
+
+(DATA_1D_PR_NETCFD_O)
+
+
+ I/O
+
+
+ Binary/
+
+
+NetCDF-
+
+
+format
+
+
+ This file
+contains data of the horizontally averaged vertical profiles (see data_output_pr )
+in NetCDF format. The data in this file can be visualized by any
+graphic software which provides a NetCDF interface (e.g. NCL or ferret ).
+
+
+
+
+
+More detailed informations about the PALM-NetCDF-output are given in chapter 4.5.1 .
+
+
+
+
+
+
+
+
+
+
+
+ 105
+
+
+ DATA_1D_TS_NETCDF
+
+
+(DATA_1D_TS_NETCDF_O)
+
+
+ I/O
+
+
+ Binary/
+
+
+NetCDF-
+
+
+format
+
+
+ This file
+contains data of the timeseries (see dt_dots )
+in NetCDF format. The data in this file can be visualized by any
+graphic software which provides a NetCDF interface (e.g. NCL or ferret ).
+
+
+
+
+
+More detailed informations about the PALM-NetCDF-output are given in chapter 4.5.1 .
+
+
+
+
+
+
+
+
+
+
+
+ 106
+
+
+ DATA_3D_NETCDF
+
+
+(DATA_3D_NETCDF_O)
+
+
+ I/O
+
+
+ Binary/
+
+
+NetCDF-
+
+
+format
+
+
+ This file
+contains data of the 3d-volume data (see data_output )
+in NetCDF format. The data in this file can be visualized by any
+graphic software which provides a NetCDF interface (e.g. NCL or ferret ).
+
+
+
+
+
+More detailed informations about the PALM-NetCDF-output are given in chapter 4.5.1 .
+
+
+
+
+
+
+
+
+
+
+
+ 107
+
+
+ DATA_1D_SP_NETCDF
+
+
+(DATA_1D_SP_NETCDF_O)
+
+
+ I/O
+
+
+ Binary/
+
+
+NetCDF-
+
+
+format
+
+
+ This file
+contains data of the horizontal spectra (see data_output_sp )
+in NetCDF format. The data in this file can be visualized by any
+graphic software which provides a NetCDF interface (e.g. NCL or ferret ).
+
+
+
+
+
+More detailed informations about the PALM-NetCDF-output are given in chapter 4.5.1 .
+
+
+
+
+
+
+
+
+
+
+
+ 108
+
+
+ DATA_PRT_NETCDF/
+
+
+(DATA_PRT_NETCDF_O /)
+
+
+ I/O
+
+
+ Binary/
+
+
+NetCDF-
+
+
+format
+
+
+ This file
+contains particle data (see dt_prel )
+in NetCDF format. The data in this file can be visualized by any
+graphic software which provides a NetCDF interface (e.g. NCL or ferret ).
+
+
+
+
+
+More detailed informations about the PALM-NetCDF-output are given in chapter 4.5.1 .
+
+
+
+
+
+
+
+
+
+
+
+ 109
+
+
+ DATA_1D_PTS_NETCDF
+
+
+(DATA_1D_PTS_NETCDF_O)
+
+
+ I/O
+
+
+ Binary/
+
+
+NetCDF-
+
+
+format
+
+
+ This
+file contains data of the timeseries of particle quantities (see dt_prel )
+in NetCDF format. The data
+in this file can be visualized by any graphic software which provides a
+NetCDF interface (e.g. NCL
+ or
+ferret ).
+For a list of available output quantities see dt_dopts .
+
+
+
+
+
+ In case of
+using more than one particle group (see number_of_particle_groups ),
+seperate time series are output for each of the groups. The long names
+of the variables in the NetCDF file containing the respective
+timeseries all end with the string ' PG ##' , where ## is the number of the particle
+group (01 , 02 , etc.).
+
+
+
+
+
+ More detailed informations about the
+PALM-NetCDF-output are given in chapter
+4.5.1 .
+
+
+
+
+
+
+
+
+
+
+
+ 111
+
+
+ DATA_2D_XY_AV_NETCDF
+
+
+(DATA_2D_XY_AV_NETCDF_O)
+
+
+ I/O
+
+
+ Binary/
+
+
+NetCDF-
+
+
+format
+
+
+ This file
+contains data of the temporally averaged two-dimensional horizontal
+cross sections (see data_output )
+in NetCDF format. The data in this file can be visualized by any
+graphic software which provides a NetCDF interface (e.g. NCL or ferret ).
+
+
+
+
+
+More detailed informations about the PALM-NetCDF-output are given in chapter 4.5.1 .
+
+
+
+
+
+
+
+
+
+
+
+ 112
+
+
+ DATA_2D_XZ_AV_NETCDF
+
+
+(DATA_2D_XZ_AV_NETCDF_O)
+
+
+ I/O
+
+
+ Binary/
+
+
+NetCDF-
+
+
+format
+
+
+ This file
+contains data of the temporally
+averaged two-dimensional vertical (xz)
+cross sections (see data_output )
+in NetCDF format. The data in this file can be visualized by any
+graphic software which provides a NetCDF interface (e.g. NCL or ferret ).
+
+
+
+
+
+More detailed informations about the PALM-NetCDF-output are given in chapter 4.5.1 .
+
+
+
+
+
+
+
+
+
+
+
+ 113
+
+
+ DATA_2D_YZ_AV_NETCDF
+
+
+(DATA_2D_YZ_AV_NETCDF_O)
+
+
+ I/O
+
+
+ Binary/
+
+
+NetCDF-
+
+
+format
+
+
+ This file
+contains data of the temporally
+averaged two-dimensional vertical
+(yz) cross sections (see data_output )
+in NetCDF format. The data in this file can be visualized by any
+graphic software which provides a NetCDF interface (e.g. NCL or ferret ).
+
+
+
+
+
+More detailed informations about the PALM-NetCDF-output are given in chapter 4.5.1 .
+
+
+
+
+
+
+
+
+
+
+
+ 116
+
+
+ DATA_3D_AV_NETCDF
+
+
+(DATA_3D_AV_NETCDF_O)
+
+
+ I/O
+
+
+ Binary/
+
+
+NetCDF-
+
+
+format
+
+
+ This file
+contains data of the temporally
+averaged 3d-volume data (see data_output )
+in NetCDF format. The data in this file can be visualized by any
+graphic software which provides a NetCDF interface (e.g. NCL or ferret ).
+
+
+
+
+
+More detailed informations about the PALM-NetCDF-output are given in chapter 4.5.1 .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Last change:
+$Id$
+
+
+
+
+
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_3.5.1.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_3.5.1.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_3.5.1.html (revision 141)
@@ -0,0 +1,334 @@
+
+
+PALM chapter 3.5.1
+3.5.1 Interfaces for
+user-defined code
+ The
+following table
+describes the available interfaces for user-defined code in the model,
+the
+names and possible arguments of the subroutines involved as well as
+actions which can be accomplished in these subroutines.
+
+ Call
+location
Subroutine
+name and
+argument
Possible
+actions
--- MODULE
+userAll
+user-defined variables which are used outside the respective local
+scopes of the user-defined subroutines have to be declared here. End
+of parin.f90
+ user_parin
+ Declaration of
+user-defined parameters in the NAMELIST
+group &userpar .
+These
+parameters can be read from the local file PARIN
+and be used for steering the user-defined code (see chapter
+4.0 ). The user-defined parameter region
+is already pre-defined in &userpar
+and must not be changed. Additional NAMELIST groups may be declared if
+desired.
+The CPU time needed for executing user_parin
+is included in the
+local file CPU_MEASURES
+within the category “initialisation”.
+ End
+of header.f90
+
+ user_header(
+io )
Output of the values of the
+user-defined parameters to
+the
+local files HEADER
+and RUN_CONTROL .
+This output should be made anyway in order to subsequently check the
+parameter values used for the respective run. The number of the output
+unit is passed as an argument and must be used in each WRITE statement
+(e.g.: “WRITE ( io,… ”)) .
+By default, this
+subroutine only creates output if a user-defined NAMELIST is found in
+file PARIN
+(in this case the
+variable user_defined_namelist_found
+is set .TRUE. in user_parin ).
+The names of any
+user-defined
+subdomains are displayed by default (see statistic_regions ).
+ End of init_3d_model.f90
+ user_init
+ Here, user-defined
+initialization actions which should
+be
+accomplished before the start of the 3D-model can be implemented (e.g.
+inhomogenous change of the surface temperature, the roughness length,
+or similar). At this point, all default parameter initializations of
+the model (chapter
+4.1 ) have already been carried out at all.
+One of the most important actions here is the definition
+of
+user-defined subdomains for statistic analysis and output (see statistic_regions
+and chapter
+3.5.3 ) and of additional time series quantities (see comment
+line example in the file).
+CPU time for user_init
+is considered in the local file CPU_MEASURES
+within the category “initialisation”.
See
+also user_init_3d_model .
+ DEFAULT
+case of SELECT
+CASE( TRIM(canopy_mode) ) command in the
+middle of init_3d_model.f90 user_init_plant_canopy
User-defined initilisation of the plant canopy model. Here, the user can define the two three-dimensional arrays lad_s and cdc
that
+stand for the leaf area density and the canopy drag coefficient. By
+this, the user can configure a plant canopy. This requires
+definition of at least one
+new canopy_mode in the SELECT CASE( TRIM(canopy_mode) ) command
+in user_init_plant_canopy .
+Note that the canopy_mode 'block' is not allowed here since it is the standard case used in the
+calling routine init_3d_model . DEFAULT
+case of SELECT
+CASE( TRIM(topography) ) command in the
+middle of init_grid.f90 user_init_grid
+ Execution of user-defined grid initializing
+actions.
Here, the user can define the
+two-dimensional index
+array nzb_local that is used to
+set up a non-flat topography. This requires definition of at least one
+new topography mode
+in the SELECT CASE( TRIM(topography) ) command
+in user_init_grid .
+Note that the topography modes
+'flat'
+and 'single_building'
+are not allowed here since these are the standard cases used in the
+calling routine init_grid .
CPU
+time for user_init_grid
+is considered in the local file CPU_MEASURES
+within the category “initialisation”.
+ In
+the middle of init_3d_model.f90 user_init_3d_ modelInitialization of the 3d-model. Allows
+the complete initialization of the 3d model. The user is responsible to
+set at least all those quantities which are normally set within init_3d_model . In
+the middle of init_particles.f90
+ user_init_ particles
+ With this routine
+e.g. size and color of particles,
+which have
+been released initially from a source, can be specified. Like the
+calling routine init_particles ,
+this routine is only
+called if particle advection is switched on (see package parameter dt_prel ).
+ End of advec_particles.f90
+ user_particle_ attributes
+ Here the particles
+can be assigned new attributes
+(diameter,
+color etc.) after each time step. Like the calling routine advec_particles , this
+routine is only
+called if particle advection is switched on (see package parameter dt_prel ).
+ Before the plot of particles and
+cross-sections in dvrp_plot.f90
+ user_dvrp_coltab
+( mode )
+ With this routine,
+color tables can be adjusted which
+should
+be used for output with the dvrp software. Individuell color tables for
+particles and cross-sections are possible. For this purpose the two
+arrays interval_values_dvrp
+and interval_h_dvrp
+(declared in the module dvrp_variables )
+have to be preset with appropriate values. The number of color table
+entries must be assigned to the variable of dvrp_colourtable_entries .
+The value of the subroutine argument mode defines,
+whether the color
+table is valid for particles or for cross-sections (i.e. mode
+can have the values “particles”
+or “slicer” ).
+This routine only becomes active if dvrp-graphics is switched on (see
+package parameter dt_dvrp ).
+ Beginning and end of the time
+integration loop
+of time_integration.f90
+as well as after each prognostic equation in prognostic_equations.f90
+ user_actions(
+location )
+or
+
user_actions(
+i, j, location )
+ In this routine
+user actions can be implemented which
+are to
+be executed either at each time step or at certain times (defined by
+the user). Since in each case the routine is called at the beginning
+and at the end of a time step as well as after each prognostic equation
+it must be defined at which place (and/or at which places) the
+respective actions are supposed to be executed. For this purpose an
+appropriate CASE structure is already inserted in this routine. The
+location of the calling routine is passed to this routine via the
+argument location .
+For example, if called at the beginning of a time step, location
+= 'before_timestep' and if
+called at the end, location = 'after_timestep' .
Calculation
+of user-defined output quantities should be carried out at location = 'after_integration' .
Important:
+if the
+cache-optimized version of prognostic_equation.f90
+is used (this is the default for IBM-Regatta-Systems), the loop
+variables i and j must be
+passed as arguments for
+all calls within prognostic_equations .
+
CPU time for user_actions
+appears within the category “user_actions” in the
+local file CPU_MEASURES .
+If the cache-optimized version of prognostic_equation.f90
+is used, this time measurement only considers the CPU time which was
+needed outside of the prognostic equations. Time needed for calls
+within prognostic_equations is considered within the category "all
+prog.equations".
Important:
+this subroutine is written
+as a FORTRAN
+module, which uses so-called function overloading. It can be called in
+two ways: with one argument (location )
+and with three arguments ( i, j, location ) . The
+three argument version
+is used in the cache-optimized version of prognostic_equations .
+Depending
+on the number of given arguments the subroutine internally calls user_actions
+or user_actions_ij .
+So the
+user must insert the actions (code extensions) desired for the
+respective prognostic equation either in the CASE structure of user_actions , or/and
+in the CASE
+structure of user_actions_ij !
+ flow_statistics.f90
+before the summation of array hom
+(horizontal averages)
user_statistics (
+sr )
Horizontal
+averages of vertical profiles of user-defined
+quantities can be computed here. Also, additional time series
+quantities can be calculated. They have to be defined before in routine
+user_init .
+The routine is called once for each defined statistic region (see statistic_region ).
The
+routine contains some simple examples (as comment lines) in order to
+demonstrate how to use it. Profile sums have to
+be stored in
+the array sums_l . The profile identification number (second index of array sums_l ) must be within the range [ pr_palm+1 , pr_palm+max_pr_user ], where pr_palm is an internal parameter and max_pr_user is the number of user-defined profiles as given by parameter data_output_pr_user in the respective PALM run.
These additional
+profiles
+are further processed (e.g. temporally averaged), like the standard profiles, in flow_statistics .
+ End
+of check_parameters.f90
+where 2d/3d output quantities are checked user_check_data_ output(
+variable, unit )Here the physical unit (s) of
+user-defined 2d/3d output quantities (see data_output_user )
+have to be set. Input parameter variable
+contains the string identifier of the respective variable. For those
+variables not recognized by the user, the parameter unit is set to
+"illegal", which tells the calling routine that the output variable is
+not defined and leads to a program abort. See chapter 3.5.4 about
+creating user-defined output quantities. End
+of check_parameters.f90
+where vertical profile output quantities are checked user_check_data_ output_pr( variable, var_count, unit ) Here the physical unit (s) and vertical grid (u- or w-grid) of
+user-defined vertical profile output quantities (see data_output_pr_user )
+have to be set. Input parameter variable
+contains the string identifier of the respective variable. Parameter var_count contains the internal profile number and must not be changed by the user. For those
+variables not recognized by the user, the parameter unit is set to
+"illegal", which tells the calling routine that the output variable is
+not defined and leads to a program abort. See chapter 3.5.4 about
+creating user-defined output quantities. netcdf.f90 (4
+times) where the vertical grid coordinates for cross sections and
+volume data are defined user_define_ netcdf_grid(
+variable, found, grid_x, grid_y, grid_z )Set the grid on which
+user-defined output quantities (see data_output_user )
+are defined. Input parameter variable
+contains the string identifier of the respective variable. Allowed
+values are 'x'
+and 'xu'
+for grid_x ,
+'y' and 'yv' for grid_y , and 'zu' and 'zw' for grid_z . The
+output parameter found
+has to be set .TRUE.
+by the user, otherwise an error message will appear in the job protocol
+for the respective output quantity.Example: If
+an output quantity is defined at the center of the grid boxes, the
+following settings have to be used:grid_x = 'x' grid_y = 'y' grid_z = 'zu' found = .TRUE.
For
+defining an output quantity at the grid points where the
+u-velocity-component is defined, please usegrid_x = 'xu' grid_y = 'y' grid_z = 'zu' found = .TRUE.
See
+chapter 3.5.4 about
+creating user-defined output quantities. Middle of data_output_2d.f90 user_data_ output_2d(
+av, variable, found, grid, local_pf )Resorts user-defined quantities
+(to be output as cross-section data; see data_output_user )
+with indices (k,j,i) to a temporary array local_pf with
+indices (i,j,k) and sets the grid
+on which they are defined. Depending on the value of input parameter av resorting is
+done for instantaneous (av =0 ) or time averaged
+data (av =1 ). Input parameter
+variable
+contains the string identifier of the respective variable. Allowed
+values for grid
+are 'zu'
+and 'zw' .
+The output parameter found
+has to be set .TRUE.
+by the user, otherwise an error message will appear in the job protocol
+for the respective output quantity. See chapter 3.5.4 about
+creating user-defined output quantities. data_output_3d.f90
+at the end of the CASE structure user_data_ output_3d(
+av, variable, found, local_pf, nz_do )Resorts user-defined quantities
+(to be output as volume data; see data_output_user )
+with indices (k,j,i) to a temporary array local_pf with
+indices (i,j,k) and sets the grid
+on which they are defined. Depending on the value of input parameter av resorting is
+done for instantaneous (av =0 ) or time averaged
+data (av =1 ). Input parameter
+variable
+contains the string identifier of the respective variable . The input
+parameter nz_do
+defines the upper limit of vertical grid index k of the output array
+(see nz_do3d ).
+The output parameter found
+has to be set .TRUE.
+by the user, otherwise an error message will appear in the job protocol
+for the respective output quantity. See chapter 3.5.4 about
+creating user-defined output quantities. End of average_3d_data.f90 ,
+middle and end of sum_up_3d_data.f90 user_3d_data_ averaging(
+mode, variable )Sum up and time-average of
+user-defined output quantities (see data_output_user )
+as well as allocation of the arrays necessary for storing the
+respective averages. Input parameter variable
+contains the string identifier of the respective variable. Depending on
+the requested action, input parameter mode has the
+value 'allocate' ,
+'sum' , or 'average' . See
+chapter 3.5.4 about
+creating user-defined output quantities. DEFAULT
+case of SELECT
+CASE(
output_variable
) command near the end of data_output_dvrp.f90
user_data_ output_dvrp( output_variable, local_pf )
Resorts user-defined quantities
+(to be output as dvrp objects; see data_output_user and mode_dvrp )
+with indices (k,j,i) to a temporary array local_pf with
+indices (i,j,k). The array local_pf is then handed back to the calling subroutine data_output_dvrp.f90
. See
+chapter 3.5.4 about
+creating user-defined output quantities. End
+of palm.f90
+ user_last_ action
+ User-defined
+actions which are to be executed at the end
+of a
+model run. When user_last_actions
+is called all model actions are already completed, but the files opened
+by the model are not closed yet and possibly terminating actions for
+these files (see subroutine of close_files )
+are also not carried
+out yet.
+CPU time for user_last_actions
+appears in the local file CPU_MEASURES
+within the category “last actions” (the time
+necessary for close_files is included).
+
+
Last
+change: $Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_3.5.2.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_3.5.2.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_3.5.2.html (revision 141)
@@ -0,0 +1,77 @@
+
+
+PALM
+chapter 3.5.2
+ 3.5.2 Definition of
+user-defined
+parameters
+As for the model in general,
+also the
+user-defined code will have to be steered by parameters. For each
+run the model should to be able to read in current values of these
+parameters. The declaration of user-defined parameters takes place in
+the user-defined module user
+(located at the beginning of the file user_interface.f90 ).
+This module must be declared in all relevant user-defined routines via
+a USE statement, in order to make the parameters available.
+The user can assign values
+to the
+user-defined parameters within the NAMELIST group &userpar
+in
+the local file
+PARIN .
+This NAMELIST group must be located after the initialization
+parameters and run parameters (&inipar ,
+ &d3par )
+(see chapter
+4.0 ). Before values of the user-defined parameters can be
+assigned,
+the parameters must be declared within the appropriate NAMELIST
+statement in the user-defined subroutine user_parin .
+
+The following example
+illustrates the
+procedure. The example assumes that the user declares a
+LOGICAL variable named abcd
+for steering the user-defined code. This variable
+must be declared in the module user :
+Pay attention
+that in this example a
+default value (.FALSE.) is assigned to the variable and it will keep
+this value if nothing else is assigned within the file PARIN .
+In user_parin
+the
+NAMELIST must be extended by the name of the new variable:
+ NAMELIST /userpar/
+ abcd, data_output_user, region.
+ In the parameter
+file PARIN a value can
+be assigned:
+ .
+. &userpar abcd = .T., ...
+ User defined
+parameters in the file PARIN
+are
+considered as run parameters, i.e. they must be specified again for
+each restart run.
+In each case the user should
+carry out
+a control output of the parameter values, so
+that their values during the respective model run are really known. For
+this
+purpose the user-defined subroutine user_header
+which writes into the files HEADER
+and RUN_CONTROL
+is available.
+
+
+
+
Last
+change: $Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_3.5.3.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_3.5.3.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_3.5.3.html (revision 141)
@@ -0,0 +1,108 @@
+
+
+PALM chapter 3.5.3
+3.5.3 Definition of user-defined
+subdomains
+By default, the values of
+the timeseries quantities and the horizontally averaged vertical
+profiles (saved in local files
+PLOT1D_DATA
+and LIST_PROFIL )
+always refer to the total model domain. Independently, up to 9 time
+series or profiles for different user-defined subdomains can be
+computed and plotted additionally. Steering in principle is done
+via the initialization parameter statistic_regions .
+
+The exact definition of
+these subdomains
+has to be made by the user within the user-defined subroutine
+init_user .
+The
+subdomains are defined with a mask array named rmask ,
+which has to be given the value 1.0 for all horizontal grid points
+belonging to
+the user-defined subdomain and the value 0.0, where grid points do not
+belong
+to the user-defined subdomain. In the model rmask
+is
+declared as:
+ REAL :: rmask
+(nys-1:nyn+1,nxl-1:nxr+1,0:9) .
+ The first two
+indices are the grid point
+indices in y and x-direction. With parallel model runs nxl ,
+ nxr ,
+ nys
+and nyn
+are the array bounds of the respective subdomain (don't confuse this
+with the user-defined subdomain!) on the
+respective processor. With runs on one processor nys
+= nxl
+= 0 and nxr
+= nx
+and nyn
+= ny .
+The third index determines the user-defined subdomain. The total model
+domain
+carries the index 0, the user-defined subdomains have the values 1 to
+9.
+The following example should
+illustrate
+this. Two subdomains are defined by the user. The first is determined
+by all grid
+points which lie within a circle whose center is equal to the
+(horizontal) center of the model domain and whose diameter is equal
+to half of the total horizontal domain size (square total domain
+assumed).
+The second subdomain should be defined by all points outside of this
+domain. This may be obtained by the following lines of code in user_init :
+
+ USE
+grid_variables USE indices USE statistics . . . disc_center_x = dx * (nx + 1)/2 disc_center_y = dy * (ny + 1)/2 disc_radius = 0.5 *
+disc_center_x DO i = nxl-1, nxr+1 x = i * dx
+
+DO j = nys-1, nyn+1
+y = j * dy
+radial_distance = SQRT( ( x - disc_center_x )**2 + &
+( y - disc_center_y )**2 )
+ IF ( radial_distance
+> disc_radius ) THEN
+rmask(j,i,1) = 0.0
+rmask(j,i,2) = 1.0
+ELSE
+rmask(j,i,1) = 1.0
+rmask(j,i,2) = 0.0
+ENDIF ENDDO ENDDO
+ The module statistics must
+be used,
+because it contains rmask
+and the modules grid_variables
+and indices
+are
+necessary in this example, because grid spacing and indices are used.
+All array elements of rmask
+(rmask(:,:,:) )
+are preset
+by the model with 1.0. In no case this assignment must be
+changed for the total domain (rmask(:,:,0) )!
+Computations and output for the user-defined subdomains only take place
+if
+the user sets statistic_regions
+≥ 1 . Beyond that, names for the user-defined
+subdomains can be
+assigned
+via the initialization parameter region .
+Output of the names of the selected user-defined subdomains happens in
+the local files HEADER
+and RUN_CONTROL
+within the user-defined subroutine user_header .
+
+
+
+
Last change:
+$Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_3.5.4.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_3.5.4.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_3.5.4.html (revision 141)
@@ -0,0 +1,232 @@
+
+
+PALM chapter 3.5.4
+3.5.4
+User-defined output quantities
+ A very typical request of users is the
+calculation and
+output of
+quantities which are not part of PALM's standard output. The basic user
+interface includes a number of subroutines which allow the calculation
+of user-defined quantities and output of these quantities as 1. (horizontally averaged) vertical profiles , 2. time series , 3. 2d cross
+section or 3d volume data and 4. dvrp objects. The respective subroutines
+contain sample code lines (written as comment lines) for defining, calculating and
+output of such quantities. Output times, averaging intervals, etc. are steered by the same variables as used for the standard PALM output quantities, e.g. dt_data_output . The
+rest of this chapter explains step-by-step how to modify/extend the
+default file user_interface.f90 in order to generate the respective output. 1. Output of vertical profiles This example shows the output of the
+quantity "turbulent resolved-scale horizontal momentum flux" (u*v*). If more than one user-defined
+quantity shall be output, the following steps have to be carried out in the
+same way for each of the quantities.The
+quantity has to be given a unique string identifier, e.g. 'u*v*' .
+This identifier must be different from the identifiers used for the
+PALM standard output (see list in description of parameter data_output_pr ).
+To switch on output of this quantity, the user has to assign the string
+identifier to the parameter data_output_pr_user ,
+eg.:
+ data_output_pr_user = 'u*v*' , For
+the
+quantity, an identification number, a physical unit, and the vertical
+grid on which it is defined (u- or w-grid), has to be assigned (subroutine user_check_data_output_pr ): CASE (
+'u*v*' ) index = pr_palm + 1
+
+
+ ! identification number dopr_index(var_count) = index dopr_unit(var_count) = 'm2/s2 '
+
+ ! physical unit hom(:,2,index,:) = SPREAD( zu , 2, statistic_regions+1 ) ! vertical grid Here only the those parts in red color have to be given by the user appropriately. The identification number (index ) must be within the range [ pr_palm+1 , pr_palm+max_pr_user ], where max_pr_user is the number of user-defined profiles as given by parameter data_output_pr_user in the respective PALM run. The physical unit has to be given with respect to the NetCDF conventions. If no unit is given,
+PALM will abort. The vertical grid has to be either zu (u-grid) or zw (w-grid). The quantity has to be calculated for all gridpoints (subroutine user_statistics ): !$OMP DO DO i = nxl, nxr DO j = nys, nyn DO k = nzb_s_outer(j,i)+1, nzt sums_l(k,pr_palm+1 ,tn) = sums_l(k,pr_palm+1 ,tn) + & ( 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,sr) ) * &
+( 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,sr) ) * &
+* rmask(j,i,sr) ENDDO ENDDO ENDDO Once again, only those parts in red have to be adjusted by the user. The
+turbulent resolved-scale momentum flux u*v* is defined as the product
+of the deviations of the horizontal velocities from their respective
+horizontally averaged mean values. These mean values are stored in
+array hom(..,1,1,sr) and hom(..,1,2,sr) for the u- and v-component, respectively. Since due to the staggered grid, u and v
+are not defined at the same gridpoints, they have to be interpolated
+appropriately (here to the center of the gridbox). The result of the
+calculation is stored in array sums_l .
+The second index of this array is the identification number of the
+profile which must match the one given in the previous step 2. 2. Output of timeseries This example shows the output of two time series for the absolut extremal values of the horizontal velocities u and v . If more than one user-defined
+quantity shall be output, the following steps have to be carried out in the
+same way for each of the quantities.For each time series quantity you have to give a label and a unit (subroutine user_init ), which will be used for the NetCDF file. They must not contain more than seven characters. The value of dots_num
has to be increased by the number of new time series quantities. Its old value has to be stored in dots_num_palm
. dots_label(dots_num+1 ) = 'abs_umx ' dots_unit(dots_num+1 ) = 'm/s ' dots_label(dots_num+2 ) = 'abs_vmx ' dots_unit(dots_num+2 ) = 'm/s ' dots_num_palm = dots_num dots_num = dots_num + 2
Only those parts in red have to be adjusted by the user. These quantities are calculated and output in subroutine user_statistics for every statistic region sr
defined by the user, but at least for the region "total domain" : ts_value(dots_num_palm+1,sr) = ABS( u_max ) ts_value(dots_num_palm+2,sr) = ABS( v_max )
3. Output of 2d cross sections or 3d volume data This example shows the output of the
+quantity "square of the u-component" (Note: this quantity
+could of course easily be calculated from the u-component by
+postprocessing the PALM output so that calculation within PALM is not
+necessarily required). If more than one user-defined
+quantity shall be output, the following steps have to be carried out in the
+same way for each of the quantities.The
+quantity has to be given a unique string identifier, e.g. 'u2' .
+This identifier must be different from the identifiers used for the
+PALM standard output (see list in description of parameter data_output ).
+To switch on output of this quantity, the user has to assign the string
+identifier to the parameter data_output_user ,
+eg.:
+ data_output_user = 'u2' , 'u2_xy_av' The
+pure string 'u2'
+switches on the output of instantaneous 3d volume data. Output of cross
+section data and time averaged data is switched on by additionally
+appending the strings '_xy' ,
+'_xz' , '_yz' , and/or '_av' (for a
+detailed explanation see parameter data_output ). In
+order to store the quantities' grid point data within PALM, a 3d data
+array has to be declared in module user : REAL,
+DIMENSION(:,:,:), ALLOCATABLE :: u2, u2_av The
+second array u2_av
+is needed in case that output of time averaged data is requested. It is
+used to store the sum of the data of the respective time levels over
+which the average has to be carried out. The
+data array has to be allocated in subroutine user_init :
+ALLOCATE( u2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) In
+case that output of time averaged data is requested, the array
+containing the sum has possibly to be read from the restart file (local
+filename BININ )
+by executing the following code in user_init :
+ IF ( initializing_actions == 'read_restart_data' )
+THEN
+ READ ( 13 ) field_chr
+ DO WHILE ( TRIM( field_chr ) /= '*** end
+user ***' )
+ SELECT CASE ( TRIM( field_chr ) )
+ CASE ( 'u2_av' )
+ ALLOCATE(
+u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) u2_av
+ CASE DEFAULT
+ PRINT*,
+'+++ user_init: unknown
+variable named "', &
+
+
+TRIM(
+field_chr ), '" found in'
+ PRINT*,
+'
+data from prior run on PE ', myid
+
+ CALL local_stop
+ END SELECT
+ ENDDO
+ ENDIF The
+quantity has to be given a unit (subroutine user_check_data_output ): CASE (
+'u2' )
+ unit = 'm2/s2' Otherwise,
+PALM will abort. The
+vertical grid on which the quantity is defined (given by the levels
+'zu' or 'zw', on which the u- or w-component of the velocity are
+defined) has to be specified for the NetCDF output files in subroutine user_define_netcdf_grid :
+ CASE ( 'u2', 'u2_xy', 'u2_xz', 'u2_yz' )
+ grid = 'zu' As
+the example shows, this grid has to be defined for the 3d volume data
+as well as for all of the three cross sections. After
+each timestep, the quantity has to be calculated at all gridpoints and
+to be stored. This has to be done in subroutine user_actions
+at location 'after_integration': CASE
+( 'after_integration' ) ! !--
+Enter actions to be done after every time integration (before !--
+data output) !--
+Sample for user-defined output:
+DO i = nxl-1, nxr+1
+DO j = nys-1, nyn+1
+DO k = nzb, nzt+1
+u2(k,j,i) = u(k,j,i)**2
+ENDDO
+ENDDO
+ENDDO In
+case that output of time-averaged data is requested, the sum- and
+average-operations as well as the allocation of the sum-array have to
+be carried out in subroutine user_3d_data_averaging :
+IF ( mode == 'allocate' ) THEN
+...
+CASE ( 'u2' )
+IF ( .NOT. ALLOCATED( u2_av ) ) THEN
+ALLOCATE( u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ENDIF
+u2_av = 0.0 ...
+ELSEIF ( mode == 'sum' ) THEN
+... CASE
+( 'u2' )
+DO i = nxl-1, nxr+1
+DO j = nys-1, nyn+1
+DO k = nzb, nzt+1
+u2_av(k,j,i) = u2_av(k,j,i) + u2(k,j,i)
+ENDDO
+ENDDO
+ENDDO ...
+ELSEIF ( mode == 'average' ) THEN
+ ... CASE
+( 'u2' )
+DO i = nxl-1, nxr+1
+DO j = nys-1, nyn+1
+DO k = nzb, nzt+1
+u2_av(k,j,i) = u2_av(k,j,i) / REAL( average_count_3d )
+ENDDO
+ENDDO
+ENDDO For
+output of 2d cross sections, the gridpoint data of the quantity has to
+be resorted to array local_pf
+in subroutine user_data_output_2d .
+Also the vertical grid, on which the quantity is defined, has to be set
+again: CASE
+( 'u2_xy', 'u2_xz', 'u2_yz' )
+IF ( av == 0 ) THEN
+DO i = nxl-1, nxr+1
+DO j = nys-1, nyn+1
+DO k = nzb, nzt+1
+local_pf(i,j,k) = u2(k,j,i)
+ENDDO
+ENDDO
+ENDDO
+ELSE
+DO i = nxl-1, nxr+1
+DO j = nys-1, nyn+1
+DO k = nzb, nzt+1
+local_pf(i,j,k) = u2_av(k,j,i)
+ENDDO
+ENDDO
+ENDDO
+ENDIF
+grid = 'zu' The ELSE case is
+only needed in case that output of time-averaged data is requested. For
+output of 3d volume data, the gridpoint data of the quantity has to be
+resorted to array local_pf
+in subroutine user_data_output_3d .: CASE
+( 'u2' )
+IF ( av == 0 ) THEN
+DO i = nxl-1, nxr+1
+DO j = nys-1, nyn+1
+DO k = nzb, nz_do
+local_pf(i,j,k) = u2(k,j,i)
+ENDDO
+ENDDO
+ENDDO
+ELSE
+DO i = nxl-1, nxr+1
+DO j = nys-1, nyn+1
+DO k = nzb, nz_do
+local_pf(i,j,k) = u2_av(k,j,i)
+ENDDO
+ENDDO
+ENDDO
+ENDIF The ELSE case is
+only needed in case that output of time-averaged data is requested. In
+case of job chains, the sum array has to be written to the (binary)
+restart file (local filename BINOUT )
+in subroutine user_last_actions :
+IF ( ALLOCATED( u2_av ) ) THEN
+WRITE ( 14 )
+'u2_av
+'; WRITE ( 14 ) u2_av
+ENDIF Otherwise, the calculated
+time-average may be wrong. 4. Output of DVRP objects This example shows the output of the
+quantity "square of the u-component", u2 . If more than one user-defined
+quantity shall be output, the following steps have to be carried out in the
+same way for each of the quantities. First, steps 1 - 6 of 2d cross
+section or 3d volume data are required. Second, the gridpoint data of the quantity has to
+be resorted to array local_pf
+in subroutine user_data_output_dvrp as follows: CASE ( 'u2 ', 'u2 _xy', 'u2 _xz', 'u2 _yz' ) DO i = nxl, nxr+1 DO j = nys, nyn+1 DO k = nzb, nz_do3d local_pf(i,j,k) = u2 (k,j,i) ENDDO ENDDO ENDDO
Only those parts in red have to be adjusted by the user. After performing these steps, the user-defined quantity 'u2'
can be selected like standard model quantities by the dvrp_graphics package parameter mode_dvrp .
+
+Last
+change: $Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_3.5.5.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_3.5.5.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_3.5.5.html (revision 141)
@@ -0,0 +1,50 @@
+
+
+PALM
+chapter 3.5.5
+3.5.5
+Compiling and
+linking user-defined code
+ Users
+can add their own (modified) user-interface to a PALM-run by carrying
+out the following steps:
Copy the default
+(empty) user-interface (file
+user_interface.f90 ) to a directory of your choice, e.g.:
+ cd ~/palm/current_version
+ mkdir -p USER_CODE/example
+ cp trunk/SOURCE/user_interface.f90
+USER_CODE/example/user_example.f90 Set
+an additional path in the configuration file
+.mrun.config to allow mrun
+ to find and include this file:
+ %add_source_path
+$base_directory/USER_CODE/$fname The
+default configuration file (trunk/SCRIPTS/.mrun.config.default )
+already includes this setting. Modify the interface
+routines according to your needs. Start a PALM run
+by executing
+ mrun -d example ... The file
+user_example.f90 will be automatically compiled within
+the job and will replace PALM‘s default user-interface. The
+above method with including $fname in
+the additional source path allows to use different user-interfaces for
+different runs at the same time. Just store the respective
+interface-files in subdirectories
+USER_CODE/abcd ,
+USER_CODE/cdef , etc. and start mrun with option
+“-d
+abcd “, “-d cdef “,
+etc.The
+modified user-interface file cannot be pre-compiled by using mbuild! While
+programming user-defined code,
+errors are frequently made. Possible ways of error
+tracing are described in the next chapter.
+
+
+
Last change:
+$Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_3.5.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_3.5.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_3.5.html (revision 141)
@@ -0,0 +1,96 @@
+
+
+PALM chapter 3.5
+3.5 Programming of user-defined
+code
+extensions
+ Programming
+user-defined code
+extensions usually requires exact knowledge of the internal structure
+of PALM.
+Appropriate explanations in chapter
+2.0 and the technical documentation are usually not
+sufficient
+and must be supplemented by the rigorous study of the source code of
+the model. Programming experiences with FORTRAN95 and if necessary
+experiences with the parallelization tool MPI are absolutely
+neccessary!
+Changes of the standard
+model code by the
+user
+should be avoided whenever possible and are reserved to the
+developer-group of PALM. The corrections, revisions and extensions of
+the
+model accomplished by this group are published in the
+technical/numerical
+documentation and the accordingly updated source files are
+accessible to the users (see chapter
+5.1 ).
+However, the user frequently
+may feel the
+need to make extensions of the model code for his/her own simulations.
+For this purpose, a set
+of interfaces is available, which can be used to add user-defined code
+to the model. This
+chapter describes the programming of such user-defined code extensions.
The integration of user-defined
+code
+occurs in the form of subroutine calls, which are made at a set of
+places in the model code, by default. These subroutines have
+pre-defined names, which must not be changed by the user. Their basic
+versions are a component of the standard model
+code and they are all included in the source code file
+user_interface.f90 .
+The basic versions
+accomplish nearly no
+actions, thus they are pure templates, which can be extended by the
+user as required. Actions which are already accomplished in these
+basic versions by default should not be changed. Here is an example
+of such a basic version:
+
+SUBROUTINE user_init !------------------------------------------------------------------------------ ! ! ! Description: ! ----------- ! Execution of user-defined initializing actions !------------------------------------------------------------------------------ ! USE control_parameters USE user IMPLICIT NONE ! !-- Here the user defined initializing actions follow: END SUBROUTINE user_init The communication (handling of
+variables)
+with the model occurs via the
+global variables, which are defined within the individual FORTRAN -
+modules of PALM. The appropriate modules (they are all in the
+source code file modules.f90 )
+must be declared by means of USE
+statements in the
+user-defined routines in order to be able to work with the variables
+contained in them. As in the example, this is already done with the
+module control_parameters .
+This yields access to most of the existing parameters for steering the
+model. Furthermore, the module user
+appears in the example
+above. This is a
+user-defined module (it is located at
+the beginning of the file user_interface.f90 )
+and can be used for communication between the user-defined routines. In
+this module own variables can be declared as desired. It
+is not used outside of the user code.
+A very typical request of
+users is the
+calculation and output of
+quantities which are not part of PALM's standard output. Several
+routines in the basic user interface are already designed and prepared
+for calculating and output of such quantities (see 3.5.4 ).
As already mentioned, the
+contents of
+the file user_interface.f90
+can be used as a basis for extensions. However the file should not be
+manipulated directly (it is anyway write protected by default), but it
+should be
+copied to another file. User write permits for this new file must be
+declared by means of the unix command chmod .
+
+The following sections
+describe, which
+interfaces for user-defined code exist in the
+model, how user parameters can be defined for steering this code
+and how it is translated and linked to the model.
+
+
Last change:
+$Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_3.6.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_3.6.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_3.6.html (revision 141)
@@ -0,0 +1,111 @@
+
+
+PALM chapter 3.6
+3.6 Interactive mode and debugging
+You can use mrun
+for running PALM
+in batch mode as well as for running it interactively. For interactive
+runs, you must (naturally) be logged in on the respective computer. For
+this computer the subroutines of the model must have
+been precompiled (see chapter
+5.0 ). Files containing user-defined code must be stored in
+the directory given by the variable
+%add_source_path in the mrun-configuration file
+.mrun.config .
+All output-files possibly
+created by the model and requested by the user to be kept after the run
+are copied to
+directories on the local host corresponding to the specifications
+in the configuration file (in this case the file attribute tr does not cause transfer to another computer).
+Since model runs usually
+require large
+amounts of CPU time, interactive runs may not be feasible, since
+in interactive mode CPU time
+is strongly limited on many hosts and runs will be aborted
+after the time limit has been exceeded. However, an interactive run
+makes sense if a suitable debugger is available,
+which may be used for error tracing in the model (here, error tracing
+in
+the user-defined software is meant). The preparations neccessary for
+debugging are described in the following. This
+description is limited to the IBM Regatta "hanni" and "berni" of the
+HLRN.
+If certain routines of the
+model
+are to be debugged for errors, the complete source code of
+the model, including the user-defined code, must be compiled
+with special debug compiler options. For this purpose, at least the
+following three lines must be included in the mrun configuration
+file:
+
%compiler_name
+mpxlf95_r
+ibmh parallel debug
+%fopts
+-g:-C:-qinitauto=FF:-qrealsize=8:-Q:-q64:-qmaxmem=-1:-qtune=pwr4:
+
+-qarch=pwr4:-qnosave:-qnoescape:-qflttrap=overflow::zerodivide:
+
+:invalid::enable:-qsigtrap
+ibmh parallel debug
+%lopts
+-g:-C:-qinitauto=FF:-qrealsize=8:-Q:-q64:-qmaxmem=-1:-qtune=pwr4:
+
+-qarch=pwr4:-qnosave:-qnoescape:-qflttrap=overflow::zerodivide:
+
+:invalid::enable:-qsigtrap:-lesslsmp
+ibmh parallel debug
+
+(Attention: in the
+configuration file,
+the compiler and linker options (fopts
+ and lopts )
+must be
+written in one line without any blank space before and after the
+colons!)
+
Using the compiler
+options "-g "
+and "-C ",
+debugable code is created
+and check of array bounds is
+switched on during run time. Option "-qinitauto=FF "
+initializes all
+automatic variables (unfortunately not the global values of modules) to
+NaN.The "-qflttrap "
+and "-qsigtrap "
+options are needed
+in order to terminate the run in case of any floating point errors
+(otherwise the run will not terminate and errors can hardly be
+detected).
+
The mrun
+ call for debugging
+needs
+an extended argument for the option -K :
mrun
+... -K “parallel debug” -s ”*.f90" ... .
The argument of option -s must
+list all source code files of the default PALM code.
+After compiling, the
+debugger
+TotalView is automatically called by mrun . With its
+assistance the user
+has to start
+the program execution manually, to set breakpoints, etc.. User manuals
+of TotalView are available online .
+
Program crashes
+caused by errors in the
+user-defined code should usually be found
+unassisted. If the termination point lies outside the user code (in the
+default model code), the PALM group can be asked for
+assistance, but please do not expect any quick response. It is
+emphasized again that error tracing and programming
+of
+user-defined code requires more or less precise knowledge of the
+internal structure of PALM (see beginning of chapter
+3.5 ).
+
+
+
Last change:
+$Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_3.7.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_3.7.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_3.7.html (revision 141)
@@ -0,0 +1,179 @@
+
+
+
+
+
+ PALM chapter 3.7
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+3.7 Optional software packages
+
+Starting from version 2.1
+PALM includes
+so-called software packages which can be used optionally. These
+software packages are part of the model, but they are not compiled with
+the default model
+installation (actually, the routines of the corresponding packages are
+compiled within the installation, but these subroutines are empty,
+i.e. they do not contain any executable statements). Thus the
+compilation time as well as the memory demand of the model is limited
+to the real needs.
+
+To use software packages in
+a model run,
+they must be requested with mrun option -p .
+Then the subroutines belonging to the respective package are
+additionally compiled for the run (and the respective restart
+runs; the filenames of these subroutines are also displayed on the
+terminal after mrun has been called). If one wants
+to use e.g.
+the two packages with the names
+package1 and package2 , then
+the mrun call
+has to be:
+
+
+Starting from version 3.2, the particles-package is part of the default model, so it does not have to be switched on using mrun -option -p . However, the respective parameters have still to be set by using the NAMELIST group particles_par .
+Further package
+names can be added to
+the list, separated by blanks. If the respective packages permit user
+steering, the appropriate parameters must be given at the end of
+the file PARIN .
+They must be given before possible user-defined
+parameters!
+Each package requires its own NAMELIST group. The respective NAMELIST
+group name is given in the table below. For the example above one
+would have to add the following lines to PARIN (example):
+
+
+
+ &namelist_packagename1
+var1 = 1,0, var2 =
+“abcd” /
+
+ &namelist_packagename2
+var3 = .TRUE.,
+var4 = 0 /
+
+
+The
+following
+packages are available:
+
+
+
+
+
+
+
+
+
+ Package
+name:
+
+
+ NAMELIST
+group name:
+
+
+ Functionality:
+
+
+
+ Control parameter:
+
+
+
+
+
+ --- (see above)
+
+
+
+ particles_par
+
+
+ Release and advection of particles. The particle sources can
+additionally be defined by the user in subroutine user_init_particles
+.
+
+
+ see section 4.2
+
+
+
+
+
+ dvrp_graphics
+
+
+
+ dvrp_graphics_par
+
+
+
+ Graphical output with the dvrp software of the
+RRZN. This is
+only available on the IBM Regatta "hanni" of the HLRN. Possible output
+are iso-surfaces, cross-sections and particles (if the particle package
+is selected). The use of this package is described in section 4.5.7 .
+
+
+
+ see section 4.2
+
+
+
+
+
+ spectra
+
+
+
+ spectra_par
+
+
+ Computation
+and output of horizontal power spectra of the
+prognostic variables.
+
+
+ see
+section 4.2
+
+
+
+
+
+
+
+
+
+
+Last
+change: $Id$
+
+
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_3.8.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_3.8.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_3.8.html (revision 141)
@@ -0,0 +1,134 @@
+
+
+
+
+
+ PALM chapter 3.8
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+3.8 Coupled model runs
+
+Starting from version 3.4
+PALM allows coupled atmosphere-ocean model runs. By analogy with the
+modular structure of PALM, mrun
+starts the coupled model as two concurrent executables, the atmosphere
+version and the ocean version of PALM.
+
+Currently, the coupler
+is at an experimental stage using a simple MPI2 intercommunicator that
+matches the atmosphere and ocean processors one-to-one. This approach
+has limited flexibility and performance, because it requires
+identical horizontal numerical grids and it uses the same number of
+atmosphere and ocean processors, which does not necessarily guarrantee
+a good load balancing.
+
+The coupler establishes a
+one-way interaction between the
+atmosphere and the ocean. The atmosphere sends its bottom surface
+fluxes
+(temperature, humidity, momentum) to the ocean. The ocean sends its top
+surface temperature to the atmosphere. The atmosphere assumes
+saturation of humidity and zero wind speed at its bottom surface. For
+calculations with humidity
+= .T. the atmospheric evaporation leads to a salinity flux in the ocean
+(see e.g. Steinhorn 1991, JPO 21, p. 1681).
+
+The full MPI-2
+standard must be available in order to use the coupling, and it must be
+activated by adding the preprocessor directive -D__mpi2
+to cpp_options
+in the .mrun.config configuration file. (Note: MPI-2 is
+not available for the IBM-Regatta systems.) To start a
+coupled model run,
+this must be requested with the mrun option -Y .
+This tells mrun
+to start two PALM executables. Coupled runs are only possible in
+parallel mode, which means that the mrun option -K parallel
+must also be set. The mrun call
+for coupled runs has to include the following coupling-related options:
+
+
+
+
+The -X ... option
+here specifies the total number of processors assigned to the coupled
+model. Currently, half of them are assigned to each of the two coupled
+executables. Therefore it is advisable to specify an even number
+with -X ...
+ . Otherwise, in case of an odd total number of processors,
+one processor remains idle.
+
+Each coupled executable has
+its own, unique set of I/O filenames; chapter 3.4 gives
+information on file name conventions of coupled runs. The configuration
+file .mrun.config has to be extended for coupled runs. It is
+recommended to duplicate existing file connection identifiers such as
+"d3#", "pr#" etc. using the coupled ocean filenames accordingly. For
+example, the example of the previous chapters could be
+duplicated as follows:
+
+PARIN in:job:npe d3# ~/palm/current_version/JOBS/$fname/INPUT _p3d PARIN in:job:npe d3f ~/palm/current_version/JOBS/$fname/INPUT _p3df BININ in:loc d3f ~/palm/current_version/JOBS/$fname/OUTPUT _d3d # BINOUT out:loc restart ~/palm/current_version/JOBS/$fname/OUTPUT _d3d # RUN_CONTROL out:loc:tr d3# ~/palm/current_version/JOBS/$fname/MONITORING _rc HEADER out:loc:tr d3# ~/palm/current_version/JOBS/$fname/MONITORING _header PLOT1D_PAR out:loc:tr pr# ~/palm/current_version/JOBS/$fname/OUTPUT _pr_par PLOT1D_DATA out:loc:tr pr# ~/palm/current_version/JOBS/$fname/OUTPUT _pr_in # PARIN _O in:job:npe d3o # ~/palm/current_version/JOBS/$fname/INPUT _ o _p3d PARIN_O in:job:npe d3o f ~/palm/current_version/JOBS/$fname/INPUT _ o _p3df BININ _O in:loc d3o f ~/palm/current_version/JOBS/$fname/OUTPUT _ o _d3d # BINOUT _O out:loc restart ~/palm/current_version/JOBS/$fname/OUTPUT _ o _d3d # RUN_CONTROL_O out:loc:tr d3o # ~/palm/current_version/JOBS/$fname/MONITORING _ o _rc HEADER _O out:loc:tr d3o # ~/palm/current_version/JOBS/$fname/MONITORING _ o _header PLOT1D_PAR_O out:loc:tr pro # ~/palm/current_version/JOBS/$fname/OUTPUT _ o _pr_par PLOT1D_DATA _O out:loc:tr pro # ~/palm/current_version/JOBS/$fname/OUTPUT _ o _pr_in
+
+The coupled ocean model
+filenames in the first column (e.g. PARIN_O ) must
+be specified as given in chapter
+3.4 ; the file connection identifiers (e.g. d3o# )
+and the file name extension (e.g. _o_ p3d )
+may be changed at the user's discretion.
+
+The coupler requires the
+following parameters to be equal in both PARIN
+and PARIN_O :
+dx , dy , nx , ny , dt_coupling , end_time , restart_time ,
+dt_restart .
+In the coupled atmosphere executable, bc_pt_b is
+internally set and does not need to be prescribed; in the coupled ocean
+executable, bc_uv_t is
+internally set ('neumann') and does not need to be prescribed. The
+coupled ocean parameter file PARIN_O
+should include dummy REAL value assignments to both top_momentumflux_u
+and top_momentumflux_v
+(e.g. top_momentumflux_u = 0.0, top_momentumflux_v = 0.0) to
+enable the momentum flux coupling.
+
+The coupling interval dt_coupling
+must be explicity set. In order to ensure synchronous coupling
+throughout the simulation, dt_coupling
+should be chosen larger than
+dt_max .
+
+
+
+
+
+
+Last
+change: $Id$
+
+
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.0.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.0.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.0.html (revision 141)
@@ -0,0 +1,277 @@
+
+
+
+
+
+
+
+
+
+
+
+ PALM chapter 4.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+4.0
+Steering parameters
+
+
+Before carrying out a model
+run, the user
+has to /determine/ a data set - the model parameters - e.g. how
+many grid points are to be used, how large the horizontal and
+vertical grid spacing should be, which kind of boundary conditions are
+to be used for the individual variables, which numerical schemes
+implemented in the model are to be used, how long the simulated time
+should be, at which times and points plot output are supposed to be
+made, etc.
+
+
+
+
+These data are
+assigned with the help of
+so-called “NAMELIST-driven input” (FORTRAN -
+NAMELIST –
+input). The chosen values of the model parameters are
+written
+into an ASCII file with fixed format, which is expected by the model as
+an input
+file under the local name PARIN .
+On this file the parameters are represented by their variable names
+they have in the model. These parameters can be assigned one or more
+values, depending on the type and size the variable has. The following
+example shows the format of the file
+PARIN:
+
+
+
+
+
+
+
+
+
+ &inipar
+nx
+= 79, ny = 79, nz = 40,
+
+
+
+dx = 50.0, dy = 50.0, dz =
+50.0,
+
+
+
+initializing_actions =
+"set_1d-model_profiles",
+
+
+
+prandtl_layer = .TRUE.,/
+
+
+
+ &d3par
+end_time = 9000.0, section_xy = 1, 10, 20,/
+
+
+
+ &packagename
+var1 = .TRUE. /
+
+
+
+ &userpar
+abcd = 1234,0,/
+
+
+
+
+
+
+
+
+
+
+The parameters
+are separated into four
+different groups which all start with the so-called NAMELIST group
+names.
+These are &inipar ,
+&d3par
+and &packagename
+as well as &userpar .
+In each case a
+group is terminated with one backslash ("/"). Between the beginning of
+the line and the group name at least one blank has to be typed. Between
+the
+group names and the "/", the
+values are assigned to the variables. The example shows that in
+principle all FORTRAN data types are allowed. For more details
+concerning the NAMELIST syntax, refer to
+appropriate FORTRAN manuals.
+
+
+
+
+Parameters
+belonging to the group inipar
+are first read by PALM.
+These are the initialization parameters. Second, the so-called run
+parameters belonging to the group d3par
+are read in, then the parameters for steering the optional software
+packages (group packagename,
+the string "packagename"
+must be replaced by the NAMELIST
+group name of the respective package) as well as user-defined
+parameters
+(group userpar ).
+The four
+groups must be given in this order, the last groups, packagename and
+userpar ,
+may
+be omitted. If several software packages are selected
+(see chapter 3.7 ),
+further NAMELIST groups may be inserted before the group userpar .
+
+
+The
+initialization, run and
+package parameters differ as follows:
+
+
+
+
+
+
+ The initialization
+parameters are steering the basic settings of the model run.
+They
+define e.g. the number of the grid points, the numerical schemes to be
+used, initial and boundary conditions to be applied, how the
+three-dimensional fields are initialized at the beginning of a model
+run (constant value profiles or 1D-model-pre-run, the initial
+temperature profile etc.). These parameters apply to the total model
+run and thus can not be changed with restart runs! If one tries to
+change these values within the NAMELIST input file of a restart run,
+then these changes are ignored (sole exception is the parameter initializing_actions , which
+must be given the
+value read_restart_data for restart
+runs).
+
+
+
+
+
+
+
+
+ The run
+parameters are generally steering actions to be carried out
+during
+a model run. One can select for example, at which times plot output
+should happen and which variables are to be written. Additionally one
+can (and must) specify the time to be simulated. Run parameters only
+apply to the actual run (job) and with each restart run other values
+may be declared (if runs are restarted automatically, parameters will
+usually keep their values, provided that the NAMELIST input file was
+not changed by the user in the meantime).
+
+
+
+
+
+
+
+
+ Package parameters
+behave like run parameters . Package parameters
+determine the behavior of
+the additional (not user-defined) software packages .
+
+
+
+
+
+
+The user-defined
+parameters are assigned
+by the user within the NAMELIST group name &userpar
+(see chapter
+3.5.2 ). They steer actions programmed by the user. By
+default,
+this group has only one parameter (region ).
+If the
+user don't want to assign any values to the user-defined
+parameters, the group
+userpar
+ may be omitted. The group name &userpar
+can be changed by the user in the user-defined code. In
+addition to this, further NAMELIST groups may also be declared (all
+within routine user_parin
+in file user_interface.f90 ).
+Chapter
+4.4.1 shows a simple but complete example of the input file
+PARIN.
+This example file can be used together with the configuration file
+(described in chapter
+3.2 ) for the execution of a model test run.
+
+
+PALM assigns default
+values to nearly all parameters. They become effective
+if no other assignments are given in the parameter file. These
+default values as well as the parameter name, type and its
+explanation are described in the lists of the following subsections.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Last change:
+$Id$
+
+
+
+
+
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.1.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.1.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.1.html (revision 141)
@@ -0,0 +1,12630 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ PALM chapter 4.1
+
+
+
+
+
+ 4.1
+Initialization parameters
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Parameter name
+
+
+
+
+
+ Type
+
+
+
+
+
+
+
+
+
+
+ Default
+
+
+
+
+ value
+
+
+
+
+
+
+
+
+
+
+ Explanation
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ adjust_mixing_length
+
+
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+
+ Near-surface adjustment of the
+mixing length to the Prandtl-layer law.
+
+
+
+
+
+
+
+
+
+ Usually
+the mixing length in LES models lLES
+depends (as in PALM) on the grid size and is possibly restricted
+further in case of stable stratification and near the lower wall (see
+parameter wall_adjustment ).
+With adjust_mixing_length = .T.
+the Prandtl' mixing length lPR = kappa * z/phi
+is calculated
+and the mixing length actually used in the model is set l = MIN (lLES ,
+lPR ). This usually gives a decrease of the
+mixing length at
+the bottom boundary and considers the fact that eddy sizes
+decrease in the vicinity of the wall.
+
+
+
+
+
+
+
+
+
+ Warning: So
+far, there is
+no good experience with adjust_mixing_length = .T. !
+
+
+
+
+
+
+
+
+
+ With adjust_mixing_length = .T. and the
+Prandtl-layer being
+switched on (see prandtl_layer )
+ '(u*)** 2+neumann'
+should always be set as the lower boundary condition for the TKE (see bc_e_b ),
+otherwise the near-surface value of the TKE is not in agreement with
+the Prandtl-layer law (Prandtl-layer law and Prandtl-Kolmogorov-Ansatz
+should provide the same value for Km ). A warning
+is given,
+if this is not the case.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ alpha_surface
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Inclination of the model domain
+with respect to the horizontal (in degrees).
+
+
+
+
+
+
+
+
+
+ By means of alpha_surface
+the model domain can be inclined in x-direction with respect to the
+horizontal. In this way flows over inclined surfaces (e.g. drainage
+flows, gravity flows) can be simulated. In case of alpha_surface
+ /= 0
+the buoyancy term
+appears both in
+the equation of motion of the u-component and of the w-component.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ An inclination
+is only possible in
+case of cyclic horizontal boundary conditions along x AND y (see bc_lr
+and bc_ns ) and topography = 'flat' .
+
+
+
+
+
+
+
+
+
+ Runs with inclined surface still require additional
+user-defined code as well as modifications to the default code. Please
+ask the PALM
+developer group .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_e_b
+
+
+
+
+
+
+
+
+
+
+ C * 20
+
+
+
+
+ 'neumann'
+
+
+
+
+
+
+
+
+
+
+ Bottom boundary condition of the
+TKE.
+
+
+
+
+
+
+
+
+
+ bc_e_b may be
+set to 'neumann'
+or '(u*) ** 2+neumann' .
+ bc_e_b
+= 'neumann'
+yields to
+e(k=0)=e(k=1) (Neumann boundary condition), where e(k=1) is calculated
+via the prognostic TKE equation. Choice of '(u*)**2+neumann'
+also yields to
+e(k=0)=e(k=1), but the TKE at the Prandtl-layer top (k=1) is calculated
+diagnostically by e(k=1)=(us/0.1)**2. However, this is only allowed if
+a Prandtl-layer is used (prandtl_layer ).
+If this is not the case, a warning is given and bc_e_b
+is reset
+to 'neumann' .
+
+
+
+
+
+
+
+
+
+
+ At the top
+boundary a Neumann
+boundary condition is generally used: (e(nz+1) = e(nz)).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_lr
+
+
+
+
+
+
+
+
+
+
+ C * 20
+
+
+
+
+
+ 'cyclic'
+
+
+
+
+
+ Boundary
+condition along x (for all quantities).
+
+
+
+
+
+
+
+
+
+
+By default, a cyclic boundary condition is used along x.
+
+
+
+
+
+
+
+
+
+
+ bc_lr may
+also be
+assigned the values 'dirichlet/radiation'
+(inflow from left, outflow to the right) or 'radiation/dirichlet'
+(inflow from
+right, outflow to the left). This requires the multi-grid method to be
+used for solving the Poisson equation for perturbation pressure (see psolver )
+and it also requires cyclic boundary conditions along y (see bc_ns ).
+
+
+
+
+
+
+
+
+
+
+In case of these non-cyclic lateral boundaries, a Dirichlet condition
+is used at the inflow for all quantities (initial vertical profiles -
+see initializing_actions
+- are fixed during the run) except u, to which a Neumann (zero
+gradient) condition is applied. At the outflow, a radiation condition is used for all velocity components, while a Neumann (zero
+gradient) condition is used for the scalars. For perturbation
+pressure Neumann (zero gradient) conditions are assumed both at the
+inflow and at the outflow.
+
+
+
+
+
+
+
+
+
+
+When using non-cyclic lateral boundaries, a filter is applied to the
+velocity field in the vicinity of the outflow in order to suppress any
+reflections of outgoing disturbances (see km_damp_max
+and outflow_damping_width ).
+
+
+
+
+
+
+
+
+
+
+
+In order to maintain a turbulent state of the flow, it may be
+neccessary to continuously impose perturbations on the horizontal
+velocity field in the vicinity of the inflow throughout the whole run.
+This can be switched on using create_disturbances .
+The horizontal range to which these perturbations are applied is
+controlled by the parameters inflow_disturbance_begin
+and inflow_disturbance_end .
+The vertical range and the perturbation amplitude are given by disturbance_level_b ,
+ disturbance_level_t ,
+and disturbance_amplitude .
+The time interval at which perturbations are to be imposed is set by dt_disturb .
+
+
+
+
+
+
+
+
+
+
+
+In case of non-cyclic horizontal boundaries call_psolver
+at_all_substeps = .T. should be used.
+
+
+
+
+
+
+
+
+
+ Note:
+
+
+
+
+
+Using non-cyclic lateral boundaries requires very sensitive adjustments
+of the inflow (vertical profiles) and the bottom boundary conditions,
+e.g. a surface heating should not be applied near the inflow boundary
+because this may significantly disturb the inflow. Please check the
+model results very carefully.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_ns
+
+
+
+
+
+
+
+
+
+
+ C * 20
+
+
+
+
+
+ 'cyclic'
+
+
+
+
+
+ Boundary
+condition along y (for all quantities).
+
+
+
+
+
+
+
+
+
+
+By default, a cyclic boundary condition is used along y.
+
+
+
+
+
+
+
+
+
+
+ bc_ns may
+also be
+assigned the values 'dirichlet/radiation'
+(inflow from rear ("north"), outflow to the front ("south")) or 'radiation/dirichlet'
+(inflow from front ("south"), outflow to the rear ("north")). This
+requires the multi-grid
+method to be used for solving the Poisson equation for perturbation
+pressure (see psolver )
+and it also requires cyclic boundary conditions along x (see
+
+
+
+
+ bc_lr ).
+
+
+
+
+
+
+
+
+
+
+In case of these non-cyclic lateral boundaries, a Dirichlet condition
+is used at the inflow for all quantities (initial vertical profiles -
+see initializing_actions
+- are fixed during the run) except u, to which a Neumann (zero
+gradient) condition is applied. At the outflow, a radiation condition is used for all velocity components, while a Neumann (zero
+gradient) condition is used for the scalars. For perturbation
+pressure Neumann (zero gradient) conditions are assumed both at the
+inflow and at the outflow.
+
+
+
+
+
+
+
+
+
+
+For further details regarding non-cyclic lateral boundary conditions
+see bc_lr .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_p_b
+
+
+
+
+
+
+
+
+
+
+ C * 20
+
+
+
+
+ 'neumann'
+
+
+
+
+
+
+
+
+
+
+ Bottom boundary condition of the
+perturbation pressure.
+
+
+
+
+
+
+
+
+
+ Allowed values
+are 'dirichlet' ,
+ 'neumann'
+and 'neumann+inhomo' .
+ 'dirichlet'
+sets
+p(k=0)=0.0, 'neumann'
+sets p(k=0)=p(k=1). 'neumann+inhomo'
+corresponds to an extended Neumann boundary condition where heat flux
+or temperature inhomogeneities near the
+surface (pt(k=1)) are additionally regarded (see Shen and
+LeClerc
+(1995, Q.J.R. Meteorol. Soc.,
+1209)). This condition is only permitted with the Prandtl-layer
+switched on (prandtl_layer ),
+otherwise the run is terminated.
+
+
+
+
+
+
+
+
+
+ Since
+at the bottom boundary of the model the vertical
+velocity
+disappears (w(k=0) = 0.0), the consistent Neumann condition ('neumann' or 'neumann+inhomo' )
+dp/dz = 0 should
+be used, which leaves the vertical component w unchanged when the
+pressure solver is applied. Simultaneous use of the Neumann boundary
+conditions both at the bottom and at the top boundary (bc_p_t )
+usually yields no consistent solution for the perturbation pressure and
+should be avoided.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_p_t
+
+
+
+
+
+
+
+
+
+
+ C * 20
+
+
+
+
+
+ 'dirichlet'
+
+
+
+
+
+
+
+
+
+
+ Top boundary condition of the
+perturbation pressure.
+
+
+
+
+
+
+
+
+
+ Allowed values are 'dirichlet'
+(p(k=nz+1)= 0.0) or 'neumann'
+(p(k=nz+1)=p(k=nz)).
+
+
+
+
+
+
+
+
+
+ Simultaneous use
+of Neumann boundary conditions both at the
+top and bottom boundary (bc_p_b )
+usually yields no consistent solution for the perturbation pressure and
+should be avoided. Since at the bottom boundary the Neumann
+condition is a good choice (see bc_p_b ),
+a Dirichlet condition should be set at the top boundary.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_pt_b
+
+
+
+
+
+
+
+
+
+
+ C*20
+
+
+
+
+
+ 'dirichlet'
+
+
+
+
+
+
+
+
+
+
+ Bottom boundary condition of the
+potential temperature.
+
+
+
+
+
+
+
+
+
+ Allowed values
+are 'dirichlet'
+(pt(k=0) = const. = pt_surface
++ pt_surface_initial_change ;
+the user may change this value during the run using user-defined code)
+and 'neumann'
+(pt(k=0)=pt(k=1)).
+
+
+
+
+
+When a constant surface sensible heat flux is used (surface_heatflux ), bc_pt_b
+= 'neumann'
+must be used, because otherwise the resolved scale may contribute to
+the surface flux so that a constant value cannot be guaranteed.
+
+
+
+
+
+
+
+
+ In the coupled atmosphere executable, bc_pt_b is internally set and does not need to be prescribed.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_pt_t
+
+
+
+
+
+
+
+
+
+
+ C * 20
+
+
+
+
+
+ 'initial_ gradient'
+
+
+
+
+
+
+
+
+
+
+ Top boundary condition of the
+potential temperature.
+
+
+
+
+
+
+
+
+
+ Allowed are the
+values 'dirichlet' (pt(k=nz+1)
+does not change during the run), 'neumann'
+(pt(k=nz+1)=pt(k=nz)), and 'initial_gradient' .
+With the 'initial_gradient'-condition the value of the temperature
+gradient at the top is
+calculated from the initial
+temperature profile (see pt_surface ,
+ pt_vertical_gradient )
+by bc_pt_t_val = (pt_init(k=nz+1) -
+pt_init(k=nz)) / dzu(nz+1).
+
+
+
+
+
+Using this value (assumed constant during the
+run) the temperature boundary values are calculated as
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ (up to k=nz the prognostic
+equation for the temperature is solved).
+
+
+
+
+
+When a constant sensible heat flux is used at the top boundary (top_heatflux ),
+ bc_pt_t = 'neumann'
+must be used, because otherwise the resolved scale may contribute to
+the top flux so that a constant value cannot be guaranteed.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_q_b
+
+
+
+
+
+
+
+
+
+
+ C * 20
+
+
+
+
+
+ 'dirichlet'
+
+
+
+
+
+
+
+
+
+
+ Bottom boundary condition of the
+specific humidity / total water content.
+
+
+
+
+
+
+
+
+
+ Allowed
+values are 'dirichlet'
+(q(k=0) = const. = q_surface
++ q_surface_initial_change ;
+the user may change this value during the run using user-defined code)
+and 'neumann'
+(q(k=0)=q(k=1)).
+
+
+
+
+
+When a constant surface latent heat flux is used (surface_waterflux ), bc_q_b
+= 'neumann'
+must be used, because otherwise the resolved scale may contribute to
+the surface flux so that a constant value cannot be guaranteed.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_q_t
+
+
+
+
+
+
+
+
+
+
+ C
+* 20
+
+
+
+
+ 'neumann'
+
+
+
+
+
+
+
+
+
+
+ Top boundary condition of the
+specific humidity / total water content.
+
+
+
+
+
+
+
+
+
+ Allowed
+are the values 'dirichlet'
+(q(k=nz) and q(k=nz+1) do
+not change during the run) and 'neumann' .
+With the Neumann boundary
+condition the value of the humidity gradient at the top is calculated
+from the
+initial humidity profile (see q_surface ,
+ q_vertical_gradient )
+by: bc_q_t_val = ( q_init(k=nz) - q_init(k=nz-1)) / dzu(nz).
+
+
+
+
+
+Using this value (assumed constant during the run) the humidity
+boundary values
+are calculated as
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ (up tp k=nz the prognostic
+equation for q is solved).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_s_b
+
+
+
+
+
+
+
+
+
+
+ C * 20
+
+
+
+
+ 'dirichlet'
+
+
+
+
+
+
+
+
+
+
+ Bottom boundary condition of the
+scalar concentration.
+
+
+
+
+
+
+
+
+
+ Allowed values
+are 'dirichlet'
+(s(k=0) = const. = s_surface
++ s_surface_initial_change ;
+the user may change this value during the run using user-defined code)
+and 'neumann'
+(s(k=0) =
+s(k=1)).
+
+
+
+
+
+When a constant surface concentration flux is used (surface_scalarflux ), bc_s_b
+= 'neumann'
+must be used, because otherwise the resolved scale may contribute to
+the surface flux so that a constant value cannot be guaranteed.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_s_t
+
+
+
+
+
+
+
+
+
+
+ C * 20
+
+
+
+
+
+ 'neumann'
+
+
+
+
+
+
+
+
+
+
+ Top boundary condition of the
+scalar concentration.
+
+
+
+
+
+
+
+
+
+ Allowed are the
+values 'dirichlet'
+(s(k=nz) and s(k=nz+1) do
+not change during the run) and 'neumann' .
+With the Neumann boundary
+condition the value of the scalar concentration gradient at the top is
+calculated
+from the initial scalar concentration profile (see s_surface , s_vertical_gradient )
+by: bc_s_t_val = (s_init(k=nz) - s_init(k=nz-1)) / dzu(nz).
+
+
+
+
+
+Using this value (assumed constant during the run) the concentration
+boundary values
+are calculated as
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ (up to k=nz the prognostic
+equation for the scalar concentration is
+solved).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_sa_t
+
+
+
+
+ C * 20
+
+
+
+
+ 'neumann'
+
+
+
+
+
+
+
+
+
+ Top boundary condition of the salinity.
+
+
+
+
+
+
+
+
+
+ This parameter only comes into effect for ocean runs (see parameter ocean ).
+
+
+
+
+
+
+
+
+ Allowed are the
+values 'dirichlet' (sa(k=nz+1)
+does not change during the run) and 'neumann'
+(sa(k=nz+1)=sa(k=nz)) .
+
+
+
+
+
+
+
+
+
+
+When a constant salinity flux is used at the top boundary (top_salinityflux ),
+ bc_sa_t = 'neumann'
+must be used, because otherwise the resolved scale may contribute to
+the top flux so that a constant value cannot be guaranteed.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_uv_b
+
+
+
+
+
+
+
+
+
+
+ C * 20
+
+
+
+
+
+ 'dirichlet'
+
+
+
+
+
+
+
+
+
+
+ Bottom boundary condition of the
+horizontal velocity components u and v.
+
+
+
+
+
+
+
+
+
+ Allowed
+values are 'dirichlet' and
+ 'neumann' . bc_uv_b
+= 'dirichlet'
+yields the
+no-slip condition with u=v=0 at the bottom. Due to the staggered grid
+u(k=0) and v(k=0) are located at z = - 0,5 * dz
+(below the bottom), while u(k=1) and v(k=1) are located at z = +0,5 *
+dz. u=v=0 at the bottom is guaranteed using mirror boundary
+condition:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ The
+Neumann boundary condition
+yields the free-slip condition with u(k=0) = u(k=1) and v(k=0) =
+v(k=1).
+With Prandtl - layer switched on, the free-slip condition is not
+allowed (otherwise the run will be terminated).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_uv_t
+
+
+
+
+
+
+
+
+
+
+ C * 20
+
+
+
+
+
+ 'dirichlet'
+
+
+
+
+
+
+
+
+
+
+ Top boundary condition of the
+horizontal velocity components u and v.
+
+
+
+
+
+
+
+
+
+ Allowed
+values are 'dirichlet' , 'dirichlet_0'
+and 'neumann' .
+The
+Dirichlet condition yields u(k=nz+1) = ug(nz+1) and v(k=nz+1) =
+vg(nz+1),
+Neumann condition yields the free-slip condition with u(k=nz+1) =
+u(k=nz) and v(k=nz+1) = v(k=nz) (up to k=nz the prognostic equations
+for the velocities are solved). The special condition 'dirichlet_0' can be used for channel flow, it yields the no-slip condition u(k=nz+1) = ug(nz+1) = 0 and v(k=nz+1) =
+vg(nz+1) = 0.
+
+
+
+
+
+
+
+
+ In the coupled ocean executable, bc_uv_t is internally set ('neumann') and does not need to be prescribed.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bottom_salinityflux
+
+
+
+
+ R
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+ Kinematic salinity flux near the surface (in psu m/s).
+
+
+
+
+This parameter only comes into effect for ocean runs (see parameter ocean ).
+
+
+
+
+ The
+respective salinity flux value is used
+as bottom (horizontally homogeneous) boundary condition for the salinity equation. This additionally requires that a Neumann
+condition must be used for the salinity, which is currently the only available condition.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ building_height
+
+
+
+
+
+ R
+
+
+
+
+ 50.0
+
+
+
+
+ Height
+of a single building in m.
+
+
+
+
+
+
+
+
+
+ building_height must
+be less than the height of the model domain. This parameter requires
+the use of topography
+= 'single_building' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ building_length_x
+
+
+
+
+
+ R
+
+
+
+
+ 50.0
+
+
+
+
+ Width of a single
+building in m.
+
+
+
+
+
+
+
+
+
+
+Currently, building_length_x
+must be at least 3
+* dx and no more than ( nx - 1 ) * dx
+ - building_wall_left .
+This parameter requires the use of topography
+= 'single_building' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ building_length_y
+
+
+
+
+
+ R
+
+
+
+
+ 50.0
+
+
+
+
+ Depth
+of a single building in m.
+
+
+
+
+
+
+
+
+
+
+Currently, building_length_y
+must be at least 3
+* dy and no more than ( ny - 1 ) * dy - building_wall_south . This parameter requires
+the use of topography
+= 'single_building' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ building_wall_left
+
+
+
+
+
+ R
+
+
+
+
+ building centered in x-direction
+
+
+
+
+
+ x-coordinate of the left building wall (distance between the
+left building wall and the left border of the model domain) in m.
+
+
+
+
+
+
+
+
+
+
+
+Currently, building_wall_left
+must be at least 1
+* dx and less than ( nx
+- 1 ) * dx - building_length_x .
+This parameter requires the use of topography
+= 'single_building' .
+
+
+
+
+
+
+
+
+
+
+
+The default value building_wall_left
+= ( ( nx +
+1 ) * dx - building_length_x ) / 2
+centers the building in x-direction. Due to the staggered grid the building will be displaced by -0.5 dx in x-direction and -0.5 dy in y-direction.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ building_wall_south
+
+
+
+
+
+ R
+
+
+
+
+ building centered in y-direction
+
+
+
+
+
+ y-coordinate of the South building wall (distance between the
+South building wall and the South border of the model domain) in m.
+
+
+
+
+
+
+
+
+
+
+
+Currently, building_wall_south
+must be at least 1
+* dy and less than ( ny
+- 1 ) * dy - building_length_y .
+This parameter requires the use of topography
+= 'single_building' .
+
+
+
+
+
+
+
+
+
+
+
+The default value building_wall_south
+= ( ( ny +
+1 ) * dy - building_length_y ) / 2
+centers the building in y-direction. Due to the staggered grid the building will be displaced by -0.5 dx in x-direction and -0.5 dy in y-direction.
+
+
+
+
+
+
+
+
+
+ canopy_mode C * 20 'block' Canopy mode.
+Besides using the default value, that will create a horizontally
+homogeneous plant canopy that extends over the total horizontal
+extension of the model domain, the user may add code to the user
+interface subroutine user_init_plant_canopy
+to allow further canopy modes. The setting of canopy_mode becomes only active, if plant_canopy has been set .T. and a non-zero drag_coefficient has been defined.
+
+
+
+
+
+ cloud_droplets
+
+
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+
+
+ Parameter to switch on
+usage of cloud droplets.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Cloud droplets require to use particles (i.e. the NAMELIST group particles_par has to be included in the parameter file ). Then each particle is a representative for a certain number of droplets. The droplet
+features (number of droplets, initial radius, etc.) can be steered with
+the respective particle parameters (see e.g. radius ).
+The real number of initial droplets in a grid cell is equal to the
+initial number of droplets (defined by the particle source parameters pst , psl , psr , pss , psn , psb , pdx , pdy
+ and
+ pdz )
+times the initial_weighting_factor .
+
+
+
+
+
+
+
+
+
+
+
+In case of using cloud droplets, the default condensation scheme in
+PALM cannot be used, i.e. cloud_physics
+must be set .F. .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ cloud_physics
+
+
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+
+ Parameter to switch
+on the condensation scheme.
+
+
+
+
+
+For cloud_physics = .TRUE. , equations
+for the
+liquid water
+content and the liquid water potential temperature are solved instead
+of those for specific humidity and potential temperature. Note
+that a grid volume is assumed to be either completely saturated or
+completely
+unsaturated (0%-or-100%-scheme). A simple precipitation scheme can
+additionally be switched on with parameter precipitation .
+Also cloud-top cooling by longwave radiation can be utilized (see radiation )
+
+
+
+
+
+
+
+
+
+
+cloud_physics = .TRUE.
+ requires humidity
+= .TRUE. .
+
+
+
+
+
+Detailed information about the condensation scheme is given in the
+description of the cloud
+physics module (pdf-file, only in German).
+
+
+
+
+
+
+
+
+
+
+This condensation scheme is not allowed if cloud droplets are simulated
+explicitly (see cloud_droplets ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ conserve_volume_flow
+
+
+
+
+
+ L
+
+
+
+
+ .F.
+
+
+
+
+ Conservation
+of volume flow in x- and y-direction.
+
+
+
+
+
+
+
+
+
+ conserve_volume_flow
+= .TRUE.
+guarantees that the volume flow through the xz- or yz-cross-section of
+the total model domain remains constant (equal to the initial value at
+t=0) throughout the run.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ cut_spline_overshoot
+
+
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+ .T.
+
+
+
+
+
+
+
+
+
+ Cuts off of
+so-called overshoots, which can occur with the
+upstream-spline scheme.
+
+
+
+
+
+
+
+
+
+ The cubic splines tend to overshoot in
+case of discontinuous changes of variables between neighbouring grid
+points. This
+may lead to errors in calculating the advection tendency.
+Choice
+of cut_spline_overshoot = .TRUE.
+(switched on by
+default)
+allows variable values not to exceed an interval defined by the
+respective adjacent grid points. This interval can be adjusted
+seperately for every prognostic variable (see initialization parameters
+ overshoot_limit_e , overshoot_limit_pt , overshoot_limit_u ,
+etc.). This might be necessary in case that the
+default interval has a non-tolerable effect on the model
+results.
+
+
+
+
+
+
+
+
+
+ Overshoots may also be removed
+using the parameters ups_limit_e ,
+ ups_limit_pt ,
+etc. as well as by applying a long-filter (see long_filter_factor ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ damp_level_1d
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ zu(nz+1)
+
+
+
+
+
+
+
+
+
+
+ Height where
+the damping layer begins in the 1d-model
+(in m).
+
+
+
+
+
+
+
+
+
+ This parameter is used to
+switch on a damping layer for the
+1d-model, which is generally needed for the damping of inertia
+oscillations. Damping is done by gradually increasing the value
+of the eddy diffusivities about 10% per vertical grid level
+(starting with the value at the height given by damp_level_1d ,
+or possibly from the next grid pint above), i.e. Km (k+1)
+=
+1.1 * Km (k).
+The values of Km are limited to 10 m**2/s at
+maximum.
+
+
+
+
+
+This parameter only comes into effect if the 1d-model is switched on
+for
+the initialization of the 3d-model using initializing_actions
+= 'set_1d-model_profiles' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dissipation_1d
+
+
+
+
+
+
+
+
+
+
+ C*20
+
+
+
+
+
+
+
+
+
+
+ 'as_in_3d_
+
+
+
+
+ model'
+
+
+
+
+
+
+
+
+
+
+ Calculation method for
+the energy dissipation term in the TKE equation of the 1d-model.
+
+
+
+
+
+
+
+
+
+
+
+By default the dissipation is calculated as in the 3d-model using diss
+= (0.19 + 0.74 * l / l_grid) * e**1.5 / l.
+
+
+
+
+
+
+
+
+
+
+Setting dissipation_1d
+= 'detering'
+forces the dissipation to be calculated as diss = 0.064 * e**1.5 / l.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ drag_coefficient R 0.0 Drag coefficient used in the plant canopy model. This parameter has to be non-zero, if the parameter plant_canopy is set .T. .
+
+
+
+
+
+
+
+
+
+ dt
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+ variable
+
+
+
+
+
+
+
+
+
+
+ Time step for
+the 3d-model (in s).
+
+
+
+
+
+
+
+
+
+ By default, (i.e.
+if a Runge-Kutta scheme is used, see timestep_scheme )
+the value of the time step is calculating after each time step
+(following the time step criteria) and
+used for the next step.
+
+
+
+
+
+
+
+
+
+ If the user assigns dt
+a value, then the time step is
+fixed to this value throughout the whole run (whether it fulfills the
+time step
+criteria or not). However, changes are allowed for restart runs,
+because dt can also be used as a run
+parameter .
+
+
+
+
+
+
+
+
+
+ In case that the
+calculated time step meets the condition
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ the simulation will be
+aborted. Such situations usually arise
+in case of any numerical problem / instability which causes a
+non-realistic increase of the wind speed.
+
+
+
+
+
+
+
+
+
+ A
+small time step due to a large mean horizontal windspeed
+speed may be enlarged by using a coordinate transformation (see galilei_transformation ),
+in order to spare CPU time.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ If the
+leapfrog timestep scheme is used (see timestep_scheme )
+a temporary time step value dt_new is calculated first, with dt_new = cfl_factor
+* dt_crit where dt_crit is the maximum timestep allowed by the CFL and
+diffusion condition. Next it is examined whether dt_new exceeds or
+falls below the
+value of the previous timestep by at
+least +5 % / -2%. If it is smaller, dt
+= dt_new is immediately used for the next timestep. If it is larger,
+then dt =
+1.02 * dt_prev
+(previous timestep) is used as the new timestep, however the time
+step is only increased if the last change of the time step is dated
+back at
+least 30 iterations. If dt_new is located in the interval mentioned
+above, then dt
+does not change at all. By doing so, permanent time step changes as
+well as large
+sudden changes (increases) in the time step are avoided.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_pr_1d
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 9999999.9
+
+
+
+
+
+
+
+
+
+
+ Temporal
+interval of vertical profile output of the 1D-model
+(in s).
+
+
+
+
+
+
+
+
+
+ Data are written in ASCII
+format to file LIST_PROFIL_1D .
+This parameter is only in effect if the 1d-model has been switched on
+for the
+initialization of the 3d-model with initializing_actions
+= 'set_1d-model_profiles' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_run_control_1d
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 60.0
+
+
+
+
+
+
+
+
+
+ Temporal interval of
+runtime control output of the 1d-model
+(in s).
+
+
+
+
+
+
+
+
+
+ Data are written in ASCII
+format to file RUN_CONTROL .
+This parameter is only in effect if the 1d-model is switched on for the
+initialization of the 3d-model with initializing_actions
+= 'set_1d-model_profiles' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dx
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 1.0
+
+
+
+
+
+
+
+
+
+ Horizontal grid
+spacing along the x-direction (in m).
+
+
+
+
+
+
+
+
+
+ Along
+x-direction only a constant grid spacing is allowed.
+
+
+
+
+
+
+
+
+ For coupled runs this parameter must be equal in both parameter files PARIN
+and PARIN_O .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dy
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 1.0
+
+
+
+
+
+
+
+
+
+ Horizontal grid
+spacing along the y-direction (in m).
+
+
+
+
+
+
+
+
+
+ Along y-direction only a constant grid spacing is allowed.
+
+
+
+
+
+
+
+
+ For coupled runs this parameter must be equal in both parameter files PARIN
+and PARIN_O .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dz
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Vertical grid
+spacing (in m).
+
+
+
+
+
+
+
+
+
+ This parameter must be
+assigned by the user, because no
+default value is given.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ By default, the
+model uses constant grid spacing along z-direction, but it can be
+stretched using the parameters dz_stretch_level
+and dz_stretch_factor .
+In case of stretching, a maximum allowed grid spacing can be given by dz_max .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Assuming
+a constant dz ,
+the scalar levels (zu) are calculated directly by:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ The w-levels lie
+half between them:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dz_max
+
+
+
+
+ R
+
+
+
+
+ 9999999.9
+
+
+
+
+ Allowed maximum vertical grid
+spacing (in m).
+
+
+
+
+
+
+
+
+
+If the vertical grid is stretched
+(see dz_stretch_factor
+and dz_stretch_level ),
+ dz_max can
+be used to limit the vertical grid spacing.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dz_stretch_factor
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 1.08
+
+
+
+
+
+
+
+
+
+ Stretch factor for a
+vertically stretched grid (see dz_stretch_level ).
+
+
+
+
+
+
+
+
+
+
+ The stretch factor should not exceed a value of
+approx. 1.10 -
+1.12, otherwise the discretization errors due to the stretched grid not
+negligible any more. (refer Kalnay de Rivas)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dz_stretch_level
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 100000.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Height level
+above/below which the grid is to be stretched
+vertically (in m).
+
+
+
+
+
+
+
+
+
+ For ocean = .F., dz_stretch_level is the height level (in m) above which the grid is to be stretched
+vertically. The vertical grid
+spacings dz
+above this level are calculated as
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ and used as spacings for the scalar levels (zu).
+The
+w-levels are then defined as:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ For ocean = .T., dz_stretch_level is the height level (in m, negative) below which the grid is to be stretched
+vertically. The vertical grid
+spacings dz below this level are calculated correspondingly as
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ e_init
+
+
+
+ R
+
+
+
+ 0.0
+
+
+
+ Initial subgrid-scale TKE in m2 s-2 .
+
+
+
+
+
+
+
+
+
+
+This
+option prescribes an initial subgrid-scale TKE from which the initial diffusion coefficients Km and Kh will be calculated if e_init is positive. This option only has an effect if km_constant is not set.
+
+
+
+
+
+
+
+
+
+
+
+
+ e_min
+
+
+
+
+
+ R
+
+
+
+
+ 0.0
+
+
+
+
+ Minimum
+subgrid-scale TKE in m2 s-2 .
+
+
+
+
+
+
+
+
+
+
+This
+option adds artificial viscosity to the flow by ensuring that
+the
+subgrid-scale TKE does not fall below the minimum threshold e_min .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ end_time_1d
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 864000.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Time to be
+simulated for the 1d-model (in s).
+
+
+
+
+
+
+
+
+
+ The
+default value corresponds to a simulated time of 10 days.
+Usually, after such a period the inertia oscillations have completely
+decayed and the solution of the 1d-model can be regarded as stationary
+(see damp_level_1d ).
+This parameter is only in effect if the 1d-model is switched on for the
+initialization of the 3d-model with initializing_actions
+= 'set_1d-model_profiles' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ fft_method
+
+
+
+
+
+
+
+
+
+
+ C * 20
+
+
+
+
+
+ 'system-
+
+
+
+
+ specific'
+
+
+
+
+
+
+
+
+
+
+ FFT-method to
+be used.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+The fast fourier transformation (FFT) is used for solving the
+perturbation pressure equation with a direct method (see psolver )
+and for calculating power spectra (see optional software packages,
+section 4.2 ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+By default, system-specific, optimized routines from external
+vendor libraries are used. However, these are available only on certain
+computers and there are more or less severe restrictions concerning the
+number of gridpoints to be used with them.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ There
+are two other PALM internal methods available on every
+machine (their respective source code is part of the PALM source code):
+
+
+
+
+
+
+
+
+
+ 1.: The Temperton -method
+from Clive Temperton (ECWMF) which is computationally very fast and
+switched on with fft_method = 'temperton-algorithm' .
+The number of horizontal gridpoints (nx+1, ny+1) to be used with this
+method must be composed of prime factors 2, 3 and 5.
+
+
+
+
+
+
+
+
+
+
+2.: The Singleton -method
+which is very slow but has no restrictions concerning the number of
+gridpoints to be used with, switched on with fft_method
+= 'singleton-algorithm' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ galilei_transformation
+
+
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+ .F.
+
+
+
+
+
+ Application of a
+Galilei-transformation to the
+coordinate
+system of the model.
+
+
+
+
+
+
+
+
+ With galilei_transformation
+= .T., a so-called
+Galilei-transformation is switched on which ensures that the coordinate
+system of the model is moved along with the geostrophical wind.
+Alternatively, the model domain can be moved along with the averaged
+horizontal wind (see use_ug_for_galilei_tr ,
+this can and will naturally change in time). With this method,
+numerical inaccuracies of the Piascek - Williams - scheme (concerns in
+particular the momentum advection) are minimized. Beyond that, in the
+majority of cases the lower relative velocities in the moved system
+permit a larger time step (dt ).
+Switching the transformation on is only worthwhile if the geostrophical
+wind (ug, vg)
+and the averaged horizontal wind clearly deviate from the value 0. In
+each case, the distance the coordinate system has been moved is written
+to the file RUN_CONTROL .
+
+
+
+
+
+
+
+
+
+
+ Non-cyclic lateral boundary conditions (see bc_lr
+and bc_ns ), the specification
+of a gestrophic
+wind that is not constant with height
+as well as e.g. stationary inhomogeneities at the bottom boundary do
+not allow the use of this transformation.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ grid_matching
+
+
+
+
+
+
+
+
+
+
+ C * 6
+
+
+
+
+
+ 'match'
+
+
+
+
+ Variable to adjust the
+subdomain
+sizes in parallel runs.
+
+
+
+
+
+
+
+
+
+
+For grid_matching = 'strict' ,
+the subdomains are forced to have an identical
+size on all processors. In this case the processor numbers in the
+respective directions of the virtual processor net must fulfill certain
+divisor conditions concerning the grid point numbers in the three
+directions (see nx , ny
+and nz ).
+Advantage of this method is that all PEs bear the same computational
+load.
+
+
+
+
+
+
+
+
+
+
+There is no such restriction by default, because then smaller
+subdomains are allowed on those processors which
+form the right and/or north boundary of the virtual processor grid. On
+all other processors the subdomains are of same size. Whether smaller
+subdomains are actually used, depends on the number of processors and
+the grid point numbers used. Information about the respective settings
+are given in file RUN_CONTROL .
+
+
+
+
+
+
+
+
+
+
+
+When using a multi-grid method for solving the Poisson equation (see psolver )
+only grid_matching = 'strict'
+is allowed.
+
+
+
+
+
+
+
+
+
+ Note:
+
+
+
+
+
+In some cases for small processor numbers there may be a very bad load
+balancing among the
+processors which may reduce the performance of the code.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ inflow_disturbance_
+
+
+
+
+
+begin
+
+
+
+
+ I
+
+
+
+
+
+ MIN(10,
+
+
+
+
+ nx/2 or ny/2)
+
+
+
+
+
+ Lower
+limit of the horizontal range for which random perturbations are to be
+imposed on the horizontal velocity field (gridpoints).
+
+
+
+
+
+
+
+
+
+
+If non-cyclic lateral boundary conditions are used (see bc_lr
+or bc_ns ),
+this parameter gives the gridpoint number (counted horizontally from
+the inflow) from which on perturbations are imposed on the
+horizontal velocity field. Perturbations must be switched on with
+parameter create_disturbances .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ inflow_disturbance_
+
+
+
+
+
+end
+
+
+
+
+ I
+
+
+
+
+
+ MIN(100,
+
+
+
+
+ 3/4*nx or
+
+
+
+
+ 3/4*ny)
+
+
+
+
+ Upper
+limit of the horizontal range for which random perturbations are
+to be imposed on the horizontal velocity field (gridpoints).
+
+
+
+
+
+
+
+
+
+
+If non-cyclic lateral boundary conditions are used (see bc_lr
+or bc_ns ),
+this parameter gives the gridpoint number (counted horizontally from
+the inflow) unto which perturbations are imposed on the
+horizontal
+velocity field. Perturbations must be switched on with parameter create_disturbances .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ initializing_actions
+
+
+
+
+
+
+
+
+
+
+ C * 100
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Initialization actions
+to be carried out.
+
+
+
+
+
+
+
+
+
+ This parameter does not have a
+default value and therefore must be assigned with each model run. For
+restart runs initializing_actions = 'read_restart_data'
+must be set. For the initial run of a job chain the following values
+are allowed:
+
+
+
+
+
+
+
+
+
+ 'set_constant_profiles'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'set_1d-model_profiles'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ The arrays of the 3d-model are initialized with
+the
+(stationary) solution of the 1d-model. These are the variables e, kh,
+km, u, v and with Prandtl layer switched on rif, us, usws, vsws. The
+temperature (humidity) profile consisting of linear sections is set as
+for 'set_constant_profiles' and assumed as constant in time within the
+1d-model. For steering of the 1d-model a set of parameters with suffix
+"_1d" (e.g. end_time_1d ,
+ damp_level_1d )
+is available.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'by_user'
+
+
+
+
+
+
+
+
+ The initialization of the arrays
+of the 3d-model is under complete control of the user and has to be
+done in routine user_init_3d_model
+of the user-interface.
+
+
+
+
+
+
+
+
+ 'initialize_vortex'
+
+
+
+
+
+
+
+
+
+
+ The initial
+velocity field of the
+3d-model corresponds to a
+Rankine-vortex with vertical axis. This setting may be used to test
+advection schemes. Free-slip boundary conditions for u and v (see
bc_uv_b ,
bc_uv_t )
+are necessary. In order not to distort the vortex, an initial
+horizontal wind profile constant
+with height is necessary (to be set by
initializing_actions
+=
'set_constant_profiles' )
+and some other conditions have to be met (neutral stratification,
+diffusion must be
+switched off, see
km_constant ).
+The center of the vortex is located at jc = (nx+1)/2. It
+extends from k = 0 to k = nz+1. Its radius is 8 *
dx
+and the exponentially decaying part ranges to 32 *
dx
+(see init_rankine.f90).
+
+
+
+
+
+
+
+
+
+ 'initialize_ptanom'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ A 2d-Gauss-like shape disturbance
+(x,y) is added to the
+initial temperature field with radius 10.0 * dx
+and center at jc = (nx+1)/2. This may be used for tests of scalar
+advection schemes
+(see scalar_advec ).
+Such tests require a horizontal wind profile constant with hight and
+diffusion
+switched off (see 'initialize_vortex' ).
+Additionally, the buoyancy term
+must be switched of in the equation of motion for w (this
+requires the user to comment out the call of buoyancy in the
+source code of prognostic_equations.f90 ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Values may be
+combined, e.g. initializing_actions = 'set_constant_profiles
+initialize_vortex' , but the values of 'set_constant_profiles' ,
+ 'set_1d-model_profiles'
+, and 'by_user'
+must not be given at the same time.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ km_constant
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ variable
+
+
+
+
+
+(computed from TKE)
+
+
+
+
+
+
+
+
+
+ Constant eddy
+diffusivities are used (laminar
+simulations).
+
+
+
+
+
+
+
+
+
+ If this parameter is
+specified, both in the 1d and in the
+3d-model constant values for the eddy diffusivities are used in
+space and time with Km = km_constant
+and Kh = Km / prandtl_number .
+The prognostic equation for the subgrid-scale TKE is switched off.
+Constant eddy diffusivities are only allowed with the Prandtl layer (prandtl_layer )
+switched off.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ km_damp_max
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.5*(dx
+or dy)
+
+
+
+
+ Maximum
+diffusivity used for filtering the velocity field in the vicinity of
+the outflow (in m2 /s).
+
+
+
+
+
+
+
+
+
+
+When using non-cyclic lateral boundaries (see bc_lr
+or bc_ns ),
+a smoothing has to be applied to the
+velocity field in the vicinity of the outflow in order to suppress any
+reflections of outgoing disturbances. Smoothing is done by increasing
+the eddy diffusivity along the horizontal direction which is
+perpendicular to the outflow boundary. Only velocity components
+parallel to the outflow boundary are filtered (e.g. v and w, if the
+outflow is along x). Damping is applied from the bottom to the top of
+the domain.
+
+
+
+
+
+
+
+
+
+
+The horizontal range of the smoothing is controlled by outflow_damping_width
+which defines the number of gridpoints (counted from the outflow
+boundary) from where on the smoothing is applied. Starting from that
+point, the eddy diffusivity is linearly increased (from zero to its
+maximum value given by km_damp_max )
+until half of the damping range width, from where it remains constant
+up to the outflow boundary. If at a certain grid point the eddy
+diffusivity calculated from the flow field is larger than as described
+above, it is used instead.
+
+
+
+
+
+
+
+
+
+
+The default value of km_damp_max
+has been empirically proven to be sufficient.
+
+
+
+
+
+
+
+
+
+ lad_surface R 0.0 Surface value of the leaf area density (in m2 /m3 ). This
+parameter assigns the value of the leaf area density lad at the surface (k=0). Starting from this value,
+the leaf area density profile is constructed with lad_vertical_gradient
+and lad_vertical_gradient_level
+ . lad_vertical_gradient R (10) 10 * 0.0 Gradient(s) of the leaf area density (in m2 /m4 ).This leaf area density gradient
+holds starting from the height
+level defined by lad_vertical_gradient_level
+(precisely: for all uv levels k where zu(k) > lad_vertical_gradient_level, lad(k) is set: lad(k) = lad(k-1) + dzu(k) * lad_vertical_gradient )
+up to the level defined by pch_index . Above that level lad(k) will automatically set to 0.0. A total of 10 different gradients for 11 height intervals (10 intervals
+if lad_vertical_gradient_level (1)
+= 0.0 ) can be assigned. The leaf area density at the surface is
+assigned via lad_surface .
+
lad_vertical_gradient_level R (10) 10 * 0.0 Height level from which on the gradient
+of the leaf area density defined by lad_vertical_gradient_level
+is effective (in m). The height levels have to be assigned in ascending order. The
+default values result in a leaf area density that is constant with height uup to the top of the plant canopy layer defined by pch_index . For the piecewise construction of temperature profiles see lad_vertical_gradient .
+
+
+
+
+
+
+
+
+
+
+ long_filter_factor
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Filter factor
+for the so-called Long-filter.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+This filter very efficiently
+eliminates 2-delta-waves sometimes cauesed by the upstream-spline
+scheme (see Mahrer and
+Pielke, 1978: Mon. Wea. Rev., 106, 818-830). It works in all three
+directions in space. A value of long_filter_factor
+= 0.01
+sufficiently removes the small-scale waves without affecting the
+longer waves.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ By default, the filter is
+switched off (= 0.0 ).
+It is exclusively applied to the tendencies calculated by the
+upstream-spline scheme (see momentum_advec
+and scalar_advec ),
+not to the prognostic variables themselves. At the bottom and top
+boundary of the model domain the filter effect for vertical
+2-delta-waves is reduced. There, the amplitude of these waves is only
+reduced by approx. 50%, otherwise by nearly 100%.
+
+
+
+
+
+Filter factors with values > 0.01 also
+reduce the amplitudes
+of waves with wavelengths longer than 2-delta (see the paper by Mahrer
+and
+Pielke, quoted above).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ loop_optimization
+
+
+
+
+ C*16
+
+
+
+
+ see right
+
+
+
+
+ Method used to optimize loops for solving the prognostic equations .
+
+
+
+
+
+
+
+
+
+By
+default, the optimization method depends on the host on which PALM is
+running. On machines with vector-type CPUs, single 3d-loops are used to
+calculate each tendency term of each prognostic equation, while on all
+other machines, all prognostic equations are solved within one big loop
+over the two horizontal indices i and j (giving a good cache uitilization).
+
+
+
+
+
+
+
+
+
+The default behaviour can be changed by setting either loop_optimization = 'vector' or loop_optimization = 'cache' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mixing_length_1d
+
+
+
+
+
+
+
+
+
+
+ C*20
+
+
+
+
+
+
+
+
+
+
+ 'as_in_3d_
+
+
+
+
+ model'
+
+
+
+
+
+
+
+
+
+
+ Mixing length used in the
+1d-model.
+
+
+
+
+
+
+
+
+
+
+By default the mixing length is calculated as in the 3d-model (i.e. it
+depends on the grid spacing).
+
+
+
+
+
+
+
+
+
+
+By setting mixing_length_1d
+= 'blackadar' ,
+the so-called Blackadar mixing length is used (l = kappa * z / ( 1 +
+kappa * z / lambda ) with the limiting value lambda = 2.7E-4 * u_g / f).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ humidity
+
+
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+
+
+ Parameter to
+switch on the prognostic equation for specific
+humidity q.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ The initial vertical
+profile of q can be set via parameters q_surface , q_vertical_gradient
+and q_vertical_gradient_level .
+Boundary conditions can be set via q_surface_initial_change
+and surface_waterflux .
+
+
+
+
+
+
+
+
+
+
+
+If the condensation scheme is switched on (cloud_physics
+= .TRUE.), q becomes the total liquid water content (sum of specific
+humidity and liquid water content).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ momentum_advec
+
+
+
+
+
+
+
+
+
+
+ C * 10
+
+
+
+
+
+ 'pw-scheme'
+
+
+
+
+
+
+
+
+
+
+ Advection
+scheme to be used for the momentum equations.
+
+
+
+
+
+
+
+
+
+
+The user can choose between the following schemes:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'pw-scheme'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ The scheme of
+Piascek and
+Williams (1970, J. Comp. Phys., 6,
+392-405) with central differences in the form C3 is used.
+
+
+
+
+
+If intermediate Euler-timesteps are carried out in case of
timestep_scheme
+=
'leapfrog+euler'
+the
+advection scheme is - for the Euler-timestep - automatically switched
+to an upstream-scheme.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'ups-scheme'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ The
+upstream-spline scheme is
+used
+(see Mahrer and Pielke,
+1978: Mon. Wea. Rev., 106, 818-830). In opposite to the
+Piascek-Williams scheme, this is characterized by much better numerical
+features (less numerical diffusion, better preservation of flow
+structures, e.g. vortices), but computationally it is much more
+expensive. In
+addition, the use of the Euler-timestep scheme is mandatory (
timestep_scheme
+=
' euler' ),
+i.e. the
+timestep accuracy is only of first order.
+For this reason the advection of scalar variables (see
scalar_advec )
+should then also be carried out with the upstream-spline scheme,
+because otherwise the scalar variables would
+be subject to large numerical diffusion due to the upstream
+scheme.
+
+
+
+
+
+
+
+
+
+ Since
+the cubic splines used tend
+to overshoot under
+certain circumstances, this effect must be adjusted by suitable
+filtering and smoothing (see cut_spline_overshoot ,
+ long_filter_factor ,
+ ups_limit_pt , ups_limit_u , ups_limit_v , ups_limit_w ).
+This is always neccessary for runs with stable stratification,
+even if this stratification appears only in parts of the model domain.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ With stable
+stratification the
+upstream-spline scheme also
+produces gravity waves with large amplitude, which must be
+suitably damped (see
rayleigh_damping_factor ).
+
+
+
+
+
+
+
+
+
+
+
Important: The
+upstream-spline scheme is not implemented for humidity and passive
+scalars (see
humidity
+and
passive_scalar )
+and requires the use of a 2d-domain-decomposition. The last conditions
+severely restricts code optimization on several machines leading to
+very long execution times! The scheme is also not allowed for
+non-cyclic lateral boundary conditions (see
bc_lr
+and
bc_ns ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ netcdf_precision
+
+
+
+
+
+
+
+
+
+
+ C*20
+
+
+
+
+
+(10)
+
+
+
+
+
+
+
+
+
+ single preci-
+
+
+
+
+ sion for all
+
+
+
+
+ output quan-
+
+
+
+
+ tities
+
+
+
+
+
+
+
+
+
+
+ Defines the accuracy of
+the NetCDF output.
+
+
+
+
+
+
+
+
+
+
+By default, all NetCDF output data (see data_output_format )
+have single precision (4 byte) accuracy. Double precision (8
+byte) can be choosen alternatively.
+
+
+
+
+
+Accuracy for the different output data (cross sections, 3d-volume data,
+spectra, etc.) can be set independently.
+
+
+
+
+ '<out>_NF90_REAL4'
+(single precision) or '<out>_NF90_REAL8'
+(double precision) are the two principally allowed values for netcdf_precision ,
+where the string '<out>'
+ can be chosen out of the following list:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'xy'
+
+
+
+
+
+
+
+
+
+
+ horizontal cross section
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'xz'
+
+
+
+
+
+
+
+
+
+
+ vertical (xz) cross
+section
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'yz'
+
+
+
+
+
+
+
+
+
+
+ vertical (yz) cross
+section
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ '2d'
+
+
+
+
+
+
+
+
+
+
+ all cross sections
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ '3d'
+
+
+
+
+
+
+
+
+
+
+ volume data
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'pr'
+
+
+
+
+
+
+
+
+
+
+ vertical profiles
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'ts'
+
+
+
+
+
+
+
+
+
+
+ time series, particle
+time series
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'sp'
+
+
+
+
+
+
+
+
+
+
+ spectra
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'prt'
+
+
+
+
+
+
+
+
+
+
+ particles
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'all'
+
+
+
+
+
+
+
+
+
+
+ all output quantities
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Example:
+
+
+
+
+
+If all cross section data and the particle data shall be output in
+double precision and all other quantities in single precision, then netcdf_precision = '2d_NF90_REAL8' , 'prt_NF90_REAL8'
+has to be assigned.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ npex
+
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Number of processors
+along x-direction of the virtual
+processor
+net.
+
+
+
+
+
+
+
+
+
+ For parallel runs, the total
+number of processors to be used
+is given by
+the mrun
+option -X .
+By default, depending on the type of the parallel computer, PALM
+generates a 1d processor
+net (domain decomposition along x, npey
+= 1 ) or a
+2d-net (this is
+favored on machines with fast communication network). In case of a
+2d-net, it is tried to make it more or less square-shaped. If, for
+example, 16 processors are assigned (-X 16), a 4 * 4 processor net is
+generated (npex
+= 4 , npey
+= 4 ).
+This choice is optimal for square total domains (nx
+= ny ),
+since then the number of ghost points at the lateral boundarys of
+the subdomains is minimal. If nx
+nd ny
+differ extremely, the
+processor net should be manually adjusted using adequate values for npex and npey .
+
+
+
+
+
+
+
+
+
+ Important: The value of npex * npey must exactly
+correspond to the
+value assigned by the mrun -option
+ -X .
+Otherwise the model run will abort with a corresponding error
+message.
+
+
+
+
+
+Additionally, the specification of npex
+and npey
+may of course
+override the default setting for the domain decomposition (1d or 2d)
+which may have a significant (negative) effect on the code performance.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ npey
+
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Number of processors
+along y-direction of the virtual
+processor
+net.
+
+
+
+
+
+
+
+
+
+ For further information see npex .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ nsor_ini
+
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+ 100
+
+
+
+
+
+
+
+
+
+
+ Initial number
+of iterations with the SOR algorithm.
+
+
+
+
+
+
+
+
+
+ This
+parameter is only effective if the SOR algorithm was
+selected as the pressure solver scheme (psolver
+= 'sor' )
+and specifies the
+number of initial iterations of the SOR
+scheme (at t = 0). The number of subsequent iterations at the following
+timesteps is determined
+with the parameter nsor .
+Usually nsor < nsor_ini ,
+since in each case
+subsequent calls to psolver
+use the solution of the previous call as initial value. Suitable
+test runs should determine whether sufficient convergence of the
+solution is obtained with the default value and if necessary the value
+of nsor_ini should be changed.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ nx
+
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Number of grid
+points in x-direction.
+
+
+
+
+
+
+
+
+
+ A value for this
+parameter must be assigned. Since the lower
+array bound in PALM
+starts with i = 0, the actual number of grid points is equal to nx+1 .
+In case of cyclic boundary conditions along x, the domain size is (nx+1 )*
+ dx .
+
+
+
+
+
+
+
+
+
+ For
+parallel runs, in case of grid_matching
+= 'strict' ,
+ nx+1 must
+be an integral multiple
+of the processor numbers (see npex
+and npey )
+along x- as well as along y-direction (due to data
+transposition restrictions).
+
+
+
+
+
+
+
+
+ For coupled runs this parameter must be equal in both parameter files PARIN
+and PARIN_O .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ny
+
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Number of grid
+points in y-direction.
+
+
+
+
+
+
+
+
+
+ A value for this
+parameter must be assigned. Since the lower
+array bound in PALM starts with j = 0, the actual number of grid points
+is equal to ny+1 . In case of cyclic boundary
+conditions along
+y, the domain size is (ny+1 ) * dy .
+
+
+
+
+
+
+
+
+
+ For parallel runs, in case of grid_matching
+= 'strict' ,
+ ny+1 must
+be an integral multiple
+of the processor numbers (see npex
+and npey )
+along y- as well as along x-direction (due to data
+transposition restrictions).
+
+
+
+
+
+
+
+
+ For coupled runs this parameter must be equal in both parameter files PARIN
+and PARIN_O .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ nz
+
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Number of grid
+points in z-direction.
+
+
+
+
+
+
+
+
+
+ A value for this
+parameter must be assigned. Since the lower
+array bound in PALM
+starts with k = 0 and since one additional grid point is added at the
+top boundary (k = nz+1 ), the actual number of grid
+points is nz+2 .
+However, the prognostic equations are only solved up to nz
+(u,
+v)
+or up to nz-1 (w, scalar quantities). The top
+boundary for u
+and v is at k = nz+1 (u, v) while at k = nz
+for all
+other quantities.
+
+
+
+
+
+
+
+
+
+ For parallel
+runs, in case of grid_matching
+= 'strict' ,
+ nz must
+be an integral multiple of
+the number of processors in x-direction (due to data transposition
+restrictions).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ocean
+
+
+
+
+ L
+
+
+
+
+ .F.
+
+
+
+
+ Parameter to switch on ocean runs.
+
+
+
+
+
+
+
+
+
+By default PALM is configured to simulate atmospheric flows. However, starting from version 3.3, ocean = .T. allows simulation of ocean turbulent flows. Setting this switch has several effects:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ An additional prognostic equation for salinity is solved.
+
+
+
+
+ Potential temperature in buoyancy and stability-related terms is replaced by potential density.
+
+
+
+
+ Potential
+density is calculated from the equation of state for seawater after
+each timestep, using the algorithm proposed by Jackett et al. (2006, J.
+Atmos. Oceanic Technol., 23 , 1709-1728).
+
+
+
+
+So far, only the initial hydrostatic pressure is entered into this equation.
+
+
+
+
+ z=0 (sea surface) is assumed at the model top (vertical grid index k=nzt on the w-grid), with negative values of z indicating the depth.
+
+
+
+
+ Initial profiles are constructed (e.g. from pt_vertical_gradient / pt_vertical_gradient_level ) starting from the sea surface, using surface values given by pt_surface , sa_surface , ug_surface , and vg_surface .
+
+
+
+
+ Zero salinity flux is used as default boundary condition at the bottom of the sea.
+
+
+
+
+ If switched on, random perturbations are by default imposed to the upper model domain from zu(nzt*2/3) to zu(nzt-3).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Relevant parameters to be exclusively used for steering ocean runs are bc_sa_t , bottom_salinityflux , sa_surface , sa_vertical_gradient , sa_vertical_gradient_level , and top_salinityflux .
+
+
+
+
+
+
+
+
+
+Section 4.4.2 gives an example for appropriate settings of these and other parameters neccessary for ocean runs.
+
+
+
+
+
+
+
+
+
+ ocean = .T. does not allow settings of timestep_scheme = 'leapfrog' or 'leapfrog+euler' as well as scalar_advec = 'ups-scheme' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ omega
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 7.29212E-5
+
+
+
+
+
+
+
+
+
+
+ Angular
+velocity of the rotating system (in rad s-1 ).
+
+
+
+
+
+
+
+
+
+
+ The angular velocity of the earth is set by
+default. The
+values
+of the Coriolis parameters are calculated as:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ outflow_damping_width
+
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+ MIN(20,
+nx/2 or ny/2)
+
+
+
+
+
+ Width of
+the damping range in the vicinity of the outflow (gridpoints).
+
+
+
+
+
+
+
+
+
+
+
+When using non-cyclic lateral boundaries (see bc_lr
+or bc_ns ),
+a smoothing has to be applied to the
+velocity field in the vicinity of the outflow in order to suppress any
+reflections of outgoing disturbances. This parameter controlls the
+horizontal range to which the smoothing is applied. The range is given
+in gridpoints counted from the respective outflow boundary. For further
+details about the smoothing see parameter km_damp_max ,
+which defines the magnitude of the damping.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ overshoot_limit_e
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Allowed limit
+for the overshooting of subgrid-scale TKE in
+case that the upstream-spline scheme is switched on (in m2 /s2 ).
+
+
+
+
+
+
+
+
+
+
+ By deafult, if cut-off of overshoots is switched
+on for the
+upstream-spline scheme (see cut_spline_overshoot ),
+no overshoots are permitted at all. If overshoot_limit_e
+is given a non-zero value, overshoots with the respective
+amplitude (both upward and downward) are allowed.
+
+
+
+
+
+
+
+
+
+ Only positive values are allowed for overshoot_limit_e .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ overshoot_limit_pt
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Allowed limit
+for the overshooting of potential temperature in
+case that the upstream-spline scheme is switched on (in K).
+
+
+
+
+
+
+
+
+
+ For further information see overshoot_limit_e .
+
+
+
+
+
+
+
+
+
+
+ Only positive values are allowed for overshoot_limit_pt .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ overshoot_limit_u
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+ Allowed limit for the
+overshooting of
+the u-component of velocity in case that the upstream-spline scheme is
+switched on (in m/s).
+
+
+
+
+ For further information see overshoot_limit_e .
+
+
+
+
+
+
+
+
+
+
+ Only positive values are allowed for overshoot_limit_u .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ overshoot_limit_v
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Allowed limit
+for the overshooting of the v-component of
+velocity in case that the upstream-spline scheme is switched on
+(in m/s).
+
+
+
+
+
+
+
+
+
+ For further information see overshoot_limit_e .
+
+
+
+
+
+
+
+
+
+
+ Only positive values are allowed for overshoot_limit_v .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ overshoot_limit_w
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Allowed limit
+for the overshooting of the w-component of
+velocity in case that the upstream-spline scheme is switched on
+(in m/s).
+
+
+
+
+
+
+
+
+
+ For further information see overshoot_limit_e .
+
+
+
+
+
+
+
+
+
+
+ Only positive values are permitted for overshoot_limit_w .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ passive_scalar
+
+
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+
+
+ Parameter to
+switch on the prognostic equation for a passive
+scalar.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ The initial vertical profile
+of s can be set via parameters s_surface ,
+ s_vertical_gradient
+and s_vertical_gradient_level .
+Boundary conditions can be set via s_surface_initial_change
+and surface_scalarflux .
+
+
+
+
+
+
+
+
+
+
+ Note:
+
+
+
+
+
+With passive_scalar
+switched
+on, the simultaneous use of humidity (see humidity )
+is impossible.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ pch_index I 0 Grid point index (scalar) of the upper boundary of the plant canopy layer. Above pch_index the arrays of leaf area density and drag_coeffient are automatically set to zero in case of plant_canopy = .T.. Up to pch_index a leaf area density profile can be prescribed by using the parameters lad_surface , lad_vertical_gradient and lad_vertical_gradient_level .
+
+
+
+
+
+
+
+
+
+ phi
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 55.0
+
+
+
+
+
+
+
+
+
+
+ Geographical
+latitude (in degrees).
+
+
+
+
+
+
+
+
+
+ The value of
+this parameter determines the value of the
+Coriolis parameters f and f*, provided that the angular velocity (see omega )
+is non-zero.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ plant_canopy L .F. Switch for the plant_canopy_model. If plant_canopy is set .T. , the plant canopy model of Watanabe (2004, BLM 112, 307-341) is used. The
+impact of a plant canopy on a turbulent flow is considered by an
+additional drag term in the momentum equations and an additional sink
+term in the prognostic equation for the subgrid-scale TKE. These
+additional terms are dependent on the leaf drag coefficient (see drag_coefficient ) and the leaf area density (see lad_surface , lad_vertical_gradient , lad_vertical_gradient_level ). By default, a horizontally homogeneous plant canopy is prescribed, if plant_canopy is set .T. . However, the user can define other types of plant canopies (see canopy_mode ).plant_canopy = .T. is only allowed together with a non-zero drag_coefficient .
+
+
+
+
+
+
+
+
+
+ prandtl_layer
+
+
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+ .T.
+
+
+
+
+
+
+
+
+
+
+ Parameter to
+switch on a Prandtl layer.
+
+
+
+
+
+
+
+
+
+ By default,
+a Prandtl layer is switched on at the bottom
+boundary between z = 0 and z = 0.5 * dz
+(the first computational grid point above ground for u, v and the
+scalar quantities).
+In this case, at the bottom boundary, free-slip conditions for u and v
+(see bc_uv_b )
+are not allowed. Likewise, laminar
+simulations with constant eddy diffusivities (km_constant )
+are forbidden.
+
+
+
+
+
+
+
+
+
+ With Prandtl-layer
+switched off, the TKE boundary condition bc_e_b
+= '(u*)**2+neumann' must not be used and is
+automatically
+changed to 'neumann' if necessary. Also,
+the pressure
+boundary condition bc_p_b
+= 'neumann+inhomo' is not allowed.
+
+
+
+
+
+
+
+
+
+ The roughness length is declared via the parameter roughness_length .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ precipitation
+
+
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+
+ Parameter to switch
+on the precipitation scheme.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ For
+precipitation processes PALM uses a simplified Kessler
+scheme. This scheme only considers the
+so-called autoconversion, that means the generation of rain water by
+coagulation of cloud drops among themselves. Precipitation begins and
+is immediately removed from the flow as soon as the liquid water
+content exceeds the critical value of 0.5 g/kg.
+
+
+
+
+
+
+
+
+ The precipitation rate and amount can be output by assigning the runtime parameter data_output = 'prr*' or 'pra*' , respectively. The time interval on which the precipitation amount is defined can be controlled via runtime parameter precipitation_amount_interval .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ pt_reference
+
+
+
+
+ R
+
+
+
+
+ use horizontal average as
+refrence
+
+
+
+
+ Reference
+temperature to be used in all buoyancy terms (in K).
+
+
+
+
+
+
+
+
+
+By
+default, the instantaneous horizontal average over the total model
+domain is used.
+
+
+
+
+
+
+
+
+
+ Attention:
+
+
+
+
+In case of ocean runs (see ocean ), always a reference temperature is used in the buoyancy terms with a default value of pt_reference = pt_surface .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ pt_surface
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 300.0
+
+
+
+
+
+
+
+
+
+
+ Surface
+potential temperature (in K).
+
+
+
+
+
+
+
+
+
+ This
+parameter assigns the value of the potential temperature
+ pt at the surface (k=0). Starting from this value,
+the
+initial vertical temperature profile is constructed with pt_vertical_gradient
+and pt_vertical_gradient_level
+ .
+This profile is also used for the 1d-model as a stationary profile.
+
+
+
+
+
+
+
+
+ Attention:
+
+
+
+
+In case of ocean runs (see ocean ),
+this parameter gives the temperature value at the sea surface, which is
+at k=nzt. The profile is then constructed from the surface down to the
+bottom of the model.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ pt_surface_initial
+
+
+
+
+
+ _change
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Change in
+surface temperature to be made at the beginning of
+the 3d run
+(in K).
+
+
+
+
+
+
+
+
+
+ If pt_surface_initial_change
+is set to a non-zero
+value, the near surface sensible heat flux is not allowed to be given
+simultaneously (see surface_heatflux ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ pt_vertical_gradient
+
+
+
+
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+ 10 * 0.0
+
+
+
+
+
+
+
+
+
+
+ Temperature
+gradient(s) of the initial temperature profile (in
+K
+/ 100 m).
+
+
+
+
+
+
+
+
+
+ This temperature gradient
+holds starting from the height
+level defined by pt_vertical_gradient_level
+(precisely: for all uv levels k where zu(k) >
+pt_vertical_gradient_level,
+pt_init(k) is set: pt_init(k) = pt_init(k-1) + dzu(k) * pt_vertical_gradient )
+up to the top boundary or up to the next height level defined
+by pt_vertical_gradient_level .
+A total of 10 different gradients for 11 height intervals (10 intervals
+if pt_vertical_gradient_level (1)
+= 0.0 ) can be assigned. The surface temperature is
+assigned via pt_surface .
+
+
+
+
+
+
+
+
+
+
+ Example:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ pt_vertical_gradient
+= 1.0 , 0.5 ,
+
+
+
+
+
+ pt_vertical_gradient_level = 500.0 ,
+ 1000.0 ,
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ That
+defines the temperature profile to be neutrally
+stratified
+up to z = 500.0 m with a temperature given by pt_surface .
+For 500.0 m < z <= 1000.0 m the temperature gradient is
+1.0 K /
+100 m and for z > 1000.0 m up to the top boundary it is
+0.5 K / 100 m (it is assumed that the assigned height levels correspond
+with uv levels).
+
+
+
+
+
+
+
+
+ Attention:
+
+
+
+
+In case of ocean runs (see ocean ),
+the profile is constructed like described above, but starting from the
+sea surface (k=nzt) down to the bottom boundary of the model. Height
+levels have then to be given as negative values, e.g. pt_vertical_gradient_level = -500.0 , -1000.0 .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ pt_vertical_gradient
+
+
+
+
+
+ _level
+
+
+
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+
+
+
+
+ 10 *
+ 0.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Height level from which on the temperature gradient defined by
+ pt_vertical_gradient
+is effective (in m).
+
+
+
+
+
+
+
+
+
+ The height levels have to be assigned in ascending order. The
+default values result in a neutral stratification regardless of the
+values of pt_vertical_gradient
+(unless the top boundary of the model is higher than 100000.0 m).
+For the piecewise construction of temperature profiles see pt_vertical_gradient .
+
+
+
+
+ Attention:
+
+
+
+
+In case of ocean runs (see ocean ), the (negative) height levels have to be assigned in descending order.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ q_surface
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Surface
+specific humidity / total water content (kg/kg).
+
+
+
+
+
+
+
+
+
+ This
+parameter assigns the value of the specific humidity q at
+the surface (k=0). Starting from this value, the initial
+humidity
+profile is constructed with q_vertical_gradient
+and q_vertical_gradient_level .
+This profile is also used for the 1d-model as a stationary profile.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ q_surface_initial
+
+
+
+
+
+ _change
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Change in
+surface specific humidity / total water content to
+be made at the beginning
+of the 3d run (kg/kg).
+
+
+
+
+
+
+
+
+
+ If q_surface_initial_change
+ is set to a
+non-zero value the
+near surface latent heat flux (water flux) is not allowed to be given
+simultaneously (see surface_waterflux ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ q_vertical_gradient
+
+
+
+
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+ 10 * 0.0
+
+
+
+
+
+
+
+
+
+
+ Humidity
+gradient(s) of the initial humidity profile
+(in 1/100 m).
+
+
+
+
+
+
+
+
+
+ This humidity gradient
+holds starting from the height
+level defined by q_vertical_gradient_level
+(precisely: for all uv levels k, where zu(k) >
+q_vertical_gradient_level,
+q_init(k) is set: q_init(k) = q_init(k-1) + dzu(k) * q_vertical_gradient )
+up to the top boundary or up to the next height level defined
+by q_vertical_gradient_level .
+A total of 10 different gradients for 11 height intervals (10 intervals
+if q_vertical_gradient_level (1)
+= 0.0 ) can be asigned. The surface humidity is
+assigned
+via q_surface .
+
+
+
+
+
+
+
+
+
+ Example:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ q_vertical_gradient
+= 0.001 , 0.0005 ,
+
+
+
+
+
+ q_vertical_gradient_level = 500.0 ,
+ 1000.0 ,
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+That defines the humidity to be constant with height up to z =
+500.0
+m with a
+value given by q_surface .
+For 500.0 m < z <= 1000.0 m the humidity gradient is
+0.001 / 100
+m and for z > 1000.0 m up to the top boundary it is
+0.0005 / 100 m (it is assumed that the assigned height levels
+correspond with uv
+levels).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ q_vertical_gradient
+
+
+
+
+
+ _level
+
+
+
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+
+
+
+
+ 10 *
+ 0.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Height level from
+which on the humidity gradient defined by q_vertical_gradient
+is effective (in m).
+
+
+
+
+
+
+
+
+
+ The height levels
+are to be assigned in ascending order. The
+default values result in a humidity constant with height regardless of
+the values of q_vertical_gradient
+(unless the top boundary of the model is higher than 100000.0 m). For
+the piecewise construction of humidity profiles see q_vertical_gradient .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ radiation
+
+
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+
+
+ Parameter to
+switch on longwave radiation cooling at
+cloud-tops.
+
+
+
+
+
+
+
+
+
+ Long-wave radiation
+processes are parameterized by the
+effective emissivity, which considers only the absorption and emission
+of long-wave radiation at cloud droplets. The radiation scheme can be
+used only with cloud_physics
+= .TRUE. .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ random_generator
+
+
+
+
+
+
+
+
+
+
+ C * 20
+
+
+
+
+
+
+
+
+
+
+ 'numerical
+
+
+
+
+
+ recipes'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Random number
+generator to be used for creating uniformly
+distributed random numbers.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ It is
+used if random perturbations are to be imposed on the
+velocity field or on the surface heat flux field (see create_disturbances
+and random_heatflux ).
+By default, the "Numerical Recipes" random number generator is used.
+This one provides exactly the same order of random numbers on all
+different machines and should be used in particular for comparison runs.
+
+
+
+
+
+
+
+
+
+
+
+Besides, a system-specific generator is available ( random_generator
+= 'system-specific') which should particularly be
+used for runs
+on vector parallel computers (NEC), because the default generator
+cannot be vectorized and therefore significantly drops down the code
+performance on these machines.
+
+
+
+
+
+
+
+
+
+ Note:
+
+
+
+
+
+Results from two otherwise identical model runs will not be comparable
+one-to-one if they used different random number generators.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ random_heatflux
+
+
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+
+
+ Parameter to
+impose random perturbations on the internal two-dimensional near
+surface heat flux field shf .
+
+
+
+
+
+
+
+
+
+
+If a near surface heat flux is used as bottom
+boundary
+condition (see surface_heatflux ),
+it is by default assumed to be horizontally homogeneous. Random
+perturbations can be imposed on the internal
+two-dimensional heat flux field shf by assigning random_heatflux
+= .T. . The disturbed heat flux field is calculated
+by
+multiplying the
+values at each mesh point with a normally distributed random number
+with a mean value and standard deviation of 1. This is repeated after
+every timestep.
+
+
+
+
+
+
+
+
+
+
+In case of a non-flat topography , assigning
+ random_heatflux
+= .T. imposes random perturbations on the
+combined heat
+flux field shf
+composed of surface_heatflux
+at the bottom surface and wall_heatflux(0)
+at the topography top face.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ rif_max
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 1.0
+
+
+
+
+
+
+
+
+
+
+ Upper limit of
+the flux-Richardson number.
+
+
+
+
+
+
+
+
+
+ With the
+Prandtl layer switched on (see prandtl_layer ),
+flux-Richardson numbers (rif) are calculated for z=zp
+(k=1)
+in the 3d-model (in the 1d model for all heights). Their values in
+particular determine the
+values of the friction velocity (1d- and 3d-model) and the values of
+the eddy diffusivity (1d-model). With small wind velocities at the
+Prandtl layer top or small vertical wind shears in the 1d-model, rif
+can take up unrealistic large values. They are limited by an upper (rif_max ) and lower
+limit (see rif_min )
+for the flux-Richardson number. The condition rif_max
+> rif_min
+must be met.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ rif_min
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ - 5.0
+
+
+
+
+
+
+
+
+
+
+ Lower limit of
+the flux-Richardson number.
+
+
+
+
+
+
+
+
+
+ For further
+explanations see rif_max .
+The condition rif_max > rif_min must
+be met.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ roughness_length
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.1
+
+
+
+
+
+
+
+
+
+
+ Roughness
+length (in m).
+
+
+
+
+
+
+
+
+
+ This parameter is
+effective only in case that a Prandtl layer
+is switched
+on (see prandtl_layer ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ sa_surface
+
+
+
+
+ R
+
+
+
+
+ 35.0
+
+
+
+
+
+
+
+
+
+ Surface salinity (in psu).
+
+
+
+
+This parameter only comes into effect for ocean runs (see parameter ocean ).
+
+
+
+
+ This
+parameter assigns the value of the salinity sa at the sea surface (k=nzt). Starting from this value,
+the
+initial vertical salinity profile is constructed from the surface down to the bottom of the model (k=0) by using sa_vertical_gradient
+and sa_vertical_gradient_level
+ .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ sa_vertical_gradient
+
+
+
+
+ R(10)
+
+
+
+
+ 10 * 0.0
+
+
+
+
+
+
+
+
+
+ Salinity gradient(s) of the initial salinity profile (in psu
+/ 100 m).
+
+
+
+
+
+
+
+
+
+ This parameter only comes into effect for ocean runs (see parameter ocean ).
+
+
+
+
+
+
+
+
+ This salinity gradient
+holds starting from the height
+level defined by sa_vertical_gradient_level
+(precisely: for all uv levels k where zu(k) <
+sa_vertical_gradient_level, sa_init(k) is set: sa_init(k) =
+sa_init(k+1) - dzu(k+1) * sa_vertical_gradient ) down to the bottom boundary or down to the next height level defined
+by sa_vertical_gradient_level .
+A total of 10 different gradients for 11 height intervals (10 intervals
+if sa_vertical_gradient_level (1)
+= 0.0 ) can be assigned. The surface salinity at k=nzt is
+assigned via sa_surface .
+
+
+
+
+
+
+
+
+
+
+ Example:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ sa_vertical_gradient
+= 1.0 , 0.5 ,
+
+
+
+
+
+ sa_vertical_gradient_level = -500.0 ,
+-1000.0 ,
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ That
+defines the salinity to be constant down to z = -500.0 m with a salinity given by sa_surface .
+For -500.0 m < z <= -1000.0 m the salinity gradient is
+1.0 psu /
+100 m and for z < -1000.0 m down to the bottom boundary it is
+0.5 psu / 100 m (it is assumed that the assigned height levels correspond
+with uv levels).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ sa_vertical_gradient_level
+
+
+
+
+ R(10)
+
+
+
+
+ 10 * 0.0
+
+
+
+
+
+
+
+
+
+ Height level from which on the salinity gradient defined by sa_vertical_gradient
+is effective (in m).
+
+
+
+
+
+
+
+
+
+ This parameter only comes into effect for ocean runs (see parameter ocean ).
+
+
+
+
+
+
+
+
+ The height levels have to be assigned in descending order. The
+default values result in a constant salinity profile regardless of the
+values of sa_vertical_gradient
+(unless the bottom boundary of the model is lower than -100000.0 m).
+For the piecewise construction of salinity profiles see sa_vertical_gradient .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ scalar_advec
+
+
+
+
+
+
+
+
+
+
+ C * 10
+
+
+
+
+
+ 'pw-scheme'
+
+
+
+
+
+
+
+
+
+
+ Advection
+scheme to be used for the scalar quantities.
+
+
+
+
+
+
+
+
+
+ The
+user can choose between the following schemes:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'pw-scheme'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ The scheme of
+Piascek and
+Williams (1970, J. Comp. Phys., 6,
+392-405) with central differences in the form C3 is used.
+
+
+
+
+
+If intermediate Euler-timesteps are carried out in case of
timestep_scheme
+=
'leapfrog+euler'
+the
+advection scheme is - for the Euler-timestep - automatically switched
+to an upstream-scheme.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'bc-scheme'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ The Bott
+scheme modified by
+Chlond (1994, Mon.
+Wea. Rev., 122, 111-125). This is a conservative monotonous scheme with
+very small numerical diffusion and therefore very good conservation of
+scalar flow features. The scheme however, is computationally very
+expensive both because it is expensive itself and because it does (so
+far) not allow specific code optimizations (e.g. cache optimization).
+Choice of this
+scheme forces the Euler timestep scheme to be used for the scalar
+quantities. For output of horizontally averaged
+profiles of the resolved / total heat flux,
data_output_pr
+=
'w*pt*BC' /
'wptBC' should
+be used, instead of the
+standard profiles (
'w*pt*'
+and
'wpt' )
+because these are
+too inaccurate with this scheme. However, for subdomain analysis (see
statistic_regions )
+exactly the reverse holds: here
'w*pt*BC' and
'wptBC'
+show very large errors and should not be used.
+
+
+
+
+
+
+
+
+
+
+This scheme is not allowed for non-cyclic lateral boundary conditions
+(see
bc_lr
+and
bc_ns ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'ups-scheme'
+
+
+
+
+
+
+
+
+
+ The upstream-spline-scheme
+is used
+(see Mahrer and Pielke,
+1978: Mon. Wea. Rev., 106, 818-830). In opposite to the Piascek
+Williams scheme, this is characterized by much better numerical
+features (less numerical diffusion, better preservation of flux
+structures, e.g. vortices), but computationally it is much more
+expensive. In
+addition, the use of the Euler-timestep scheme is mandatory (timestep_scheme
+= ' euler' ),
+i.e. the
+timestep accuracy is only first order. For this reason the advection of
+momentum (see momentum_advec )
+should then also be carried out with the upstream-spline scheme,
+because otherwise the momentum would
+be subject to large numerical diffusion due to the upstream
+scheme.
+
+
+
+
+
+
+
+
+
+ Since
+the cubic splines used tend
+to overshoot under
+certain circumstances, this effect must be adjusted by suitable
+filtering and smoothing (see cut_spline_overshoot ,
+ long_filter_factor ,
+ ups_limit_pt , ups_limit_u , ups_limit_v , ups_limit_w ).
+This is always neccesssary for runs with stable stratification,
+even if this stratification appears only in parts of the model
+domain.
+
+
+
+
+
+
+
+
+
+ With
+stable stratification the
+upstream-upline scheme also produces gravity waves with large
+amplitude, which must be
+suitably damped (see rayleigh_damping_factor ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Important: The
+upstream-spline scheme is not implemented for humidity and passive
+scalars (see humidity
+and passive_scalar )
+and requires the use of a 2d-domain-decomposition. The last conditions
+severely restricts code optimization on several machines leading to
+very long execution times! This scheme is also not allowed for
+non-cyclic lateral boundary conditions (see bc_lr
+and bc_ns ).
+
+
+
+
+
+
+
+
+
+A
+differing advection scheme can be choosed for the subgrid-scale TKE
+using parameter use_upstream_for_tke .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ statistic_regions
+
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+ 0
+
+
+
+
+
+
+
+
+
+
+ Number of
+additional user-defined subdomains for which
+statistical analysis
+and corresponding output (profiles, time series) shall be
+made.
+
+
+
+
+
+
+
+
+
+ By default, vertical profiles and
+other statistical quantities
+are calculated as horizontal and/or volume average of the total model
+domain. Beyond that, these calculations can also be carried out for
+subdomains which can be defined using the field rmask within the
+user-defined software
+(see chapter
+3.5.3 ). The number of these subdomains is determined with the
+parameter statistic_regions . Maximum 9 additional
+subdomains
+are allowed. The parameter region
+can be used to assigned names (identifier) to these subdomains which
+are then used in the headers
+of the output files and plots.
+
+
+
+
+
+
+
+
+ If the default NetCDF
+output format is selected (see parameter data_output_format ),
+data for the total domain and all defined subdomains are output to the
+same file(s) (DATA_1D_PR_NETCDF ,
+ DATA_1D_TS_NETCDF ).
+In case of statistic_regions
+> 0 ,
+data on the file for the different domains can be distinguished by a
+suffix which is appended to the quantity names. Suffix 0 means data for
+the total domain, suffix 1 means data for subdomain 1, etc.
+
+
+
+
+
+
+
+
+ In
+case of data_output_format
+= 'profil' ,
+individual local files for profiles (PLOT1D_DATA ) are
+created for each subdomain. The individual subdomain files differ by
+their name (the
+number of the respective subdomain is attached, e.g.
+PLOT1D_DATA_1). In this case the name of the file with the data of
+the total domain is PLOT1D_DATA_0. If no subdomains
+are declared (statistic_regions = 0 ),
+the name
+PLOT1D_DATA is used (this must be considered in the
+respective file connection statements of the mrun configuration
+file).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ surface_heatflux
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ no prescribed
+
+
+
+
+
+heatflux
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Kinematic sensible
+heat flux at the bottom surface (in K m/s).
+
+
+
+
+
+
+
+
+
+ If
+a value is assigned to this parameter, the internal two-dimensional
+surface heat flux field shf
+is initialized with the value of surface_heatflux as
+bottom (horizontally homogeneous) boundary condition for the
+temperature equation. This additionally requires that a Neumann
+condition must be used for the potential temperature (see bc_pt_b ),
+because otherwise the resolved scale may contribute to
+the surface flux so that a constant value cannot be guaranteed. Also,
+changes of the
+surface temperature (see pt_surface_initial_change )
+are not allowed. The parameter random_heatflux
+can be used to impose random perturbations on the (homogeneous) surface
+heat
+flux field shf .
+
+
+
+
+
+
+
+
+
+
+In case of a non-flat topography , the
+internal two-dimensional surface heat
+flux field shf
+is initialized with the value of surface_heatflux
+at the bottom surface and wall_heatflux(0)
+at the topography top face. The parameter random_heatflux
+can be used to impose random perturbations on this combined surface
+heat
+flux field shf .
+
+
+
+
+
+
+
+
+
+
+ If no surface heat flux is assigned, shf is calculated
+at each timestep by u* * theta*
+(of course only with prandtl_layer
+switched on). Here, u*
+and theta* are calculated from the Prandtl law
+assuming
+logarithmic wind and temperature
+profiles between k=0 and k=1. In this case a Dirichlet condition (see bc_pt_b )
+must be used as bottom boundary condition for the potential temperature.
+
+
+
+
+
+
+
+
+ See
+also top_heatflux .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ surface_pressure
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 1013.25
+
+
+
+
+
+
+
+
+
+
+ Atmospheric
+pressure at the surface (in hPa).
+
+
+
+
+
+Starting from this surface value, the vertical pressure
+profile is calculated once at the beginning of the run assuming a
+neutrally stratified
+atmosphere. This is needed for
+converting between the liquid water potential temperature and the
+potential temperature (see cloud_physics ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ surface_scalarflux
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Scalar flux at
+the surface (in kg/(m2 s)).
+
+
+
+
+
+
+
+
+
+ If a non-zero value is assigned to this parameter, the
+respective scalar flux value is used
+as bottom (horizontally homogeneous) boundary condition for the scalar
+concentration equation. This additionally requires that a
+Neumann
+condition must be used for the scalar concentration (see bc_s_b ),
+because otherwise the resolved scale may contribute to
+the surface flux so that a constant value cannot be guaranteed. Also,
+changes of the
+surface scalar concentration (see s_surface_initial_change )
+are not allowed.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ If no surface scalar
+flux is assigned (surface_scalarflux
+= 0.0 ),
+it is calculated at each timestep by u* * s*
+(of course only with Prandtl layer switched on). Here, s*
+is calculated from the Prandtl law assuming a logarithmic scalar
+concentration
+profile between k=0 and k=1. In this case a Dirichlet condition (see bc_s_b )
+must be used as bottom boundary condition for the scalar concentration.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ surface_waterflux
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Kinematic
+water flux near the surface (in m/s).
+
+
+
+
+
+
+
+
+
+ If
+a non-zero value is assigned to this parameter, the
+respective water flux value is used
+as bottom (horizontally homogeneous) boundary condition for the
+humidity equation. This additionally requires that a Neumann
+condition must be used for the specific humidity / total water content
+(see bc_q_b ),
+because otherwise the resolved scale may contribute to
+the surface flux so that a constant value cannot be guaranteed. Also,
+changes of the
+surface humidity (see q_surface_initial_change )
+are not allowed.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ If no surface water
+flux is assigned (surface_waterflux
+= 0.0 ),
+it is calculated at each timestep by u* * q*
+(of course only with Prandtl layer switched on). Here, q*
+is calculated from the Prandtl law assuming a logarithmic temperature
+profile between k=0 and k=1. In this case a Dirichlet condition (see bc_q_b )
+must be used as the bottom boundary condition for the humidity.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ s_surface
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Surface value
+of the passive scalar (in kg/m3 ).
+
+
+
+
+
+
+
+
+
+
+
+This parameter assigns the value of the passive scalar s at
+the surface (k=0). Starting from this value, the
+initial vertical scalar concentration profile is constructed with
+s_vertical_gradient and s_vertical_gradient_level .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ s_surface_initial
+
+
+
+
+
+ _change
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Change in
+surface scalar concentration to be made at the
+beginning of the 3d run (in kg/m3 ).
+
+
+
+
+
+
+
+
+
+ If s_surface_initial_change is
+set to a
+non-zero
+value, the near surface scalar flux is not allowed to be given
+simultaneously (see surface_scalarflux ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ s_vertical_gradient
+
+
+
+
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+ 10 * 0 .0
+
+
+
+
+
+
+
+
+
+
+ Scalar
+concentration gradient(s) of the initial scalar
+concentration profile (in kg/m3 /
+100 m).
+
+
+
+
+
+
+
+
+
+ The scalar gradient holds
+starting from the height level
+defined by s_vertical_gradient_level
+ (precisely: for all uv levels k, where zu(k) >
+s_vertical_gradient_level, s_init(k) is set: s_init(k) = s_init(k-1) +
+dzu(k) * s_vertical_gradient ) up to the top
+boundary or up to
+the next height level defined by s_vertical_gradient_level .
+A total of 10 different gradients for 11 height intervals (10 intervals
+if s_vertical_gradient_level (1)
+= 0.0 ) can be assigned. The surface scalar value is
+assigned
+via s_surface .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Example:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ s_vertical_gradient
+= 0.1 , 0.05 ,
+
+
+
+
+
+ s_vertical_gradient_level = 500.0 ,
+ 1000.0 ,
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ That
+defines the scalar concentration to be constant with
+height up to z = 500.0 m with a value given by s_surface .
+For 500.0 m < z <= 1000.0 m the scalar gradient is 0.1
+kg/m3 / 100 m and for z > 1000.0 m up to
+the top
+boundary it is 0.05 kg/m3 / 100 m (it is
+assumed that the
+assigned height levels
+correspond with uv
+levels).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ s_vertical_gradient_
+
+
+
+
+
+ level
+
+
+
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+
+
+
+
+ 10 *
+ 0.0
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Height level from
+which on the scalar gradient defined by s_vertical_gradient
+is effective (in m).
+
+
+
+
+
+
+
+
+
+ The height levels
+are to be assigned in ascending order. The
+default values result in a scalar concentration constant with height
+regardless of the values of s_vertical_gradient
+(unless the top boundary of the model is higher than 100000.0 m). For
+the
+piecewise construction of scalar concentration profiles see s_vertical_gradient .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ timestep_scheme
+
+
+
+
+
+
+
+
+
+
+ C * 20
+
+
+
+
+
+
+
+
+
+
+ 'runge
+
+
+
+
+
+ kutta-3'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Time step scheme to
+be used for the integration of the prognostic
+variables.
+
+
+
+
+
+
+
+
+
+ The user can choose between
+the following schemes:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'runge-kutta-3'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'runge-kutta-2'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Second order
+Runge-Kutta scheme.
+
+
+
+
+
+For special features see timestep_scheme = 'runge-kutta-3' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'leapfrog'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Second
+order leapfrog scheme.
+
+
+
+
+
+Although this scheme requires a constant timestep (because it is
+centered in time), is even applied in case of changes in
+timestep. Therefore, only small
+changes of the timestep are allowed (see
dt ).
+However, an Euler timestep is always used as the first timestep of an
+initiali run. When using the Bott-Chlond scheme for scalar advection
+(see
scalar_advec ),
+the prognostic equation for potential temperature will be calculated
+with the Euler scheme, although the leapfrog scheme is switched
+on.
+
+
+
+
+
+The leapfrog scheme must not be used together with the upstream-spline
+scheme for calculating the advection (see
scalar_advec
+= '
ups-scheme' and
momentum_advec
+= '
ups-scheme' ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ' leapfrog+euler'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ The
+leapfrog scheme is used, but
+after each change of a timestep an Euler timestep is carried out.
+Although this method is theoretically correct (because the pure
+leapfrog method does not allow timestep changes), the divergence of the
+velocity field (after applying the pressure solver) may be
+significantly larger than with 'leapfrog' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'euler'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ First order
+Euler scheme.
+
+
+
+
+
+The Euler scheme must be used when treating the advection terms with
+the upstream-spline scheme (see
scalar_advec
+=
'ups-scheme'
+and
momentum_advec
+=
'ups-scheme' ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+A differing timestep scheme can be choosed for the
+subgrid-scale TKE using parameter use_upstream_for_tke .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ topography
+
+
+
+
+
+ C * 40
+
+
+
+
+ 'flat'
+
+
+
+
+
+
+
+
+
+ Topography mode.
+
+
+
+
+
+
+
+
+
+ The user can
+choose between the following modes:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'flat'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Flat surface.
+
+
+
+
+
+
+
+
+
+ 'single_building'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'read_from_file'
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Flow around
+arbitrary topography.
+
+
+
+
+
+This mode requires the input file
TOPOGRAPHY_DATA . This file contains the arbitrary topography height
+information
+in m. These data must
+exactly match the horizontal grid. Due to the staggered grid the topography will be displaced by -0.5 dx in x-direction and -0.5 dy in y-direction.
+
+
+
+
+
+
+
+
+
+
+Alternatively, the user may add code to the user interface subroutine user_init_grid
+to allow further topography modes. Again, due to the staggered grid the topography will be displaced by -0.5 dx in x-direction and -0.5 dy in y-direction.
+
+
+
+
+
+
+
+
+
+
+All non-flat topography
+modes require the use of momentum_advec
+= scalar_advec
+= 'pw-scheme' , psolver
+= 'poisfft' or 'poisfft_hybrid' ,
+ alpha_surface
+= 0.0, bc_lr = bc_ns = 'cyclic' , galilei_transformation
+= .F. , cloud_physics = .F. , cloud_droplets = .F. , humidity = .F. , and prandtl_layer = .T..
+
+
+
+
+
+
+
+
+
+
+
+Note that an inclined model domain requires the use of topography = 'flat' and a
+nonzero alpha_surface .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ top_heatflux
+
+
+
+
+ R
+
+
+
+
+ no prescribed
+
+
+
+
+
+heatflux
+
+
+
+
+
+
+
+
+
+ Kinematic
+sensible heat flux at the top boundary (in K m/s).
+
+
+
+
+
+
+
+
+
+ If a value is assigned to this parameter, the internal
+two-dimensional surface heat flux field tswst is
+initialized with the value of top_heatflux as
+top (horizontally homogeneous) boundary condition for the
+temperature equation. This additionally requires that a Neumann
+condition must be used for the potential temperature (see bc_pt_t ),
+because otherwise the resolved scale may contribute to
+the top flux so that a constant flux value cannot be guaranteed.
+
+
+
+
+
+
+
+
+
+ Note:
+
+
+
+
+The
+application of a top heat flux additionally requires the setting of
+initial parameter use_top_fluxes
+= .T..
+
+
+
+
+
+
+
+
+ No
+Prandtl-layer is available at the top boundary so far.
+
+
+
+
+
+
+
+
+ See
+also surface_heatflux .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ top_momentumflux_u
+
+
+
+
+ R
+
+
+
+
+ no prescribed momentumflux
+
+
+
+
+ Momentum flux along x at the top boundary (in m2/s2).
+
+
+
+
+
+
+
+
+ If a value is assigned to this parameter, the internal
+two-dimensional u-momentum flux field uswst is
+initialized with the value of top_momentumflux_u as
+top (horizontally homogeneous) boundary condition for the u-momentum equation.
+
+
+
+
+
+
+
+
+ Notes:
+
+
+
+
+The
+application of a top momentum flux additionally requires the setting of
+initial parameter use_top_fluxes
+= .T.. Setting of top_momentumflux_u requires setting of top_momentumflux_v also.
+
+
+
+
+
+
+
+
+ A Neumann
+condition should be used for the u velocity component (see bc_uv_t ),
+because otherwise the resolved scale may contribute to
+the top flux so that a constant flux value cannot be guaranteed.
+
+
+
+
+
+
+
+
+
+
+ No
+Prandtl-layer is available at the top boundary so far.
+
+
+
+
+
+
+
+
+ The coupled ocean parameter file PARIN_O should include dummy REAL value assignments to both top_momentumflux_u and top_momentumflux_v (e.g. top_momentumflux_u = 0.0, top_momentumflux_v = 0.0) to enable the momentum flux coupling.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ top_momentumflux_v
+
+
+
+
+ R
+
+
+
+
+ no prescribed momentumflux
+
+
+
+
+ Momentum flux along y at the top boundary (in m2/s2).
+
+
+
+
+
+
+
+
+ If a value is assigned to this parameter, the internal
+two-dimensional v-momentum flux field vswst is
+initialized with the value of top_momentumflux_v as
+top (horizontally homogeneous) boundary condition for the v-momentum equation.
+
+
+
+
+
+
+
+
+ Notes:
+
+
+
+
+The
+application of a top momentum flux additionally requires the setting of
+initial parameter use_top_fluxes
+= .T.. Setting of top_momentumflux_v requires setting of top_momentumflux_u also.
+
+
+
+
+
+
+
+
+ A Neumann
+condition should be used for the v velocity component (see bc_uv_t ),
+because otherwise the resolved scale may contribute to
+the top flux so that a constant flux value cannot be guaranteed.
+
+
+
+
+
+
+
+
+
+
+ No
+Prandtl-layer is available at the top boundary so far.
+
+
+
+
+
+
+
+
+ The coupled ocean parameter file PARIN_O should include dummy REAL value assignments to both top_momentumflux_u and top_momentumflux_v (e.g. top_momentumflux_u = 0.0, top_momentumflux_v = 0.0) to enable the momentum flux coupling.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ top_salinityflux
+
+
+
+
+ R
+
+
+
+
+ no prescribed
+
+
+
+
+
+salinityflux
+
+
+
+
+
+
+
+
+
+ Kinematic
+salinity flux at the top boundary, i.e. the sea surface (in psu m/s).
+
+
+
+
+
+
+
+
+
+ This parameter only comes into effect for ocean runs (see parameter ocean ).
+
+
+
+
+
+
+
+
+ If a value is assigned to this parameter, the internal
+two-dimensional surface heat flux field saswst is
+initialized with the value of top_salinityflux as
+top (horizontally homogeneous) boundary condition for the salinity equation. This additionally requires that a Neumann
+condition must be used for the salinity (see bc_sa_t ),
+because otherwise the resolved scale may contribute to
+the top flux so that a constant flux value cannot be guaranteed.
+
+
+
+
+
+
+
+
+
+ Note:
+
+
+
+
+The
+application of a salinity flux at the model top additionally requires the setting of
+initial parameter use_top_fluxes
+= .T..
+
+
+
+
+
+
+
+
+ See
+also bottom_salinityflux .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ug_surface
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ u-component of the
+geostrophic
+wind at the surface (in m/s).
+
+
+
+
+
+
+
+
+
+
+This parameter assigns the value of the u-component of the geostrophic
+wind (ug) at the surface (k=0). Starting from this value, the initial
+vertical profile of the
+
+
+
+
+
+u-component of the geostrophic wind is constructed with ug_vertical_gradient
+and ug_vertical_gradient_level .
+The
+profile constructed in that way is used for creating the initial
+vertical velocity profile of the 3d-model. Either it is applied, as it
+has been specified by the user (initializing_actions
+= 'set_constant_profiles') or it is used for calculating a stationary
+boundary layer wind profile (initializing_actions
+= 'set_1d-model_profiles'). If ug is constant with height (i.e. ug(k)=ug_surface )
+and has a large
+value, it is recommended to use a Galilei-transformation of the
+coordinate system, if possible (see galilei_transformation ),
+in order to obtain larger time steps.
+
+
+
+
+
+
+
+
+
+ Attention:
+
+
+
+
+In case of ocean runs (see ocean ),
+this parameter gives the geostrophic velocity value (i.e. the pressure gradient) at the sea surface, which is
+at k=nzt. The profile is then constructed from the surface down to the
+bottom of the model.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ug_vertical_gradient
+
+
+
+
+
+
+
+
+
+
+ R(10)
+
+
+
+
+
+
+
+
+
+
+ 10
+* 0.0
+
+
+
+
+
+
+
+
+
+ Gradient(s) of the initial
+profile of the u-component of the geostrophic wind (in
+1/100s).
+
+
+
+
+
+
+
+
+
+
+The gradient holds starting from the height level defined by ug_vertical_gradient_level
+(precisely: for all uv levels k where zu(k) > ug_vertical_gradient_level ,
+ug(k) is set: ug(k) = ug(k-1) + dzu(k) * ug_vertical_gradient )
+up to the top
+boundary or up to the next height level defined by ug_vertical_gradient_level .
+A
+total of 10 different gradients for 11 height intervals (10
+intervals if ug_vertical_gradient_level (1)
+= 0.0) can be assigned. The surface geostrophic wind is assigned by ug_surface .
+
+
+
+
+
+
+
+
+
+ Attention:
+
+
+
+
+In case of ocean runs (see ocean ),
+the profile is constructed like described above, but starting from the
+sea surface (k=nzt) down to the bottom boundary of the model. Height
+levels have then to be given as negative values, e.g. ug_vertical_gradient_level = -500.0 , -1000.0 .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ug_vertical_gradient_level
+
+
+
+
+
+
+
+
+
+
+ R(10)
+
+
+
+
+
+
+
+
+
+
+ 10
+* 0.0
+
+
+
+
+
+
+
+
+
+ Height level from which on the
+gradient defined by ug_vertical_gradient
+is effective (in m).
+
+
+
+
+
+
+
+
+
+
+The height levels have to be assigned in ascending order. For the
+piecewise construction of a profile of the u-component of the
+geostrophic wind component (ug) see ug_vertical_gradient .
+
+
+
+
+
+
+
+
+
+ Attention:
+
+
+
+
+In case of ocean runs (see ocean ), the (negative) height levels have to be assigned in descending order.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ups_limit_e
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Subgrid-scale
+turbulent kinetic energy difference used as
+criterion for applying the upstream scheme when upstream-spline
+advection is switched on (in m2 /s2 ).
+
+
+
+
+
+
+
+
+
+
+ This variable steers the appropriate
+treatment of the
+advection of the subgrid-scale turbulent kinetic energy in case that
+the uptream-spline scheme is used . For further information see ups_limit_pt .
+
+
+
+
+
+
+
+
+
+ Only positive values are allowed for ups_limit_e .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ups_limit_pt
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Temperature
+difference used as criterion for applying
+the upstream scheme when upstream-spline advection is
+switched on
+(in K).
+
+
+
+
+
+
+
+
+
+ This criterion is used if the
+upstream-spline scheme is
+switched on (see scalar_advec ).
+
+
+
+
+
+If, for a given gridpoint, the absolute temperature difference with
+respect to the upstream
+grid point is smaller than the value given for ups_limit_pt ,
+the upstream scheme is used for this gridpoint (by default, the
+upstream-spline scheme is always used). Reason: in case of a very small
+upstream gradient, the advection should cause only a very small
+tendency. However, in such situations the upstream-spline scheme may
+give wrong tendencies at a
+grid point due to spline overshooting, if simultaneously the downstream
+gradient is very large. In such cases it may be more reasonable to use
+the upstream scheme. The numerical diffusion caused by the upstream
+schme remains small as long as the upstream gradients are small.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ The percentage of grid points for which the
+upstream
+scheme is actually used, can be output as a time series with respect to
+the
+three directions in space with run parameter (see dt_dots , the
+timeseries names in the NetCDF file are 'splptx' , 'splpty' ,
+ 'splptz' ). The percentage
+of gridpoints should stay below a certain limit, however, it
+is
+not possible to give
+a general limit, since it depends on the respective flow.
+
+
+
+
+
+
+
+
+
+ Only positive values are permitted for ups_limit_pt .
+
+
+
+
+
+
+
+
+
+
+
+A more effective control of
+the “overshoots” can be achieved with parameter cut_spline_overshoot .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ups_limit_u
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Velocity
+difference (u-component) used as criterion for
+applying the upstream scheme
+when upstream-spline advection is switched on (in m/s).
+
+
+
+
+
+
+
+
+
+ This variable steers the appropriate treatment of the
+advection of the u-velocity-component in case that the upstream-spline
+scheme is used. For further
+information see ups_limit_pt .
+
+
+
+
+
+
+
+
+
+
+ Only positive values are permitted for ups_limit_u .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ups_limit_v
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Velocity
+difference (v-component) used as criterion for
+applying the upstream scheme
+when upstream-spline advection is switched on (in m/s).
+
+
+
+
+
+
+
+
+
+ This variable steers the appropriate treatment of the
+advection of the v-velocity-component in case that the upstream-spline
+scheme is used. For further
+information see ups_limit_pt .
+
+
+
+
+
+
+
+
+
+
+ Only positive values are permitted for ups_limit_v .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ups_limit_w
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ Velocity
+difference (w-component) used as criterion for
+applying the upstream scheme
+when upstream-spline advection is switched on (in m/s).
+
+
+
+
+
+
+
+
+
+ This variable steers the appropriate treatment of the
+advection of the w-velocity-component in case that the upstream-spline
+scheme is used. For further
+information see ups_limit_pt .
+
+
+
+
+
+
+
+
+
+
+ Only positive values are permitted for ups_limit_w .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ use_surface_fluxes
+
+
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+
+
+ Parameter to
+steer the treatment of the subgrid-scale vertical
+fluxes within the diffusion terms at k=1 (bottom boundary).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ By default, the near-surface subgrid-scale fluxes are
+parameterized (like in the remaining model domain) using the gradient
+approach. If use_surface_fluxes
+= .TRUE. , the user-assigned surface fluxes are used
+instead
+(see surface_heatflux ,
+ surface_waterflux
+and surface_scalarflux )
+ or the
+surface fluxes are
+calculated via the Prandtl layer relation (depends on the bottom
+boundary conditions, see bc_pt_b ,
+ bc_q_b
+and bc_s_b ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ use_surface_fluxes
+is automatically set .TRUE. , if a Prandtl layer is
+used (see prandtl_layer ).
+
+
+
+
+
+
+
+
+
+
+ The user may prescribe the surface fluxes at the
+bottom
+boundary without using a Prandtl layer by setting use_surface_fluxes =
+ .T. and prandtl_layer = .F. . If , in this
+case, the
+momentum flux (u* 2 )
+should also be prescribed,
+the user must assign an appropriate value within the user-defined code.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ use_top_fluxes
+
+
+
+
+ L
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+
+ Parameter to steer
+the treatment of the subgrid-scale vertical
+fluxes within the diffusion terms at k=nz (top boundary).
+
+
+
+
+
+
+
+
+ By
+default, the fluxes at nz are calculated using the gradient approach.
+If use_top_fluxes
+= .TRUE. , the user-assigned top fluxes are used
+instead
+(see top_heatflux , top_momentumflux_u , top_momentumflux_v , top_salinityflux ).
+
+
+
+
+
+
+
+
+ Currently, no value for the latent heatflux can be assigned. In case of use_top_fluxes = .TRUE. , the latent
+heat flux at the top will be automatically set to zero.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ use_ug_for_galilei_tr
+
+
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+ .T.
+
+
+
+
+
+
+
+
+
+
+ Switch to
+determine the translation velocity in case that a
+Galilean transformation is used.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ In
+case of a Galilean transformation (see galilei_transformation ),
+ use_ug_for_galilei_tr
+= .T. ensures
+that the coordinate system is translated with the geostrophic windspeed.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Alternatively, with use_ug_for_galilei_tr
+= .F .,
+the
+geostrophic wind can be replaced as translation speed by the (volume)
+averaged velocity. However, in this case the user must be aware of fast
+growing gravity waves, so this
+choice is usually not recommended!
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ use_upstream_for_tke
+
+
+
+
+ L
+
+
+
+
+ .F.
+
+
+
+
+ Parameter to choose the
+advection/timestep scheme to be used for the subgrid-scale TKE.
+
+
+
+
+
+
+
+
+
+By
+default, the advection scheme and the timestep scheme to be used for
+the subgrid-scale TKE are set by the initialization parameters scalar_advec and timestep_scheme ,
+respectively. use_upstream_for_tke
+= .T.
+forces the Euler-scheme and the upstream-scheme to be used as timestep
+scheme and advection scheme, respectively. By these methods, the strong
+(artificial) near-surface vertical gradients of the subgrid-scale TKE
+are significantly reduced. This is required when subgrid-scale
+velocities are used for advection of particles (see particle package
+parameter use_sgs_for_particles ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ vg_surface
+
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+
+ v-component of the
+geostrophic
+wind at the surface (in m/s).
+
+
+
+
+
+
+
+
+
+
+This parameter assigns the value of the v-component of the geostrophic
+wind (vg) at the surface (k=0). Starting from this value, the initial
+vertical profile of the
+
+
+
+
+
+v-component of the geostrophic wind is constructed with vg_vertical_gradient
+and vg_vertical_gradient_level .
+The
+profile
+constructed in that way is used for creating the initial vertical
+velocity profile of the 3d-model. Either it is applied, as it has been
+specified by the user (initializing_actions
+= 'set_constant_profiles')
+or it is used for calculating a stationary boundary layer wind profile
+(initializing_actions
+=
+'set_1d-model_profiles'). If vg is constant
+with height (i.e. vg(k)=vg_surface )
+and has a large value, it is
+recommended to use a Galilei-transformation of the coordinate system,
+if possible (see galilei_transformation ),
+in order to obtain larger
+time steps.
+
+
+
+
+
+
+
+
+
+ Attention:
+
+
+
+
+In case of ocean runs (see ocean ),
+this parameter gives the geostrophic velocity value (i.e. the pressure gradient) at the sea surface, which is
+at k=nzt. The profile is then constructed from the surface down to the
+bottom of the model.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ vg_vertical_gradient
+
+
+
+
+
+
+
+
+
+
+ R(10)
+
+
+
+
+
+
+
+
+
+
+ 10
+* 0.0
+
+
+
+
+
+
+
+
+
+ Gradient(s) of the initial
+profile of the v-component of the geostrophic wind (in
+1/100s).
+
+
+
+
+
+
+
+
+
+
+The gradient holds starting from the height level defined by vg_vertical_gradient_level
+(precisely: for all uv levels k where zu(k)
+> vg_vertical_gradient_level ,
+vg(k) is set: vg(k) = vg(k-1) + dzu(k)
+* vg_vertical_gradient )
+up to
+the top boundary or up to the next height
+level defined by vg_vertical_gradient_level .
+A total of 10 different
+gradients for 11 height intervals (10 intervals if vg_vertical_gradient_level (1)
+=
+0.0) can be assigned. The surface
+geostrophic wind is assigned by vg_surface .
+
+
+
+
+
+
+
+
+
+ Attention:
+
+
+
+
+In case of ocean runs (see ocean ),
+the profile is constructed like described above, but starting from the
+sea surface (k=nzt) down to the bottom boundary of the model. Height
+levels have then to be given as negative values, e.g. vg_vertical_gradient_level = -500.0 , -1000.0 .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ vg_vertical_gradient_level
+
+
+
+
+
+
+
+
+
+
+ R(10)
+
+
+
+
+
+
+
+
+
+
+ 10
+* 0.0
+
+
+
+
+
+
+
+
+
+ Height level from which on the
+gradient defined by vg_vertical_gradient
+is effective (in m).
+
+
+
+
+
+
+
+
+
+
+The height levels have to be assigned in ascending order. For the
+piecewise construction of a profile of the v-component of the
+geostrophic wind component (vg) see vg_vertical_gradient .
+
+
+
+
+
+
+
+
+
+ Attention:
+
+
+
+
+In case of ocean runs (see ocean ), the (negative) height levels have to be assigned in descending order.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ wall_adjustment
+
+
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+ .T.
+
+
+
+
+
+
+
+
+
+
+ Parameter to
+restrict the mixing length in the vicinity of the
+bottom
+boundary (and near vertical walls of a non-flat topography ).
+
+
+
+
+
+
+
+
+
+ With wall_adjustment
+= .TRUE., the mixing
+length is limited to a maximum of 1.8 * z. This condition
+typically affects only the
+first grid points above the bottom boundary.
+ In case of a non-flat topography the respective horizontal distance from vertical walls is used.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ wall_heatflux
+
+
+
+
+
+ R(5)
+
+
+
+
+ 5 * 0.0
+
+
+
+
+ Prescribed
+kinematic sensible heat flux in K m/s
+at the five topography faces:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ wall_heatflux(0)
+ top face
+
+
+
+
+ wall_heatflux(1)
+ left face
+
+
+
+
+ wall_heatflux(2)
+ right face
+
+
+
+
+ wall_heatflux(3)
+ south face
+
+
+
+
+ wall_heatflux(4)
+ north face
+
+
+
+
+
+
+
+
+
+
+This parameter applies only in case of a non-flat topography . The
+parameter random_heatflux
+can be used to impose random perturbations on the internal
+two-dimensional surface heat
+flux field shf
+that is composed of surface_heatflux
+at the bottom surface and wall_heatflux(0)
+at the topography top face.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Last
+change: $Id$
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.2.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.2.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.2.html (revision 141)
@@ -0,0 +1,11586 @@
+
+
+
+
+
+
+
+
+
+
+
+
+ PALM chapter 4.2
+
+
+
+
+
+
+
+ Runtime parameters:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Parameter
+name
+
+
+ Type
+
+
+
+
+
+
+ Default
+
+
+ value
+
+
+
+
+
+
+ Explanation
+
+
+
+
+
+
+
+
+
+ averaging_interval
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+ Averaging interval for
+all output of temporally averaged data (in s).
+
+
+
+
+
+This
+parameter defines the time interval length for temporally averaged data
+(vertical profiles, spectra, 2d cross-sections, 3d volume data). By
+default, data are not subject to temporal averaging. The
+interval
+length is limited by the parameter dt_data_output_av .
+In any case, averaging_interval
+<= dt_data_output_av
+must hold.
+
+
+
+
+
+If
+an interval is defined, then by default the average is calculated from
+the data values of all timesteps lying within this interval. The number
+of time levels entering into the average can be reduced with the
+parameter dt_averaging_input .
+
+
+
+
+
+If
+an averaging interval can not be completed at the end of a run, it
+will be finished at the beginning of the next restart run. Thus for
+restart runs, averaging intervals do not
+necessarily begin at the beginning of the run.
+
+
+
+
+
+Parameters
+ averaging_interval_pr
+and averaging_interval_sp
+can be used to define different averaging intervals for vertical
+profile data and spectra, respectively.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ averaging_interval_pr
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value of averaging_
+
+
+
+interval
+
+
+
+
+
+
+
+
+
+ Averaging
+interval for output of vertical profiles to
+local
+file DATA_1D_PR_NETCDF
+ and/or PLOT1D_DATA
+(in s).
+
+
+
+
+
+ If
+this parameter is given a non-zero value, temporally
+averaged vertical profile data are output. By default, profile data
+data are not subject to temporal averaging. The interval length is
+limited by the parameter dt_dopr .
+In any case averaging_interval_pr <= dt_dopr
+ must
+hold.
+
+
+If an interval is defined, then by default the average
+is calculated
+from the data values of all timesteps lying within this interval. The
+number of time levels entering into the average can be reduced with the
+parameter dt_averaging_input_pr .
+
+
+ If
+an averaging interval can not be completed at the end of a run, it will
+be finished at the beginning of the next restart run. Thus for restart
+runs, averaging intervals do not
+necessarily begin at the beginning of the run.
+
+
+
+
+
+
+
+
+
+
+
+
+ call_psolver_at_all_
+
+
+
+substeps
+
+
+ L
+
+
+
+
+
+
+ .T.
+
+
+
+
+
+
+ Switch
+to steer the call of the pressure solver.
+
+
+
+
+
+
+In order to speed-up performance, the Poisson equation for perturbation
+pressure (see psolver ) can
+be called only at the last substep of multistep Runge-Kutta
+timestep schemes (see timestep_scheme )
+by setting call_psolver_at_all_substeps
+= .F. .
+In many cases, this sufficiently reduces the divergence of the velocity
+field. Nevertheless, small-scale ripples (2-delta-x) may occur. In this
+case and in case
+of non-cyclic lateral boundary conditions, call_psolver_at_all_timesteps
+= .T.
+should be used.
+
+
+
+
+
+
+
+
+
+
+
+
+ cfl_factor
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.1,
+0.8 or 0.9
+
+
+ (see right)
+
+
+
+
+
+
+
+
+
+ Time step limiting factor.
+
+
+
+
+
+ In the model, the maximum
+allowed time step according to CFL and
+diffusion-criterion
+dt_max is reduced by dt =
+dt_max * cfl_factor
+in order to avoid stability problems which may arise in the vicinity of
+the maximum allowed timestep. The condition 0.0
+< cfl_factor
+< 1.0 applies.
+
+
+
+
+
+
+
+
+ The default value of
+cfl_factor depends on
+the timestep_scheme used:
+
+
+
+
+
+
+
+
+ For the third order Runge-Kutta scheme it
+is cfl_factor = 0.9 .
+
+
+
+
+
+
+
+
+ In case of the leapfrog scheme a quite
+restrictive value of cfl_factor
+= 0.1 is used because for larger values the velocity
+divergence
+significantly effects the accuracy of the model results. Possibly larger values may
+be used with the leapfrog scheme but these are to be determined by
+appropriate test runs.
+
+
+
+
+
+
+ The default value for the Euler
+scheme is cfl_factor
+= 0.8 .
+
+
+
+
+
+
+
+
+
+
+
+
+ create_disturbances
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+ .T.
+
+
+
+
+
+
+
+
+
+ Switch to
+impose random perturbations to the horizontal
+velocity field.
+
+
+
+
+
+ With create_disturbances
+= .T., random
+perturbations can be imposed to the horizontal velocity field at
+certain times e.g. in order to trigger off the onset of convection,
+etc..
+
+
+
+
+
+
+
+
+ The temporal interval between
+these times can be steered with dt_disturb ,
+the vertical range of the perturbations with disturbance_level_b
+and disturbance_level_t ,
+and the perturbation amplitude with disturbance_amplitude .
+In case of non-cyclic lateral boundary conditions (see bc_lr
+and bc_ns ),
+the horizontal range of the perturbations is determined by inflow_disturbance_begin
+and inflow_disturbance_end .
+A perturbation is added to each grid point with its individual value
+determined by multiplying the disturbance amplitude with a uniformly
+distributed random number.
+After this, the arrays of u and v are smoothed by applying a
+Shuman-filter twice and made divergence-free by applying the pressure
+solver.
+
+
+
+
+
+
+
+
+ The random number generator to
+be used can be chosen with random_generator .
+
+
+
+
+
+
+
+
+
+ As soon as the desired flow features have
+developed
+(e.g. convection has started), further imposing of
+perturbations
+is not necessary and can be omitted (this does not hold for non-cyclic
+lateral boundaries!). This can be steered by assigning
+an upper limit value for the perturbation energy (the perturbation
+energy is defined by the deviation of the velocity from the mean flow)
+using the parameter disturbance_energy_limit .
+As soon as the perturbation energy has exceeded this energy limit, no
+more random perturbations are assigned
+
+
+
+.
+
+
+
+Timesteps where a random perturbation has been imposed are marked in
+the local file RUN_CONTROL
+by the character "D" appended to the values of the maximum horizontal
+velocities.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ cross_normalized_x
+
+
+
+
+
+
+ C*10
+
+
+
+ (100)
+
+
+ 100 * ' '
+
+
+
+
+
+
+ Type of
+normalization applied to the x-coordinate of vertical
+profiles to be plotted with profil .
+
+
+
+
+
+ This parameter only applies for data_output_format
+= 'profil' .
+
+
+
+
+ If
+vertical profiles are plotted with the plot software profil (data on
+local file PLOT1D_DATA ,
+parameters on local file PLOT1D_PAR )
+the x-values of the data points can be normalized with respect to
+certain quantities (e.g. the near-surface heat flux) in order to ensure
+a better comparability. This type of normalization then applies to all
+profiles of one coordinate system (panel). The normalization quantities
+are re-calculated for each output time of each individual profile. If
+temporally averaged profiles are output (see averaging_interval_pr ),
+then the normalization quantities are also temporally averaged
+accordingly. If the value of a normalization quantity becomes zero,
+then normalization for the total respective coordinate system (panel)
+is switched off automatically (also for the y-axis).
+
+
+
+
+
+
+
+
+ By default, the normalization quantities are calculated as the
+horizontal mean of the total model domain and and these values are also
+used for the normalization of profiles from subdomains (see statistic_regions ).
+Instead of this, they can be calculated from the data of a certain
+subdomain by using the parameter normalizing_region
+(however, they are used again for all subdomains and even for the total
+domain).
+
+
+
+
+
+ The user can choose between
+the following normalization
+quantities:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'wpt0'
+
+
+
+ Normalization with
+respect
+to the total surface sensible heat
+flux (k=0 ).
+
+
+
+
+
+
+
+
+ 'ws2'
+
+
+
+ Normalization with
+respect
+to w* 2
+(square of the characteristic vertical wind speed of the CBL)
+
+
+
+
+
+
+
+
+
+ 'tsw2'
+
+
+
+ Normalization with
+respect
+to the square of the characteristic
+temperature of the CBL theta* (this is defined
+as ratio of
+the surface heat flux and w* ).
+
+
+
+
+
+
+
+
+
+ 'ws3'
+
+
+
+ Normalization with
+respect
+to w* 3 .
+
+
+
+
+
+
+
+
+
+ 'ws2tsw'
+
+
+
+ Normalization with
+respect
+to w* 2 theta*
+(for definition of theta* see 'tsw2' ).
+
+
+
+
+
+
+
+
+
+ 'wstsw2'
+
+
+
+ Normalization with
+respect
+to w* 2 theta*
+(for definition of theta* see 'tsw2' ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ For each
+coordinate system (panel) to be drawn (see cross_profiles )
+an individual normalization quantity can be assigned. For example: if cross_normalized_x =
+ 'ws2' ,'ws3' ,
+then the
+x-values in the 1st coordinate system are normalized with respect to w* 2
+and in the 2nd system with respect to w* 3 .
+Data
+of the further coordinate systems (if any are to be drawn) are not
+normalized.
+
+
+
+
+
+ Using a normalization
+leaves all vertical profile data on
+local file PLOT1D_DATA
+unaffected, it only affects the visualization. Within profil , the
+normalization is steered
+by parameter normx
+which may be changed subsequently by the user in the parameter file
+(local file PLOT1D_PAR ).
+
+
+
+
+
+
+
+The assigned normalization quantity is noted in the axes labels of the
+respective coordinate systems (see cross_xtext ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ cross_normalized_y
+
+
+
+
+
+
+ C*10
+
+
+
+ (100)
+
+
+ 100 * ' '
+
+
+
+
+
+
+ Type of
+normalization applied to the y-coordinate of vertical
+profiles to be plotted with profil .
+
+
+
+
+
+ This parameter only applies for data_output_format
+= 'profil' .
+
+
+
+
+ If
+vertical profiles are plotted with the plot software profil (data on
+local file PLOT1D_DATA ,
+parameter on local file PLOT1D_PAR )
+the y-values of the data points can be normalized with respect to
+certain quantities (at present only the normalization with respect to
+the boundary layer height is possible) in order to ensure a better
+comparability.
+
+
+
+
+
+ The user can choose between the
+following normalization
+quantities:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'z_i'
+
+
+
+ Normalization with
+respect
+to the boundary layer height
+(determined from the height where the heat flux achieves its minimum
+value).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ For
+further explanations see cross_normalized_x.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ cross_profiles
+
+
+
+
+
+
+ C*100
+
+
+
+ (100)
+
+
+ see right
+
+
+
+
+
+
+
+
+
+ Determines
+which vertical profiles are to be presented in
+which coordinate system if the plot software profil is used.
+
+
+
+
+
+
+ This parameter only applies for
+ data_output_format
+= 'profil' .
+
+
+
+
+ The
+default assignment is:
+
+
+
+
+
+ cross_profiles
+=
+
+
+
+
+
+
+
+
+
+
+
+ '
+u v ',
+
+
+ ' pt
+',
+
+
+ '
+w"pt" w*pt* w*pt*BC wpt wptBC ',
+
+
+ '
+w"u" w*u* wu w"v"w*v* wv ',
+
+
+ ' km
+kh ',
+
+
+ ' l '
+,
+
+
+
+14 * '
+'
+
+
+
+
+
+
+
+
+
+
+
+ If plot output of
+vertical profiles is produced (see data_output_pr ),
+the appropriate data are written to the local file PLOT1D_DATA .
+Simultaneously, the model produces a parameter file (local name PLOT1D_PAR )
+which describes the layout for a plot to be generated with the plot
+program profil .
+The parameter cross_profiles
+determines how many coordinate systems (panels) the plot contains and
+which profiles are supposed to be drawn into which panel. cross_profiles
+expects a character string (up to 100 characters long) for each
+coordinate system, which consists of the names of the profiles to be
+drawn into this system (all available profiles and their respective
+names are described at parameter data_output_pr ).
+The single names have to be separated by one blank (' ') and a blank
+must be spent also at the beginning and at the end of the
+string.
+
+
+
+
+
+ Example:
+
+
+
+
+
+
+
+
+
+
+
+ cross_profiles = ' u v ',
+' pt '
+
+
+
+
+
+
+
+
+
+
+
+ In this case the
+plot consists of two coordinate systems
+(panels) with the first panel containing the profiles of the horizontal
+velocity components ('u'
+and 'v' )
+of all output times (see dt_dopr )
+and the second one containing the profiles of the potential temperature
+('pt' ).
+
+
+
+
+
+
+
+
+
+ Whether the coordinate systems are actually drawn,
+depends on
+whether data of the appropriate profiles were output during the run
+(profiles to be output have to be selected with the parameter data_output_pr ).
+For example if data_output_pr = 'u' , 'v' was assigned,
+then
+the plot only consists of one panel, since no profiles of the potential
+temperature were output. On the other hand, if profiles were assigned
+to data_output_pr whose names do not appear in cross_profiles ,
+then the respective profile data are output (PLOT1D_DATA )
+but they are not drawn in the plot.
+
+
+
+
+
+
+The arrangement of the panels in the plot can be controlled
+with the parameters profile_columns
+and profile_rows .
+Up to 100 panels systems are allowed in a plot (however, they may be
+distributed on several pages).
+
+
+
+
+
+
+
+
+
+
+
+ cross_xtext
+
+
+
+
+
+
+ C*40
+
+
+
+ (100)
+
+
+ see right
+
+
+
+
+
+
+
+
+
+ x-axis labels
+of vertical profile coordinate systems to be
+plotted with profil .
+
+
+
+
+
+
+ This parameter only applies for data_output_format
+= 'profil' .
+
+
+
+
+ The
+default assignment is:
+
+
+
+
+
+ cross_xtext
+=
+
+
+
+
+
+
+
+
+
+
+
+ 'wind speed in
+ms>->1',
+
+
+ 'pot. temperature in
+K',
+
+
+
+ 'heat flux in K
+ms>->1',
+
+
+ 'momentum flux in
+m>2s>2',
+
+
+ 'eddy diffusivity in
+m>2s>->1',
+
+
+ 'mixing length in m',
+
+
+
+14 * ' '
+
+
+
+
+
+
+
+
+
+
+
+ This parameter can be used to assign x-axis
+labels to vertical
+profiles to be plotted with the plot software profil (for output
+of vertical
+profile data see data_output_pr ).
+
+
+
+The labels are assigned to those coordinate systems (panels) defined by
+ cross_profiles
+according to their respective order (compare the default values of cross_xtext
+and cross_profiles ).
+
+
+
+
+
+ Umlauts
+are possible (write “ in front of, similar to TeX), as
+well as super- and subscripts (use ">" or "<" in front of
+each
+character), special characters etc. (see UNIRAS manuals) when using the
+plot software profil .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ cycle_mg
+
+
+
+
+
+
+ C*1
+
+
+
+ 'w'
+
+
+
+
+
+
+ Type of cycle
+to be used with the multi-grid method.
+
+
+
+
+
+ This
+parameter determines which type of cycle is applied in
+the multi-grid method used for solving the Poisson equation for
+perturbation pressure (see psolver ).
+It defines in which way it is switched between the fine and coarse
+grids. So-called v- and w-cycles are realized (i.e. cycle_mg
+may be assigned the values 'v' or 'w' ).
+The
+computational cost of w-cycles is much higher than that of v-cycles,
+however, w-cycles give a much better convergence.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ data_output
+
+
+
+
+
+
+ C * 10 (100)
+
+
+
+
+
+
+ 100 * ' '
+
+
+
+
+
+
+ Quantities
+for which 2d cross section and/or 3d volume data are to be output.
+
+
+
+
+
+PALM
+allows the output of instantaneous data as well as of temporally
+averaged data which is steered by the strings assigned to this
+parameter (see below).
+
+
+
+
+
+By default, cross section
+data are output (depending on the selected cross sections(s), see
+below) to local files DATA_2D_XY_NETCDF ,
+ DATA_2D_XZ_NETCDF
+and/or DATA_2D_YZ_NETCDF .
+Volume data are output to file DATA_3D_NETCDF .
+If the user has switched on the output of temporally averaged data,
+these are written seperately to local files DATA_2D_XY_AV_NETCDF ,
+ DATA_2D_XZ_AV_NETCDF ,
+ DATA_2D_YZ_AV_NETCDF ,
+and DATA_3D_AV_NETCDF ,
+respectively.
+
+
+
+
+
+The
+filenames already suggest that all files have NetCDF format.
+Informations about the file content (kind of quantities, array
+dimensions and grid coordinates) are part of the self describing NetCDF
+format and can be extracted from the NetCDF files using the command
+"ncdump -c <filename>". See chapter 4.5.1 about processing
+the PALM NetCDF data.
+
+
+
+
+
+The following quantities are
+available for output by default (quantity names ending with '*' are only allowed for the output of horizontal cross sections):
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ quantity
+name
+
+
+ meaning
+
+
+ unit
+
+
+ remarks
+
+
+
+
+
+
+
+
+ e
+
+
+ SGS TKE
+
+
+ m2 /s2
+
+
+
+
+
+
+
+
+
+
+
+ lwp*
+
+
+ liquid water path
+
+
+ m
+
+
+ only horizontal cross section
+is allowed, requires cloud_physics
+= .TRUE.
+
+
+
+
+
+
+
+
+ p
+
+
+ perturpation
+pressure
+
+
+ N/m2 ,
+Pa
+
+
+
+
+
+
+
+
+
+
+
+ pc
+
+
+ particle/droplet
+concentration
+
+
+ #/gridbox
+
+
+ requires that particle
+advection is switched on by mrun -option
+"-p particles"
+
+
+
+
+
+
+
+
+ pr
+
+
+ mean
+particle/droplet radius
+
+
+ m
+
+
+ requires that particle
+advection is switched on by mrun -option
+"-p particles"
+
+
+
+
+
+
+
+
+ pra*
+
+
+ precipitation amount
+
+
+ mm
+
+
+ only horizontal cross section
+is allowed, requires precipitation
+= .TRUE., time interval on which amount refers to is defined by precipitation_amount_interval
+
+
+
+
+
+
+
+
+ prr*
+
+
+ precipitation rate
+
+
+ mm/s
+
+
+ only horizontal cross section
+is allowed, requires precipitation
+= .TRUE.
+
+
+
+
+
+
+
+
+ pt
+
+
+ potential
+temperature
+
+
+
+
+
+ K
+
+
+
+
+
+
+
+
+
+
+
+ q
+
+
+ specific humidity
+(or total water content, if cloud physics is switched on)
+
+
+ kg/kg
+
+
+ requires humidity = .TRUE.
+
+
+
+
+
+
+
+
+ ql
+
+
+ liquid water
+content
+
+
+ kg/kg
+
+
+ requires cloud_physics
+= .TRUE.
+or cloud_droplets
+= .TRUE.
+
+
+
+
+
+
+
+
+ ql_c
+
+
+ change in liquid
+water content due to condensation/evaporation during last timestep
+
+
+ kg/kg
+
+
+ requires cloud_droplets
+= .TRUE.
+
+
+
+
+
+
+
+
+ ql_v
+
+
+ volume of liquid
+water
+
+
+ m3 /gridbox
+
+
+ requires cloud_droplets
+= .TRUE.
+
+
+
+
+
+
+
+
+ ql_vp
+
+
+ weighting factor
+
+
+
+
+
+ requires cloud_droplets
+= .TRUE.
+
+
+
+
+
+
+
+
+ qv
+
+
+ water vapor
+content (specific humidity)
+
+
+ kg/kg
+
+
+ requires cloud_physics
+= .TRUE.
+
+
+
+
+
+
+
+
+ rho
+
+
+ potential density
+
+
+ kg/m3
+
+
+ requires ocean
+= .TRUE.
+
+
+
+
+
+
+
+
+ s
+
+
+ concentration of
+the scalar
+
+
+ 1/m3
+
+
+ requires passive_scalar
+= .TRUE.
+
+
+
+
+
+
+
+
+ sa
+
+
+ salinity
+
+
+ psu
+
+
+ requires ocean
+= .TRUE.
+
+
+
+
+
+
+
+
+ t*
+
+
+ (near surface)
+characteristic temperature
+
+
+ K
+
+
+ only horizontal cross section
+is allowed
+
+
+
+
+
+
+
+
+ u
+
+
+ u-component of
+the velocity
+
+
+ m/s
+
+
+
+
+
+
+
+
+
+
+
+ u*
+
+
+ (near surface)
+friction velocity
+
+
+ m/s
+
+
+ only horizontal cross section
+is allowed
+
+
+
+
+
+
+
+
+ v
+
+
+ v-component of
+the velocity
+
+
+ m/s
+
+
+
+
+
+
+
+
+
+
+
+ vpt
+
+
+ virtual potential
+temperature
+
+
+ K
+
+
+ requires humidity = .TRUE.
+
+
+
+
+
+
+
+
+ w
+
+
+ w-component of
+the velocity
+
+
+ m/s
+
+
+
+
+
+
+
+
+
+
+
+ z0*
+
+
+ roughness length
+
+
+ m
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Multiple
+quantities can be assigned, e.g. data_output
+= 'e' , 'u' , 'w' .
+
+
+
+
+
+By
+assigning the pure strings from the above table, 3d volume data is
+output. Cross section data can be output by appending the string '_xy' , '_xz' , or '_yz' to the
+respective quantities. Time averaged output is created by
+appending the string '_av'
+ (for
+cross section data, this string must be appended after the cross
+section string). Cross section data can also be (additionally) averaged
+along the direction normal to the respective section (see below).
+Assignments of quantities can be given in arbitrary
+order:
+
+
+
+
+
+Example:
+
+
+
+
+
+
+
+ data_output = 'u' , 'pt_xz_av' , 'w_xy' , 'u_av' .
+
+
+
+
+
+
+
+
+This
+example will create the following output: instantaneous 3d volume data
+of u-velocity component (by default on file DATA_3D_NETCDF), temporally
+averaged 3d volume data of u-velocity component (by default on file
+DATA_3D_AV_NETCDF), instantaneous horizontal cross section data of
+w-velocity component (by default on file DATA_2D_XY_NETCDF), and
+temporally averaged vertical cross section data of potential
+temperature (by default on file DATA_2D_XZ_AV_NETCDF).
+
+
+
+
+
+The
+user is allowed to extend the above list of quantities by defining his
+own output quantities (see the user-parameter data_output_user ).
+
+
+
+
+
+The
+time interval of the output times is determined via dt_data_output .
+This is valid for all types of output quantities by default. Individual
+time intervals for instantaneous (!) 3d and section data can
+be
+declared using dt_do3d , dt_do2d_xy , dt_do2d_xz , and dt_do2d_yz .
+
+
+
+
+
+Also,
+an individual time interval for output of temporally averaged data can
+be assigned using parameter dt_data_output_av .
+This applies to both 3d volume and cross section data. The length of
+the averaging interval is controlled via parameter averaging_interval .
+
+
+
+
+
+The
+parameter skip_time_data_output
+can be used to shift data output activities for a given time interval.
+Individual intervals can be set using skip_time_do3d ,
+ skip_time_do2d_xy , skip_time_do2d_xz , skip_time_do2d_yz , and skip_time_data_output_av .
+
+
+
+
+ With
+the parameter nz_do3d
+the output can be limited in the vertical direction up to a certain
+grid point.
+
+
+
+
+
+ Cross sections extend through the
+total model
+domain. In the two horizontal directions all grid points with 0
+<= i
+<= nx+1 and 0 <= j
+<= ny+1 are output so that in case of cyclic boundary conditions
+the
+complete total domain is represented. The location(s) of the cross
+sections can be defined with parameters section_xy ,
+ section_xz , and section_yz . Assigning section_.. = -1
+causes the output data to be averaged along the direction
+normal to the respective section.
+
+
+
+
+
+
+
+
+ Output of user defined quantities:
+
+
+
+
+
+Beside
+the standard quantities from the above list, the user can output any
+other quantities. These have to be defined and calculated within the
+user-defined code (see 3.5.4 ).
+They can be selected for output with the user-parameter data_output_user
+for which the same rules apply as for data_output .
+Output of the user defined quantities (time interval, averaging,
+selection of cross sections, etc.) is controlled with the parameters
+listed above and data are written to the same file(s) as the standard
+quantities.
+
+
+
+
+
+
+
+ Output
+on parallel machines:
+
+
+
+
+
+By default, with parallel runs, processors output only data
+of their respective subdomains into seperate local files (file names
+are
+constructed by appending the four digit processor ID, e.g.
+<filename>_0000, <filename>_0001, etc.).
+After PALM has
+finished, the contents of these individual
+files are sampled into one final file
+using the program combine_plot_fields.x
+(to be started e.g. by a suitable OUTPUT command in the mrun
+configuration file).
+
+
+
+
+
+ Alternatively, PALM is able to
+collect all grid points of a
+cross section on PE0 before output is done. In this case only
+one
+output file (DATA_2D_XY_NETCDF, etc.) is created and combine_plot_fields.x
+does not have to be called. In case of very large numbers of horizontal
+gridpoints, sufficient
+memory is required on PE0. This method can be used by
+assigning data_output_2d_on_each_pe
+= .F. .
+
+
+
+
+ 3d volume data output is
+always handled seperately by each processor so that combine_plot_fields.x
+has to be called anyway after PALM has been finished.
+
+
+
+
+
+
+
+ Old formats:
+
+
+
+
+
+ Beside
+the NetCDF format, 2d cross section data and 3d volume data
+can
+also be output, for historical reasons, in a different (binary) format
+using parameter data_output_format .
+
+
+
+
+ By
+assigning data_output_format
+ = 'avs' ,
+the 3d volume data is output to the local file PLOT3D_DATA .
+Output is in FORTRAN binary format readable by
+the plot software AVS .
+The order of data on the file follows the order used in the assignment
+for data_output (e.g. data_output
+= 'p' , 'v' ,...
+means that the file starts with the pressure data, followed by the
+v-component of the velocity, etc.). Both instantaneous and time
+averaged data are written on this file! Additional to this file, PALM
+creates
+a second binary file (local name PLOT3D_COOR )
+with coordinate information needed by AVS .
+As third and
+fourth file two ASCII files are created (AVS-FLD-format, local name PLOT3D_FLD
+and PLOT3D_FLD_COOR ),
+which describe the contents of the data file and/or coordinate file
+and are used by AVS. However, AVS expects the content description in
+one file. This needs the local file PLOT3D_FLD_COOR to be appended to
+the file
+PLOT3D_FLD (by suitable OUTPUT command in the mrun
+configuration file: “cat
+PLOT3D_FLD_COOR >> PLOT3D_FLD ”)
+after PALM has
+finished. To reduce the amount of data, output to this file
+can be done
+in
+compressed form (see do3d_compress ).
+Further details about plotting 3d volume data with AVS can be found in
+ chapter
+4.5.5 .
+
+
+By assigning data_output_format =
+ 'iso2d' ,
+the cross section data is output to the local files PLOT2D_XY , PLOT2D_XZ , and PLOT2D_YZ .
+Output is in FORTRAN binary format readable by
+the plot software iso2d .
+The order of data on the files follows the order used in the assignment
+for data_output (e.g. data_output
+= 'p_xy' , 'v_xy_av' ,...
+means that the file containing the horizontal cross section data starts
+with the instantaneous pressure data, followed by the
+temporally averaged v-component of the velocity, etc.). Both
+instantaneous and time averaged data are written on this
+file!Additional to these binary files, PALM
+creates NAMELIST parameter files
+(local names PLOT2D_XY_GLOBAL ,
+ PLOT2D_XY_LOCAL ,
+ PLOT2D_XZ_GLOBAL ,
+ PLOT2D_XZ_LOCAL ,
+ PLOT2D_YZ_GLOBAL ,
+ PLOT2D_YZ_LOCAL )
+which can be used as parameter input files for the plot software iso2d .
+That needs local files with suffix _LOCAL to be appended to the
+respective files with suffix _GLOBAL (by
+suitable OUTPUT commands in the mrun
+configuration file, e.g.: “cat
+PLOT2D_XY_LOCAL >> PLOT2D_XY_GLOBAL ”)
+after PALM has
+finished. Cross sections can be directly plotted with iso2d using the
+respective data and
+parameter file. The plot layout is steered via the parameter input
+file.
+The values of these iso2d
+parameters are determined by a set of mostly internal PALM parameters
+(exception: z_max_do2d ).
+All parameter values can be changed by editing the parameter input
+file. Further details about plotting 2d cross sections with iso2d can be found
+in chapter
+4.5.4 .
+
+
+
+
+
+ Important:
+
+
+There
+is no guarantee that iso2d- and avs-output will be available in future
+PALM versions (later than 3.0).
+
+
+
+
+
+
+
+
+ data_output_format
+
+
+
+
+
+
+ C * 10 (10)
+
+
+
+ 'netcdf'
+
+
+
+ Format of output data.
+
+
+
+
+
+By
+default, all data (profiles, time
+series, spectra, particle data, cross sections, volume data) are output
+in NetCDF format (see chapter 4.5.1 ).
+Exception: restart data (local files BININ , BINOUT , PARTICLE_RESTART_DATA_IN ,
+ PARTICLE_RESTART_DATA_OUT )
+are always output in FORTRAN binary format.
+
+
+
+
+
+The
+numerical precision of the NetCDF output is determined with parameter netcdf_precision .
+
+
+
+
+
+The
+maximum file size for NetCDF files is 2 GByte by default. Use the
+parameter netcdf_64bit
+if larger files have to be created.
+
+
+
+
+
+For historical
+reasons, other data formats are still available. Beside 'netcdf', data_output_format
+may be assigned the following values:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'profil'
+
+
+ output
+of profiles, time series and spectra in ASCII format to be
+read by the graphic software profil
+ (see chapters 4.5.2 ,
+ 4.5.3 )
+
+
+
+
+
+
+
+
+ 'iso2d'
+
+
+ output
+of 2d cross-sections in FORTRAN binary format to be read by the graphic
+software iso2d
+(see chapter 4.5.4 )
+
+
+
+
+
+
+
+
+ 'avs'
+
+
+ output
+of 3d volume data in FORTRAN binary format to be read by the graphic
+software AVS
+(see chapter 4.5.5 )
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Multiple
+values can be assigned to data_output_format ,
+i.e. if the user wants to have both the "old" data format suitable for iso2d as well as
+cross section data in NetCDF format, then data_output_format =
+ 'iso2d' , 'netcdf' has to be
+assigned.
+
+
+
+
+
+ Warning:
+There is no guarantee that the "old" formats will be available in
+future PALM versions (beyond 3.0)!
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ data_output_pr
+
+
+
+
+
+
+ C *
+10
+
+
+
+(100)
+
+
+ 100
+* ' '
+
+
+
+
+
+ Quantities for which vertical profiles (horizontally averaged)
+are to be output.
+
+
+
+
+
+ By default vertical
+profile data is output to the local file DATA_1D_PR_NETCDF .
+The file's format is NetCDF. Further details about processing
+NetCDF data are given in chapter 4.5.1 .
+
+
+
+
+ For
+historical reasons, data can also be output in ASCII-format on local
+file PLOT1D_DATA
+which is readable by the graphic software profil . See
+parameter data_output_format
+for defining the format in which data shall be output.
+
+
+
+
+
+
+
+
+ For horizontally averaged vertical
+profiles always all
+vertical
+grid points (0 <= k <= nz+1) are output to file. Vertical
+profile data refers to the total domain but profiles for subdomains can
+also be output (see statistic_regions ).
+
+
+
+
+
+
+ The temporal interval of the output times of
+profiles is
+assigned via the parameter dt_dopr .
+Within the file PLOT1D_DATA ,
+the profiles are ordered with respect to their
+output times.
+
+
+
+
+ Profiles can also be temporally
+averaged (see averaging_interval_pr ).
+
+
+
+
+
+
+
+
+
+ The following list shows the values which can be
+assigned to data_output_pr .
+The profile data is either defined on
+u-v-levels (variables marked in red )
+or
+on w-levels (green ).
+According to this,
+the
+z-coordinates of the individual profiles vary. Beyond that, with a
+Prandtl layer switched on (prandtl_layer )
+the lowest output
+level is z = zu(1) instead of z = zw(0) for profiles w''
+u'',w''v" , wu and wv
+. Turbulence quantities such as w*u* or u*2 are calculated from turbulent fluctuations that are defined as deviations from the instantaneous horizontal average.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ u
+
+
+
+ u-component of the
+velocity (in m/s).
+
+
+
+
+
+
+
+
+ v
+
+
+
+ v-component of the
+velocity (in m/s).
+
+
+
+
+
+
+
+
+ w
+
+
+
+ w-component of the
+velocity (in m/s).
+
+
+
+
+
+
+
+
+ pt
+
+
+
+ Potential temperature (in
+K).
+
+
+
+
+
+
+
+
+ vpt
+
+
+
+ Virtual potential
+temperature (in K).
+
+
+
+
+
+
+
+
+ lpt
+
+
+
+ Potential liquid water
+temperature (in K).
+
+
+
+
+
+
+
+
+ q
+
+
+
+ Total water content
+(in kg/kg).
+
+
+
+
+
+
+
+
+ qv
+
+
+
+ Specific humidity (in
+kg/kg).
+
+
+
+
+
+
+
+
+ ql
+
+
+
+ Liquid water content
+(in kg/kg).
+
+
+
+
+
+
+
+
+ rho
+
+
+ Potential density (in kg/m3 ).
+
+
+
+
+
+
+
+
+ s
+
+
+
+ Scalar concentration (in
+kg/m3 ).
+
+
+
+
+
+
+
+
+ sa
+
+
+ Salinity (in psu).
+
+
+
+
+
+
+
+
+ e
+
+
+
+ Turbulent kinetic energy
+(TKE, subgrid-scale) (in m2 /s2 ).
+
+
+
+
+
+
+
+
+
+ e*
+
+
+
+ Perturbation energy
+(resolved) (in m2 /s2 ).
+
+
+
+
+
+
+
+
+
+ km
+
+
+
+ Eddy diffusivity for
+momentum (in m2 /s).
+
+
+
+
+
+
+
+
+
+ kh
+
+
+
+ Eddy diffusivity for heat
+(in m2 /s).
+
+
+
+
+
+
+
+
+ l
+
+
+
+ Mixing length (in m).
+
+
+
+
+
+
+
+
+
+ w"u"
+
+
+
+ u-component of the
+subgrid-scale vertical momentum flux (in m2 /s2 ).
+
+
+
+
+
+
+
+
+
+ w*u*
+
+
+
+ u-component of the
+resolved vertical momentum flux (in m2 /s2 ).
+
+
+
+
+
+
+
+
+
+ wu
+
+
+
+ u-component of the total
+vertical momentum flux (w"u" + w*u* )
+(in m2 /s2 ).
+
+
+
+
+
+
+
+
+
+ w"v"
+
+
+
+ v-component of the
+subgrid-scale vertical momentum flux (in m2 /s2 ).
+
+
+
+
+
+
+
+
+
+ w*v*
+
+
+
+ v-component of the
+resolved vertical momentum flux (in m2 /s2 ).
+
+
+
+
+
+
+
+
+
+ wv
+
+
+
+ v-component of the total
+vertical momentum flux (w"v" + w*v* )
+(in m2 /s2 ).
+
+
+
+
+
+
+
+
+
+ w"pt"
+
+
+
+ Subgrid-scale vertical
+sensible heat flux (in K m/s).
+
+
+
+
+
+
+
+
+ w*pt*
+
+
+
+ Resolved vertical
+sensible
+heat flux (in K m/s).
+
+
+
+
+
+
+
+
+ wpt
+
+
+
+ Total vertical sensible
+heat flux (w"pt" + w*pt* )
+(in K
+m/s).
+
+
+
+
+
+
+
+
+ w*pt*BC
+
+
+
+ Subgrid-scale vertical
+sensible heat flux using the
+Bott-Chlond scheme (in K m/s).
+
+
+
+
+
+
+
+
+ wptBC
+
+
+
+ Total vertical sensible
+heat flux using the Bott-Chlond scheme
+(w"pt"
++ w*pt*BC ) (in K m/s).
+
+
+
+
+
+
+
+
+
+ w"vpt"
+
+
+
+ Subgrid-scale vertical
+buoyancy flux (in K m/s).
+
+
+
+
+
+
+
+
+ w*vpt*
+
+
+
+ Resolved vertical
+buoyancy
+flux (in K m/s).
+
+
+
+
+
+
+
+
+ wvpt
+
+
+
+ Total vertical buoyancy
+flux (w"vpt" + w*vpt*) (in K m/s).
+
+
+
+
+
+
+
+
+ w"q"
+
+
+
+ Subgrid-scale vertical
+water flux (in kg/kg m/s).
+
+
+
+
+
+
+
+
+ w*q*
+
+
+
+ Resolved vertical water
+flux (in kg/kg m/s).
+
+
+
+
+
+
+
+
+ wq
+
+
+
+ Total vertical water flux
+(w"q" + w*q*) (in kg/kg m/s).
+
+
+
+
+
+
+
+
+ w"qv"
+
+
+
+ Subgrid-scale vertical
+latent heat flux (in kg/kg m/s).
+
+
+
+
+
+
+
+
+ w*qv*
+
+
+
+ Resolved vertical latent
+heat flux (in kg/kg m/s).
+
+
+
+
+
+
+
+
+ wqv
+
+
+
+ Total vertical latent
+heat
+flux (w"qv" + w*qv*) (in kg/kg m/s).
+
+
+
+
+
+
+
+
+
+ w"s"
+
+
+
+ Subgrid-scale vertical
+scalar concentration flux (in kg/m3 m/s).
+
+
+
+
+
+
+
+
+
+ w*s*
+
+
+
+ Resolved vertical scalar
+concentration flux (in kg/m3 m/s).
+
+
+
+
+
+
+
+
+
+ ws
+
+
+
+ Total vertical scalar
+concentration flux (w"s" + w*s*) (in kg/m3 m/s).
+
+
+
+
+
+
+
+
+
+ w"sa"
+
+
+ Subgrid-scale vertical
+salinity flux (in psu m/s).
+
+
+
+
+
+
+
+
+ w*sa*
+
+
+ Resolved vertical salinity flux (in psu m/s).
+
+
+
+
+
+
+
+
+ wsa
+
+
+ Total vertical salinity flux (w"sa" + w*sa*) (in psu m/s).
+
+
+
+
+
+
+
+
+ w*e*
+
+
+
+ Vertical flux of
+perturbation energy (resolved)
+
+
+
+
+
+
+
+
+ u*2
+
+
+
+ Variance of the
+u-velocity
+component (resolved)
+
+
+
+
+
+
+
+
+ v*2
+
+
+
+ Variance of the
+v-velocity
+component (resolved)
+
+
+
+
+
+
+
+
+ w*2
+
+
+
+ Variance of the w-velocity
+component (resolved)
+
+
+
+
+
+
+
+
+ pt*2
+
+
+
+ Variance of the potential
+temperature (resolved)
+
+
+
+
+
+
+
+
+ w*3
+
+
+
+ Third moment of the
+w-velocity component (resolved)
+
+
+
+
+
+
+
+
+ Sw
+
+
+
+ Skewness of the
+w-velocity
+component (resolved, Sw
+= W3 /(w2 )1.5 )
+
+
+
+
+
+
+
+
+
+ w*2pt*
+
+
+
+ Third moment (resolved)
+
+
+
+
+
+
+
+
+
+ w*pt*2
+
+
+
+ Third moment (resolved)
+
+
+
+
+
+
+
+
+
+ w*u*u*/dz
+
+
+
+ Energy production by
+shear
+(resolved)
+
+
+
+
+
+
+
+
+ w*p*/dz
+
+
+
+ Energy production by
+turbulent transport of pressure
+fluctuations (resolved)
+
+
+
+
+
+
+
+
+ w"e/dz
+
+
+
+ Energy production by
+transport of resolved-scale TKE
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Beyond that, initial profiles (t=0) of some
+variables can additionally be
+output (this output is only done once
+with the first plot output and not repeated with the profile output at
+later
+times). The names of these profiles result from the ones specified
+above leaded by a hash "#". Allowed values are:
+
+
+
+
+
+
+
+
+
+
+
+ #u , #v , #pt ,
+ #km , #kh , #l, #lpt, #q, #qv, #s, #sa, #vpt
+
+
+
+
+
+
+
+
+
+
+
+ Profile names preceded by a hash automatically imply that
+profiles for these variables are also output at later times. It is not
+necessary and not allowed to specify the same profile name with and
+without hash simultaneously(this would lead to an NetCDF error).
+ These initial profiles have been either set by
+the user or
+have been calculated by a 1d-model prerun.
+
+
+The
+user is allowed to extend the above list of quantities by defining his
+own output quantities (see the user-parameter data_output_pr_user ).
+
+
+
+
+
+In case
+of ASCII data output to local file PLOT1D_DATA,
+PALM additionally creates a NAMELIST parameter file (local name PLOT1D_PAR )
+which can be used as parameter input file for the plot software profil .
+Profiles can be directly plotted with profil
+using these two files. The
+plot layout is
+steered via the parameter input file. The values of these profil -parameters
+are determined by
+a set of PALM parameters (profile_columns ,
+ profile_rows ,
+ z_max_do1d ,
+ cross_profiles ,
+etc.) All parameter values can be changed by editing the parameter
+input
+file.
+
+
+
+
+
+Further details about plotting vertical
+profiles with profil can
+be found in chapter
+4.5.2
+
+
+
+
+
+
+
+
+
+
+
+ data_output_2d_on
+
+
+
+ _each_pe
+
+
+
+
+
+ L
+
+
+
+
+
+ .T.
+
+
+
+
+
+
+ Output 2d cross section
+data by one or
+all processors.
+
+
+ In runs with several processors, by
+default, each processor
+outputs cross section data of its subdomain into an individual
+file. After PALM
+has finished, the contents of these files have to be sampled into one
+file using
+the program combine_plot_fields.x .
+
+
+
+
+
+ Alternatively, by assigning data_output_2d_on_each_pe
+= .F.,
+the respective data is gathered on PE0 and output is done directly
+into one file, so combine_plot_fields.x does not
+have to be
+called. However, in case of very large numbers of horizontal
+gridpoints, sufficient
+memory is required on PE0.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ disturbance
+
+
+
+_amplitude
+
+
+
+
+
+ R
+
+
+ 0.25
+
+
+
+
+
+
+ Maximum
+perturbation amplitude of the random perturbations
+imposed to the horizontal velocity field (in m/s).
+
+
+
+
+
+ The parameter create_disturbances
+describes how to impose random perturbations to the horizontal velocity
+field. Since the perturbation procedure includes two filter operations,
+the amplitude assigned by disturbance_amplitude is
+only an
+approximate value of the real magnitude of the perturbation.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ disturbance_energy
+
+
+
+ _limit
+
+
+
+
+
+ R
+
+
+ 0.01
+
+
+
+
+
+
+ Upper
+limit value of the perturbation energy of
+the velocity field used as a criterion for imposing random
+perturbations (in m2 /s2 ).
+
+
+
+
+
+
+ The parameter create_disturbances
+describes how to impose
+random perturbations to the horizontal velocity field. The perturbation
+energy is defined as the volume average (over the total model domain)
+of the squares of the deviations of the velocity components from the
+mean flow (horizontal average). If the perturbation energy exceeds the
+assigned value, random perturbations to the fields of horizontal
+velocities are imposed no more. The value of this parameter usually
+must be determined by trial and error (it depends e.g. on the total
+number of grid points).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ disturbance_level_b
+
+
+
+
+
+
+ R
+
+
+
+ zu(3) or
+
+
+zu(nz*2/3)
+
+
+see right
+
+
+
+
+
+
+ Lower
+limit of the vertical range for which random perturbations are to be
+imposed on the horizontal wind field ( in m).
+
+
+
+
+
+
+ This
+parameter must hold the condition zu(3) <= disturbance_level_b
+<= zu( nz-2 ) . Additionally, disturbance_level_b
+<= disturbance_level_t
+ must
+also hold.
+
+
+
+
+ In case of ocean runs (see ocean ) the default value is disturbance_level_b = zu(nz * 2 / 3) (negative).
+
+
+
+
+
+ The
+parameter create_disturbances
+describes how to impose
+random perturbations to the horizontal velocity field .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ disturbance_level_t
+
+
+
+
+
+
+ R
+
+
+
+ zu(nz/3) or
+
+
+zu(nzt-3)
+
+
+see right
+
+
+
+
+
+
+ Upper
+limit of the vertical range for which random perturbations are to be
+imposed on the horizontal wind field ( in m).
+
+
+
+
+
+
+ This
+parameter must hold the condition disturbance_level_t
+<= zu( nz-2 ) .
+Additionally, disturbance_level_b
+ <=
+ disturbance_level_t
+must also hold.
+
+
+ In case of ocean runs (see ocean ) the default value is disturbance_level_t = zu(nzt - 3 ) (negative).
+
+
+ The
+parameter create_disturbances
+describes how to impose
+random perturbations to the horizontal velocity field .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ do2d_at_begin
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+
+ Output of 2d
+cross section data at the beginning of a run.
+
+
+
+
+
+ The
+temporal intervals of output times of 2d cross section data (see data_output )
+are usually determined with parameters dt_do2d_xy , dt_do2d_xz
+and dt_do2d_yz .
+By assigning do2d_at_begin = .T.
+an additional output
+will be made at the
+beginning of a run (thus at the time t = 0 or at the respective
+starting times of restart runs).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ do3d_at_begin
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+ Output of 3d volume data
+at the beginning
+of a run.
+
+
+
+
+
+The temporal intervals of output times of
+3d volume data (see data_output )
+is usually determined with parameter dt_do3d .
+By assigning do3d_at_begin = .T.
+an additional output
+will be made at the
+beginning of a run (thus at the time t = 0 or at the respective
+starting times of restart runs).
+
+
+
+
+
+
+
+
+
+
+
+ do3d_compress
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+
+ Output of data
+for 3d plots in compressed form.
+
+
+
+
+
+ This
+parameter only applies for data_output_format
+= 'avs' .
+
+
+
+
+ Output
+of 3d volume data may need huge amounts of disc storage
+(up to several Terabytes ore more). Data compression can serve to
+reduce this requirement. PALM is able to output 3d data in compressed
+form using 32-bit integers, if do3d_compress
+= .T. is
+assigned. This
+yields a loss of accuracy, but the file size is clearly reduced. The
+parameter do3d_precision
+can be used to separately define the number of significant digits for
+each quantity.
+
+
+
+
+
+
+
+
+ So far compressed data
+output is only possible for Cray-T3E
+machines. Additional information for
+handling compressed data is given in chapter
+4.5.6 .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ do3d_precision
+
+
+
+
+
+
+ C *
+7
+
+
+
+ (100)
+
+
+ see
+right
+
+
+
+
+
+
+
+
+ Significant digits in case of compressed data
+output.
+
+
+
+
+
+ This parameter only applies for
+ data_output_format
+= 'avs' .
+
+
+
+
+ In
+case that data compression is used for output of 3d data
+(see do3d_compress ),
+this parameter determines the number of significant digits
+which are to be output.
+
+
+
+
+
+
+
+
+ Fewer digits
+clearly reduce the amount
+of data. Assignments have to be given separately for each individual
+quantity via a character string of the form '<quantity
+name><number of
+significant digits>' , e.g. 'pt2' .
+Only those quantities listed in data_output
+are admitted. Up to 9 significant digits are allowed (but large values
+are not very reasonable
+because they do not effect a significant compression).
+
+
+
+
+
+
+
+
+ The default assignment is do3d_precision
+= 'u2' , 'v2' , 'w2' , 'p5' , 'pt2' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt
+
+
+
+
+
+
+ R
+
+
+
+ variable
+
+
+
+
+
+
+ Time
+step to be used by the 3d-model ( in s).
+
+
+
+
+
+
+ This parameter
+ is
+described in
+detail with the initialization parameters (see dt ).
+Additionally, it may be
+used as a run parameter and then applies to all restart runs (until it
+is changed again). A switch from a constant time step to a variable
+time step can be achieved with dt = -1.0 .
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_averaging_input
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+ Temporal interval
+of data which are subject to temporal averaging (in s).
+
+
+
+
+
+By
+default, data from each timestep within the interval defined by averaging_interval
+are used for calculating the temporal average. By choosing dt_averaging_input
+> dt ,
+the number of time levels entering the average can be minimized. This
+reduces the CPU-time of a run but may worsen the quality of the
+average's statistics.
+
+
+
+
+
+ With
+variable time step (see dt ),
+the number of time levels entering the average can vary from one
+averaging interval to the next (for a more detailed explanation see averaging_interval ). It
+is approximately given by the quotient of averaging_interval /
+MAX( dt_averaging_input ,
+ dt ) (which
+gives a more or less exact value if a fixed timestep is used and if
+this is an integral divisor of dt_averaging_input ).
+
+
+
+
+
+
+ Example:
+
+
+With
+an averaging interval of 100.0 s and dt_averaging_input =
+ 10.0 ,
+the time levels entering the average have a (minimum) distance of 10.0
+s (their distance may of course be larger if the current timestep is
+larger than 10.0 s), so the average is calculated from the data of
+(maximum) 10 time levels.
+
+
+
+
+
+ It
+is allowed
+to change dt_averaging_input during a job chain. If
+the last averaging
+interval of the run previous to the change could not be completed (i.e.
+has to be finished in the current run), the individual profiles and/or
+spectra entering the averaging are not uniformly distributed over the
+averaging interval.
+
+
+
+
+
+ Parameter dt_averaging_input_pr can
+be used to define a different temporal interval for
+vertical profile data and spectra.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_averaging_input_pr
+
+
+
+
+
+
+ R
+
+
+
+ value of dt_
+
+
+averaging_
+
+
+input
+
+
+
+
+
+
+ Temporal
+interval of data which are subject to temporal averaging of vertical
+profiles and/or spectra ( in s).
+
+
+
+
+
+
+ By default, data from
+each timestep within the interval defined by averaging_interval_pr , and averaging_interval_sp are
+used for calculating the temporal average. By choosing dt_averaging_input_pr
+> dt ,
+the number of time levels entering the average can be minimized. This
+reduces the CPU-time of a run but may worsen the quality of the
+average's statistics.
+
+
+
+
+
+
+
+ For
+more explanations see parameter dt_averaging_input .
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_coupling
+
+
+ R
+
+
+ 9999999.9
+
+
+ Temporal interval for the data exchange in case of runs with coupled models (e.g. atmosphere - ocean) (in s).
+
+
+
+
+
+This parameter has an effect only in case of a run with coupled models. It is available starting from version 3.3a.
+
+
+
+
+
+This parameter specifies the temporal interval at which data are
+exchanged at the interface between coupled models (currently: interface
+between atmosphere and ocean). If this parameter is not explicitly
+specified in the parameter files for both coupled models, or if there
+is an inconsistency between its values for both coupled models,
+the execution will terminate and an informative error message will
+be given. In order to ensure synchronous coupling throughout the simulation, dt_coupling should be chosen larger than
+ dt_max .
+
+
+
+
+
+
+
+
+ dt_data_output
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ 9999999.9
+
+
+
+
+
+
+
+
+
+ Temporal interval
+at which data (3d volume data (instantaneous or time
+averaged),
+cross sections (instantaneous or time averaged), vertical profiles,
+spectra) shall be output ( in s).
+
+
+
+ If
+data output is switched on (see data_output , data_output_pr , data_output_sp , and section_xy ), this
+parameter can be used to
+assign the temporal interval at which these data shall be
+output. Output can be skipped at the beginning of a
+simulation using parameter skip_time_data_output ,
+which has zero value by default. Reference
+time is the beginning of the simulation, i.e. output
+takes place at times t = skip_time_data_output +
+dt_data_output , skip_time_data_output
++ 2*dt_data_output , skip_time_data_output
++ 3*dt_data_output ,
+etc. Since output is only done at the discrete time levels given by
+the timestep used, the actual output times can slightly
+deviate
+from these theoretical values .
+
+
+
+
+
+Individual temporal
+intervals for the different output quantities can be assigned using
+parameters dt_do3d , dt_do2d_xy , dt_do2d_xz , dt_do2d_yz , dt_dopr , dt_dosp ,
+and dt_data_output_av .
+
+
+
+
+
+
+
+
+
+ dt_data_output_av
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value of
+ dt_data_
+
+
+output
+
+
+
+
+
+
+ Temporal interval
+at which time averaged 3d volume data and/or 2d cross section data
+shall be output ( in s).
+
+
+ If data
+output of time averaged 2d and 3d data is switched on (see data_output and section_xy ), this
+parameter can be used to
+assign the temporal interval at which they shall be
+output. Output can be skipped at the beginning of a
+simulation using parameter skip_time_data_output_av ,
+which has zero value by default. Reference
+time is the beginning of the simulation, i.e. output
+takes place at times t = skip_time_data_output_av +
+dt_data_output_av , skip_time_data_output_av
++ 2*dt_data_output_av , skip_time_data_output_av
++ 3*dt_data_output_av ,
+etc. Since output is only done at the discrete time levels given by
+the timestep used, the actual output times can slightly
+deviate from
+these theoretical values .
+
+
+
+
+
+ The
+length of the averaging interval is controlled via parameter averaging_interval .
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_disturb
+
+
+
+
+
+
+ R
+
+
+
+ 9999999.9
+
+
+
+
+
+
+ Temporal
+interval at which random
+perturbations are to be imposed on the horizontal velocity field
+( in s).
+
+
+
+
+
+
+ The parameter create_disturbances
+describes how to impose
+random perturbations to the horizontal velocity field .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_dopr
+
+
+
+
+
+
+ R
+
+
+
+ value of
+ dt_data_
+
+
+output
+
+
+
+
+
+
+ Temporal
+interval at
+which data of vertical profiles shall be output (to local
+file DATA_1D_PR_NETCDF
+or/and PLOT1D_DATA ) ( in
+ s).
+
+
+
+
+
+
+ If output of
+horizontally averaged vertical profiles is switched on (see data_output_pr ), this
+parameter can be used to
+assign the temporal interval at which profile data shall be output. Output can
+be skipped at the beginning of a simulation using parameter skip_time_dopr , which has
+zero value by default. Reference
+time is the beginning
+of the simulation, thus t = 0, i.e. output
+takes place at times t = skip_time_dopr + dt_dopr , skip_time_dopr + 2*dt_dopr ,
+ skip_time_dopr
++ 3*dt_dopr ,
+etc. Since
+profiles can not be calculated for times lying within a time step
+interval, the output times can deviate from these theoretical values.
+If a time step ranges from t = 1799.8 to t = 1800.2, then in the
+example above the output would take place at t = 1800.2. In general,
+the output always lie between t = 1800.0 and t = 1800.0 + dt . If the
+model uses a variable time step, these
+deviations from the theoretical output times will of course be
+different for each output time.
+
+
+
+
+
+
+
+
+ In
+order to
+guarantee an output of profile data at the end of a simulation (see end_time ) in any way ,
+ end_time
+should be equal or a little bit
+larger than the respective theoretical output time. For example, if dt_dopr
+= 900.0
+ and 3600.0
+seconds are to be simulated, then end_time
+>= 3600.0 should be chosen.
+
+
+
+
+
+
+ A selection of
+profiles to be output can be done via parameter data_output_pr .
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_dopr_listing
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ 9999999.9
+
+
+
+
+
+
+ Temporal
+interval at which data of
+vertical
+profiles shall be output (output for printouts, local file LIST_PROFIL ) ( in
+ s).
+
+
+
+
+
+
+ This
+parameter can be used to
+assign the temporal interval at which profile data shall be output. Reference
+time is the beginning
+of the simulation, thus t = 0. For example if dt_dopr_listing
+= 1800.0,
+then output takes place at t = 1800.0, 3600.0, 5400.0, etc. Since
+profiles can not be calculated for times lying within a time step
+interval, the output times can deviate from these theoretical values.
+If a time step ranges from t = 1799.8 to t = 1800.2, then in the
+example above the output would take place at t = 1800.2. In general,
+the output always lie between t = 1800.0 and t = 1800.0 + dt (numbers
+are related to
+the
+example above). If the model uses a variable time step, these
+deviations from the theoretical output times will of course be
+different for each output time.
+
+
+
+
+
+
+
+
+ In
+order to
+guarantee an output of profile data at the end of a simulation (see end_time ) in any way ,
+ end_time
+should be a little bit
+larger than the respective theoretical output time. For example, if dt_dopr_listing
+= 900.0
+ and 3600.0
+seconds are to be simulated, then it should be at least end_time
+> 3600.0 + dt . If
+variable time steps are used
+(which is the default), dt
+should be properly estimated.
+
+
+
+
+
+ Data
+and output
+format of the file LIST_PROFIL
+ is
+internally fixed. In this file
+the profiles of the most important model variables are arranged in
+adjacent columns.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_dots
+
+
+
+
+
+
+ R
+
+
+
+ see right
+
+
+
+
+
+
+ Temporal
+interval at which time series data shall be
+output ( in s).
+
+
+
+
+
+
+ The default interval for the output of timeseries
+is calculated as shown below (this tries to minimize the number of
+calls of flow_statistics )
+
+
+
+
+
+IF ( averaging_interval_pr
+== 0.0 ) THEN
+
+
+
+ dt_dots =
+MIN( dt_run_control , dt_dopr )
+
+
+
+ELSE
+
+
+
+ dt_dots =
+MIN( dt_run_control, dt_averaging_input_pr
+)
+
+
+
+ENDIF
+
+
+
+
+ This parameter can be used to
+assign the temporal interval at which data points shall be output. Reference
+time is the beginning of
+ the simulation, i.e. output takes place at times t = dt_dots ,
+2*dt_dots , 3*dt_dots , etc. The
+actual output times can
+deviate from these theoretical values (see dt_dopr ).
+Is dt_dots < dt , then data
+of the time series are
+written after each time step (if this is requested it should be dt_dots
+= 0 ).
+
+
+
+
+ The default
+value of dt_dots
+is calculated as follows:
+
+
+
+IF ( averaging_interval_pr
+== 0.0 ) THEN
+
+
+
+ dt_dots =
+MIN( dt_run_control , dt_dopr )
+
+
+
+ELSE
+
+
+
+ dt_dots =
+MIN( dt_run_control ,
+ dt_averaging_input_pr
+)
+
+
+
+ENDIF
+
+
+
+
+
+(which minimizes the number of calls of
+routine flow_statistics).
+
+
+
+
+ By default time series data
+is output to the local file DATA_1D_TS_NETCDF .
+Because of the default settings of dt_dots ,
+it will generally be created for each model run. The file's
+format is NetCDF. Further details about processing NetCDF
+data are given in chapter 4.5.1 .
+
+
+The
+file contains the following timeseries quantities (the first column
+gives the name of the quantities as used in the NetCDF file):
+
+
+
+
+
+
+
+
+
+
+
+
+
+ E
+
+
+
+
+
+
+ Total
+kinetic energy of
+the flow (in m2 /s2 )
+(normalized with respect to the total number of grid points).
+
+
+
+
+
+
+
+
+
+ E*
+
+
+
+
+
+
+ Perturbation
+kinetic
+energy of the flow (in m2 /s2 )
+ (normalized
+with respect to the total number of grid
+points)
+
+
+
+
+
+
+
+
+ dt
+
+
+
+
+
+
+ Time step
+size (in s).
+
+
+
+
+
+
+
+
+ u*
+
+
+
+ Friction velocity (in
+m/s)
+(horizontal average).
+
+
+
+
+
+
+
+
+ w*
+
+
+
+ Vertical velocity scale
+of
+the CBL (in m/s) (horizontal average)
+
+
+
+
+
+
+
+
+
+ th*
+
+
+
+ Temperature
+scale (Prandtl layer), defined as w"pt"0
+/ u*
+(horizontal
+average) (in K).
+
+
+
+
+
+
+
+
+ umax
+
+
+
+
+
+
+ Maximum
+u-component of the
+velocity (in m/s).
+
+
+
+
+
+
+
+
+ vmax
+
+
+
+
+
+
+ Maximum
+v-component of the
+velocity (in m/s).
+
+
+
+
+
+
+
+
+ wmax
+
+
+
+
+
+
+ Maximum
+w-component of the
+velocity (in m/s).
+
+
+
+
+
+
+
+
+ div_old
+
+
+
+
+
+
+ Divergence
+of the velocity
+field before the pressure
+solver has been called (normalized with respect to the total number of
+grid points) (in 1/s).
+
+
+
+
+
+
+
+
+ div_new
+
+
+
+ Divergence of the
+velocity
+field after the pressure
+solver has been called (normalized with respect to the total number of
+grid points) (in 1/s).
+
+
+
+
+
+
+
+
+ z_i_wpt
+
+
+
+ Height of the convective
+boundary layer (horizontal average)
+determined by the height of the minimum sensible heat flux (in m).
+
+
+
+
+
+
+
+
+
+ z_i_pt
+
+
+
+ Height of the convective
+boundary layer (horizontal average)
+determined by the temperature profile (in m).
+
+
+
+
+
+
+
+
+
+ w"pt"0
+
+
+
+ Subgrid-scale sensible
+heat flux near the surface (horizontal
+average)
+between z = 0 and z = zp = zu(1) (there it
+corresponds to
+the total heat flux) (in K m/s).
+
+
+
+
+
+
+
+
+ w"pt"
+
+
+
+ Subgrid-scale heat flux
+(horizontal average) for z = zw(1) (in K
+m/s).
+
+
+
+
+
+
+
+
+ wpt
+
+
+
+ Total heat flux
+(horizontal average) for z = zw(1) (in K m/s).
+
+
+
+
+
+
+
+
+
+ pt(0)
+
+
+
+ Potential temperature at
+the surface (horizontal average) (in K).
+
+
+
+
+
+
+
+
+
+ pt(zp)
+
+
+
+ Potential temperature for
+z = zu(1) (horizontal average) (in K).
+
+
+
+
+
+
+
+
+
+ splptx
+
+
+
+ Percentage of grid points
+using upstream scheme along x with
+upstream-spline advection switched on.
+
+
+
+
+
+
+
+
+
+ splpty
+
+
+
+ Percentage of grid points
+using upstream scheme along y with
+upstream-spline
+advection switched on.
+
+
+
+
+
+
+
+
+ splptz
+
+
+
+ Percentage of grid points
+using upstream scheme along z with
+upstream-spline
+advection switched on.
+
+
+
+
+
+
+
+
+
+
+
+ L
+
+
+
+ Monin-Obukhov length.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Additionally, the
+user can add his own timeseries quantities to the file, by using the
+user-interface subroutines user_init and user_statistics .
+These routines contain (as comment lines) a simple example how to do
+this.
+
+
+
+
+
+Time series data refers to the total
+domain, but time series for subdomains can also be output (see statistic_regions ).
+However, the following time series always present the values of the
+total model domain (even with output for subdomains): umax ,
+ vmax , wmax , div_old ,
+ div_new .
+
+
+
+
+
+
+
+
+
+
+
+ dt_do2d_xy
+
+
+
+
+
+
+ R
+
+
+
+ value of
+ dt_data_
+
+
+output
+
+
+
+
+
+
+ Temporal
+interval at which horizontal cross section data
+shall be output ( in s).
+
+
+
+
+
+
+ If output of
+horizontal cross sections is switched on (see data_output
+ and
+ section_xy ), this
+parameter can be used to
+assign the temporal interval at which cross section data shall be
+output. Output can be skipped at the beginning of a
+simulation using parameter skip_time_do2d_xy ,
+which has zero value by default. Reference
+time is the beginning of the simulation, i.e. output
+takes place at times t = skip_time_do2d_xy + dt_do2d_xy ,
+ skip_time_do2d_xy
++ 2*dt_do2d_xy , skip_time_do2d_xy
++ 3*dt_do2d_xy ,
+etc. The actual output times can deviate from these theoretical values
+(see dt_dopr ).
+
+
+
+
+
+
+
+
+
+ Parameter do2d_at_begin
+has to be used if an additional output is wanted at the start of a run (thus at
+the time t = 0 or at the
+respective starting times of restart runs).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_do2d_xz
+
+
+
+
+
+
+ R
+
+
+
+ value of
+ dt_data_
+
+
+output
+
+
+
+
+
+
+ Temporal
+interval at which vertical cross sections data
+(xz) shall be output ( in s).
+
+
+
+
+
+
+ If output of
+horizontal cross sections is switched on (see data_output
+ and
+ section_xz ),
+this parameter can be used to assign the temporal interval at which
+cross section data shall be output. Output can
+be skipped at the beginning of a simulation using parameter skip_time_do2d_xz , which
+has zero value by default. Reference time is the beginning of
+the simulation, i.e. output takes place at times t = skip_time_do2d_xz
++ dt_do2d_xz ,
+ skip_time_do2d_xz
++ 2*dt_do2d_xz , skip_time_do2d_xz
++ 3*dt_do2d_xz , etc. The actual output times
+can deviate from these theoretical values (see dt_dopr ).
+
+
+
+
+
+
+
+
+
+ Parameter do2d_at_begin
+has to be used if an additional output is wanted at the start of a run (thus at
+the time t = 0 or at the
+respective starting times of restart runs).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_do2d_yz
+
+
+
+
+
+
+ R
+
+
+
+ value of
+ dt_data_
+
+
+output
+
+
+
+
+
+
+ Temporal
+interval at which vertical cross section data
+(yz) shall be output ( in s).
+
+
+
+
+
+
+ If output of
+horizontal cross sections is switched on (see data_output
+ and
+ section_yz ),
+this parameter can be used to assign the temporal interval at which
+cross section data shall be output. Output can
+be skipped at the beginning of a simulation using parameter skip_time_do2d_yz , which
+has zero value by default. Reference
+time is the beginning of
+the simulation, i.e. output takes place at times t = skip_time_do2d_yz
++ dt_do2d_yz ,
+ skip_time_do2d_yz
++ 2*dt_do2d_yz , skip_time_do2d_yz
+ + 3*dt_do2d_yz , etc. The actual output
+times
+can deviate from these theoretical values (see dt_dopr ).
+
+
+
+
+
+
+
+
+
+ Parameter do2d_at_begin
+has to be used if an additional output is wanted at the start of a run (thus at
+the time t = 0 or at the
+respective starting times of restart runs).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_do3d
+
+
+
+
+
+
+ R
+
+
+
+ value of
+ dt_data_
+
+
+output
+
+
+
+
+
+
+ Temporal
+interval at which 3d volume data shall be output ( in
+ s).
+
+
+
+
+
+ If
+output of
+3d-volume data is switched on (see data_output ), this parameter can be used
+to assign
+th e temporal
+interval at which 3d-data shall be output. Output can
+be skipped at the beginning of a simulation using parameter skip_time_do3d , which has
+zero value by default. Reference
+time is the
+beginning of the simulation, i.e. output takes place at times t = skip_time_do3d
++ dt_do3d ,
+ skip_time_do3d
++ 2*dt_do3d , skip_time_do3d
++ 3*dt_do3d , etc. The actual output times can
+deviate from these theoretical values (see dt_dopr ).
+
+
+
+
+
+
+
+
+
+ Parameter do3d_at_begin
+has to be used if an additional output is wanted at the start of a run (thus at
+the time t = 0 or at the
+respective starting times of restart runs).
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_max
+
+
+ R
+
+
+ 20.0
+
+
+ Maximum
+allowed value of the timestep (in s).
+
+
+
+
+
+By default,
+the maximum timestep is restricted to be 20 s. This might be o.k. for
+simulations of any kind of atmospheric turbulence but may have to be
+changed for other situations.
+
+
+
+
+
+
+
+
+
+
+
+ dt_restart
+
+
+
+
+
+
+ R
+
+
+
+ 9999999.9
+
+
+
+
+
+
+ Temporal
+interval at which a new
+restart run is to be carried out ( in s).
+
+
+
+
+
+ For a
+description
+how to assign restart times manually see run time parameter restart_time . dt_restart
+does not show any effect, if restart_time
+has not been set.
+
+
+ For coupled runs this parameter must be equal in both parameter files PARIN
+and PARIN_O .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_run_control
+
+
+
+
+
+
+ R
+
+
+
+ 60.0
+
+
+
+
+
+
+ Temporal
+interval at which run control
+output is to be made ( in s).
+
+
+
+
+
+
+ Run control
+information is output to the local ASCII-file RUN_CONTROL . At each
+output time, one line
+with information about the size of the time step, maximum speeds, total
+kinetic energy etc. is written to this file. Reference time is the
+beginning of the simulation, i.e. output takes place at times t = dt_run_control ,
+2*dt_run_control , 3*dt_run_control ,
+etc., and always at
+the beginning of a model run (thus at the time t = 0 or at the
+respective starting times of restart runs). The actual output times can
+deviate from these theoretical values (see dt_dopr ).
+
+
+
+
+
+
+
+
+
+ Run control
+information is output after each time step can be achieved via dt_run_control
+= 0.0 .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ end_time
+
+
+
+
+
+
+ R
+
+
+
+ 0.0
+
+
+
+
+
+
+ Simulation time of the 3D
+model ( in s).
+
+
+
+
+
+
+ The simulation time
+is starting from the beginning of the initialization run (t = 0), not
+starting from the beginning of the respective restart run.
+
+
+ For coupled runs this parameter must be equal in both parameter files PARIN
+and PARIN_O .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ force_print_header
+
+
+
+
+
+
+ L
+
+
+
+ .F.
+
+
+
+
+
+
+ Steering of
+header output to the local file RUN_CONTROL .
+
+
+
+
+
+
+ By default, informations about the model
+parameters in use are
+output to the beginning of file RUN_CONTROL for initial runs only
+(these informations are identical to that which are output to the local
+file HEADER ).
+With force_print_header = .T. ,
+these informations are
+also output to RUN_CONTROL
+at restart runs.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mg_cycles
+
+
+
+
+
+
+ I
+
+
+
+ -1
+
+
+
+
+
+
+ Number of
+cycles to be used with the multi-grid scheme.
+
+
+
+
+
+
+This parameter determines the number of cycles to be carried out in the
+multi-grid method used for solving the Poisson equation for
+perturbation pressure (see psolver ).
+The type of the cycles can be set with cycle_mg .
+
+
+
+
+
+
+
+
+
+By default (mg_cyles = -
+1 ), the
+number of cycles
+depends on the requested accuracy of the scheme (see residual_limit )
+and may vary from time step to time step. In this case, the CPU time
+for a run will be difficult to estimate, since it heavily depends on
+the total number of the cycles to be carried out.
+
+
+
+
+
+
+By assigning mg_cycles a value (>=1 ), the number of
+cycles can be
+fixed so that the CPU time can be clearly estimated.
+
+
+
+
+
+
+ Note: When using a fixed number of cycles, the user
+must
+examine the local file RUN_CONTROL
+regularly to check whether the divergence of the velocity field is
+sufficiently reduced by the pressure solver. It should be reduced at
+least by two orders of magnitude. For cyclic boundary conditions along
+both horizontal directions (see bc_lr
+and bc_ns ) mg_cycles = 2 is typically a
+good choice, for
+non-cyclic lateral boundary conditions mg_cycles
+= 4 may be
+sufficient.
+
+
+
+
+
+
+
+
+ mg_switch_to_pe0_
+
+
+
+level
+
+
+ I
+
+
+
+
+
+
+
+
+
+ Grid
+level at which data shall be gathered on PE0.
+
+
+
+
+
+
+In case of a run using several PEs and the multigrid method for solving
+the Poisson equation for perturbation pressure (see psolver ),
+the value of this parameter defines on which grid level the data are
+gathered on PE0 in order to allow for a further coarsening of the grid.
+The finest grid defines the largest grid level. By default, the
+gathering level is determined automatically and displayed in file RUN_CONTROL .
+It is only possible to gather data from a level larger than the one
+determined automatically. A test run may be neccessary to determine
+this level.
+
+
+
+
+
+
+
+
+ netcdf_64bit
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+ All NetCDF files - except those containing 3d
+volume data - will have 64
+bit offset format if netcdf_64bit
+= .TRUE..
+
+
+
+
+
+By
+default, the maximum file size of the NetCDF files opened by PALM is 2
+GByte. Using netcdf_64bit = .TRUE. allows file sizes larger than 2
+GByte.
+
+
+
+
+
+The 64 bit offset format for those NetCDF files containing 3d volume data (DATA_3D_NETCDF ,
+ DATA_3D_AV_NETCDF )
+is controlled independently by the switch netcdf_64bit_3d .
+
+
+
+
+
+ Warning:
+
+
+Some
+(PD or commercial) software may not support the 64 bit offset format.
+
+
+
+
+
+
+
+
+
+
+
+
+ netcdf_64bit_3d
+
+
+ L
+
+
+ .T.
+
+
+ NetCDF files containing 3d
+volume data will have 64 bit offset format if netcdf_64bit_3d
+= .TRUE..
+
+
+By
+default, the maximum file size of the NetCDF files opened by PALM is 2
+GByte. Using netcdf_64bit_3d = .TRUE. allows file sizes larger than 2
+GByte.
+
+
+The 64 bit offset format for all other NetCDF files (not containing 3d volume data) is controlled independently by the switch netcdf_64bit .
+
+
+ Warning:
+
+
+Some
+(PD or commercial) software may not support the 64 bit offset format.
+
+
+
+
+
+
+
+
+
+
+
+
+ ngsrb
+
+
+
+
+
+
+ I
+
+
+ 2
+
+
+
+ Grid
+level at which data shall be gathered on PE0.
+
+
+
+
+
+
+In case of a run using several PEs and the multigrid method for solving
+the Poisson equation for perturbation pressure (see psolver ),
+the value of this parameter defines on which grid level the data are
+gathered on PE0 in order to allow for a further coarsening of the grid.
+The finest grid defines the largest grid level. By default, the
+gathering level is determined automatically and displayed in file RUN_CONTROL .
+It is only possible to gather data from a level larger than the one
+determined automatically. A test run may be neccessary to determine
+this level.
+
+
+
+
+
+
+
+
+
+
+
+ normalizing_region
+
+
+
+
+
+
+ I
+
+
+
+ 0
+
+
+
+
+
+
+
+
+
+ Determines the
+subdomain from which the normalization
+quantities are calculated.
+
+
+
+
+
+ If output
+data of the horizontally averaged vertical profiles
+(see data_output_pr )
+is to be normalized (see cross_normalized_x ,
+ cross_normalized_y ),
+the respective normalization quantities are by default calculated from
+the averaged data of the total model domain (normalizing_region
+= 0 ) and are thus representative for the total
+domain. Instead
+of that, normalization quantities can also be calculated for a
+subdomain. The wanted subdomain can be given with the parameter normalizing_region ,
+where 1
+<= normalizing_region <= 9 must
+hold. These
+quantities are then used for normalizing of all profiles (even for that
+of the total domain).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ nsor
+
+
+
+
+
+
+ I
+
+
+
+ 20
+
+
+
+
+
+
+ Number of
+iterations to be used with the SOR-scheme.
+
+
+
+
+
+ This
+parameter is only effective if the SOR-scheme is selected
+as pressure solver (psolver
+= 'sor' ).
+The number of
+iterations necessary for a sufficient convergence of the scheme depends
+on the grid point numbers and is to be determined by appropriate test
+runs (the default value will not at all be sufficient for larger grid
+point numbers). The number of iterations used for the first call of the
+SOR-scheme (t = 0) is determined via the parameter nsor_ini .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ nz_do3d
+
+
+
+
+
+
+ I
+
+
+
+ nz+1
+
+
+
+ Limits the output of 3d
+volume data along the vertical direction (grid point index k).
+
+
+
+
+
+By
+default, data for all grid points along z are output. The parameter nz_do3d
+can be used to limit the output up to a certain vertical grid point
+(e.g. in order to reduce the amount of output data). It affects all
+output of volume data ("normal" output to file, see data_output , as well as output
+for dvrp -software,
+see mode_dvrp ).
+
+
+
+
+
+
+
+
+
+
+
+
+ omega_sor
+
+
+
+
+
+
+ R
+
+
+
+ 1.8
+
+
+
+
+
+
+ Convergence
+factor to be used with the the SOR-scheme.
+
+
+
+
+
+ If
+the SOR-scheme is selected (psolver
+= 'sor' ),
+this parameter
+determines the value of the convergence factor, where 1.0
+<= omega_sor < 2.0 .
+The optimum value of omega_sor
+depends on the number of grid points along the different directions in
+space. For non-equidistant grids it can only be determined by
+appropriate test runs.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ prandtl_number
+
+
+
+
+
+
+ R
+
+
+
+ 1.0
+
+
+
+
+
+
+ Ratio of the
+eddy diffusivities for momentum and heat (Km /Kh ).
+
+
+
+
+
+
+ For runs with constant eddy diffusivity (see km_constant ),
+this parameter can be used to assign the Prandtl number (ratio Km
+/ Kh ).
+
+
+
+
+
+
+
+
+
+
+
+ precipitation_amount_
+
+
+ interval
+
+
+ R
+
+
+ value of
+ dt_do2d_
+
+
+xy
+
+
+
+
+
+ Temporal
+interval for which the precipitation amount (in mm) shall be calculated and output ( in s).
+
+
+
+
+
+
+ This
+parameter requires precipitation = .TRUE. . The interval must be smaller or equal than the output interval for 2d horizontal cross sections given by dt_do2d_xy ). The output of the precipitation amount also requires setting of data_output = 'pra*' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ profile_columns
+
+
+
+
+
+
+ I
+
+
+
+ 3
+
+
+
+
+
+
+ Number of
+coordinate systems to be plotted
+in one row by profil .
+
+
+
+
+
+
+ This parameter only applies for data_output_format
+= 'profil' .
+
+
+
+
+ It
+determines the layout of plots of
+horizontally averaged profiles (data_output_pr )
+when plotted with the plot software profil .
+Generally, the number and sequence of coordinate systems (panels) to be
+plotted on one page are
+determined by cross_profiles .
+ profile_columns
+determines how many panels are to be
+arranged next to each other in one row (number of columns). The
+respective number of rows on a page is assigned by profile_rows .
+According to their order given by data_output_pr ,
+the panels are arranged beginning in the top row from left to right and
+then continued in the following row. If the number of panels cranz
+> profile_columns * profile_rows ,
+the remaining
+panels are drawn on an additional page. If cranz < profile_columns ,
+then profile_columns = cranz is automatically set.
+If
+row contains any panel, then the value of profile_rows
+is reduced automatically.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ profile_rows
+
+
+
+
+
+
+ I
+
+
+
+ 2
+
+
+
+
+
+
+ Number of rows
+of coordinate systems to be plotted on one page
+by profil .
+
+
+
+
+
+
+ This parameter only applies for data_output_format
+= 'profil' .
+
+
+
+
+ It
+determines the layout of plots of horizontally averaged
+profiles. See profile_columns .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ psolver
+
+
+
+
+
+
+ C * 10
+
+
+
+ 'poisfft'
+
+
+
+
+
+
+ Scheme to be
+used to solve the Poisson equation for the
+perturbation pressure.
+
+
+
+
+
+
+The user can choose between the following schemes:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ poisfft
+
+
+
+ Direct method using FFT
+along x and y, solution of a
+tridiagonal matrix along z, and backward
+FFT (see Siano, institute reports, volume 54). The FFT routines to be
+used can be determined via the initialization parameter fft_method .
+
+
+
+This solver is specially optimized for 1d domain decompositions.
+Vectorization is optimized for domain decompositions along x only.
+
+
+
+
+
+
+
+
+
+
+
+
+ poisfft_
+
+
+
+ hybrid
+
+
+
+
+
+
+ Direct
+method using FFT
+along x and y, solution of a
+tridiagonal matrix along z, and backward
+FFT (see Siano, institute reports, volume 54). The FFT routines to be
+used can be determined via the initialization parameter fft_method .
+
+
+
+This solver is specially optimized for 1d domain decompositions.
+Vectorization is optimized for domain decompositions along x only.
+
+
+
+
+
+
+
+
+
+ multigrid
+
+
+
+
+
+
+ Multi-grid
+scheme (see Uhlenbrock, diploma thesis). v-
+and
+w-cycles (see cycle_mg )
+are implemented. The convergence of the iterative scheme can be
+steered by the number of v-/w-cycles to be carried out for each call of
+the scheme (mg_cycles )
+and by the number of Gauss-Seidel iterations (see ngsrb )
+to be carried out on each grid level. Instead the requested accuracy
+can be given via residual_limit .
+ This is the default!
+The
+smaller this limit is, the more cycles have to be carried out in this
+case and the number of cycles may vary from timestep to timestep.
+
+
+
+
+
+
+If mg_cycles
+is set to its optimal value, the computing time of the
+multi-grid scheme amounts approximately to that of the direct solver poisfft , as long as
+the number of
+grid points in the three directions
+of space corresponds to a power-of-two (2n )
+where n >= 5 must hold. With large n,
+ the
+multi-grid scheme can even be faster than the direct solver (although
+its accuracy is several orders of magnitude worse, but this does not
+affect the accuracy of the simulation). Nevertheless, the user should
+always carry out some test runs in order to find out the optimum value
+for mg_cycles ,
+because the CPU time of a run very critically depends on this
+parameter.
+
+
+ This scheme requires that the number of grid
+points of
+the
+subdomains (or of the total domain, if only one PE is uesd) along each
+of the directions can at least be devided once by 2 without rest.
+
+
+
+With parallel runs, starting from a certain grid level the
+data of the subdomains are possibly gathered on PE0 in order to allow
+for a further coarsening of the grid. The grid level for gathering can
+be manually set by mg_switch_to_pe0_level .
+
+
+
+
+
+ Using this procedure requires the subdomains to be of
+identical size (see grid_matching ).
+
+
+
+
+
+
+
+
+
+
+
+
+ sor
+
+
+
+ Successive over
+relaxation
+method (SOR). The convergence of
+this
+iterative scheme is steered with the parameters omega_sor ,
+ nsor_ini
+and nsor .
+
+
+
+Compared to the direct method and the multi-grid method, this
+scheme
+needs substantially
+more computing time. It should only be used for test runs, e.g. if
+errors in the other pressure solver methods are assumed.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+In order to speed-up
+performance, the Poisson equation is by default
+only solved at the last substep of a multistep Runge-Kutta scheme (see call_psolver
+at_all_substeps and timestep_scheme ).
+
+
+
+
+
+
+
+
+
+
+
+
+ rayleigh_damping
+
+
+
+ _factor
+
+
+
+
+
+ R
+
+
+ 0.0 or
+
+
+
+ 0.01
+
+
+
+
+
+ Factor for Rayleigh damping.
+
+
+
+
+
+ A
+so-called Rayleigh damping is applied to all prognostic
+variables if a non-zero value is assigned to rayleigh_damping_factor .
+If switched on, variables are forced towards the value of their
+respective basic states (e.g. the geostrophic wind). The intensity of
+damping is controlled by the value the rayleigh_damping_factor
+is assigned to.
+The damping starts weakly at a height defined by rayleigh_damping_height
+and rises according to a sin2 -function to its
+maximum value
+at
+the top (ocean: bottom) boundary.
+
+
+
+
+
+ This method
+effectively damps gravity waves, caused by boundary layer convection,
+which may spread out vertically in the inversion layer and which are
+reflected at the top (ocean: bottom)
+boundary. This particularly happens with the upstream-spline scheme
+switched on (see momentum_advec
+or scalar_advec ).
+Therefore, with this scheme the Rayleigh damping is switched on (rayleigh_damping_factor
+= 0.01 ) by default. Otherwise it remains switched
+off.
+
+
+
+
+
+ The Rayleigh damping factor must
+hold the condition 0.0
+<= rayleigh_damping_factor
+<= 1.0 . Large values (close to 1.0 ) can cause
+numerical instabilities.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ rayleigh_damping
+
+
+
+ _height
+
+
+
+
+
+ R
+
+
+
+
+
+ 2/3 *
+
+
+
+ zu (nz)
+ (ocean: 2/3 *
+ zu(0) )
+
+
+
+
+
+
+
+
+
+ Height above (ocean: below) which the Rayleigh damping starts (in m).
+
+
+
+
+
+ With
+Rayleigh damping switched on (see rayleigh_damping_factor ),
+this parameter determines the range where damping is applied. By
+default, Rayleigh damping will be applied in the upper (ocean: lower) third of the
+model
+domain.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ residual_limit
+
+
+
+
+
+
+ R
+
+
+
+ 1.0E-6
+
+
+
+
+
+
+ Largest
+residual permitted for the multi-grid scheme (in s-2 m-3 ).
+
+
+
+
+
+
+ This is a parameter to steer the accuracy of the
+multi-grid
+scheme (see psolver ).
+The assigned cycle (v- or w-cycle, see mg_cycles )
+is passed through until the residual falls below the limit given by residual_limit . If
+this
+is not the case after 1000 cycles, the PALM aborts with a corresponding
+error message.
+
+
+
+
+
+ The reciprocal value of this
+parameter can be interpreted as
+a factor by the divergence of the provisional
+velocity field is approximately reduced after the multi-grid scheme has
+been applied (thus the default value causes a reduction of the
+divergence by approx. 6 orders of magnitude).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ restart_time
+
+
+
+
+
+
+ R
+
+
+
+ 9999999.9
+
+
+
+
+
+
+ Simulated time
+after which a restart run is to be carried out
+(in s).
+
+
+
+
+
+ The simulated time refers to the
+beginning of the
+initial run (t = 0), not to the beginning of the respective
+restart run. Restart runs can additionally be forced to be carried out
+in regular intervals using the run time parameter dt_restart .
+
+
+
+
+
+ Note:
+
+
+
+A successful operation of this parameter requires additional
+modifications in the mrun -call
+for the respective run (see chapter
+3.3 ).
+
+
+
+
+
+
+
+
+ The choice of restart_time
+or dt_restart does
+not override the automatic start of restart runs in case that the job
+runs out of CPU time.
+
+
+
+
+ For coupled runs this parameter must be equal in both parameter files PARIN
+and PARIN_O .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ section_xy
+
+
+
+
+
+
+ I(100)
+
+
+
+
+
+
+ no section
+
+
+
+
+
+
+
+
+
+ Position
+of cross section(s) for output of 2d horizontal cross
+sections (grid point index k).
+
+
+
+
+
+ If output
+of
+horizontal cross sections is selected (see data_output ), this
+parameter can be used to
+define the position(s) of the cross section(s). Up to 100 positions of
+cross sections can be selected by assigning section_xy
+the
+corresponding vertical grid point index/indices k of the requested
+cross section(s). The exact location (height level) of the cross
+section depends on the variable for which the output is made: zu(k) for
+scalars and horizontal velocities, zw(k) for the vertical velocity.
+Information about the exact location of the cross section is contained
+in the NetCDF output file (if the default NetCDF output is switched on;
+see data_output_format ).
+
+
+
+
+ Assigning section_xy = -1
+creates the output of horizontal cross sections averaged along z. In
+the
+NetCDF output file these (averaged) cross sections are given the
+z-coordinate -1.0 .
+
+
+
+
+ Assignments to section_xy
+does not effect the output of horizontal cross sections of variable u*
+and theta* and the liquid water path lwp*. For
+these quantities always only one cross
+section (for z=zu(1)) is output.
+
+
+ In case of data_output_format =
+ 'iso2d' and
+if several cross sections are selected (e.g. section_xy
+= 1 , 10 , 15 ),
+then the respective data are
+successively written to file. The output order follows the order given
+by section_xy .
+
+
+
+
+
+
+
+
+
+
+
+
+ section_xz
+
+
+
+
+
+
+ I(100)
+
+
+
+
+
+
+ no section
+
+
+
+
+
+
+ Position of cross section(s)
+for output of 2d (xz) vertical cross sections (grid point
+index j).
+
+
+ If output of
+vertical xz cross sections is selected (see data_output ), this
+parameter can be used to
+define the position(s) of the cross section(s). Up to 100 positions of
+cross sections can be selected by assigning section_xz
+the
+corresponding horizontal grid point index/indices j of the requested
+cross section(s). The exact position (in y-direction) of the cross
+section is given by j* dy or (j-0.5)* dy , depending
+on which grid the output quantity is defined. However, in
+the NetCDF output file (if the
+default NetCDF output is switched on; see data_output_format )
+no distinction is made between the quantities and j*dy is used for all
+positions.
+
+
+
+
+
+Assigning section_xz = -1
+creates the output of vertical cross sections averaged along y. In the
+NetCDF output file these (averaged) cross sections are given the
+y-coordinate -1.0 .
+
+
+
+
+
+ In case of data_output_format =
+ 'iso2d' and
+ if several cross sections are
+selected (e.g. section_xz = 0 , 12 ,
+ 27 ),
+then the respective data are successively written to file. The output
+order follows the order given by section_xz .
+
+
+
+
+
+
+
+
+
+
+
+
+ section_yz
+
+
+
+
+
+
+ I(100)
+
+
+
+
+
+
+ no section
+
+
+
+
+
+
+ Position of cross section(s)
+for output of 2d (yz) vertical cross sections (grid point
+index i).
+
+
+ If output of
+vertical yz cross sections is selected (see data_output ),
+this parameter can be used to define the position(s) of the cross
+section(s). Up to 100 positions of cross sections can be selected by
+assigning section_yz the corresponding horizontal
+grid point
+index/indices i of the requested cross section(s). The exact position
+(in x-direction) of the cross section is given by i* dx or (i-0.5)* dx , depending
+on which grid the output quantity is defined. However, in
+the NetCDF output file (if the
+default NetCDF output is switched on; see data_output_format )
+no distinction is made between the quantities and i*dx is used for all
+positions.
+
+
+
+
+
+ Assigning section_yz = -1
+creates the output of vertical cross sections averaged along x. In the
+NetCDF output file these (averaged) cross sections are given the
+x-coordinate -1.0 .
+
+
+
+
+
+ In case of data_output_format =
+ 'iso2d' and
+ if several cross sections are
+selected (e.g. section_yz = 3 , 27 , 19), then the
+respective data are successively written to file. The output order
+follows the order given by section_yz .
+
+
+
+
+
+
+
+
+
+ skip_time_data_output
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+ No data output before
+this interval has passed (in s).
+
+
+
+
+
+This
+parameter causes that data output activities are starting not before
+this interval
+(counting from the beginning of the simulation, t=0) has passed. By
+default, this
+applies for output of instantaneous 3d volume data, cross section data,
+spectra and vertical profile data as well as for temporally averaged 2d
+and 3d data. Individual intervals can be assigned using parameters skip_time_do3d , skip_time_do2d_xy , skip_time_do2d_xz , skip_time_do2d_yz , skip_time_dosp , skip_time_dopr , and skip_time_data_output_av .
+
+
+
+
+
+ Example:
+
+
+If
+the user has set dt_data_output
+= 3600.0
+and skip_time_data_output
+= 1800.0 ,
+then the first output will be done at t = 5400 s.
+
+
+
+
+
+
+
+
+
+
+
+
+ skip_time_data_output_av
+
+
+ R
+
+
+ value of skip_time_
+
+
+data_output
+
+
+ No output of temporally
+averaged 2d/3d data before this interval has passed (in s).
+
+
+
+
+
+This
+parameter causes that data output activities are starting not before
+this interval
+(counting from the beginning of the simulation, t=0) has passed.
+
+
+
+
+
+ Example:
+
+
+If
+the user has set dt_data_output_av
+= 3600.0
+and skip_time_data_output_av
+= 1800.0 ,
+then the first output will be done at t = 5400 s.
+
+
+
+
+
+
+
+
+
+ skip_time_dopr
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value of skip_time_
+
+
+data_output
+
+
+
+ No output of
+vertical profile data before this interval has passed (in s).
+
+
+
+
+
+This
+parameter causes that data output activities are starting not before
+this interval
+(counting from the beginning of the simulation, t=0) has passed.
+
+
+
+
+
+ Example:
+
+
+If
+the user has set dt_dopr = 3600.0 and skip_time_dopr = 1800.0 , then the
+first output will be done at t = 5400 s.
+
+
+
+
+
+
+
+
+
+ skip_time_do2d_xy
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value of skip_time_
+
+
+data_output
+
+
+
+ No output of
+instantaneous horizontal cross section data before this interval has
+passed (in s).
+
+
+
+
+
+This
+parameter causes that data output activities are starting not before
+this interval
+(counting from the beginning of the simulation, t=0) has passed.
+
+
+
+
+
+ Example:
+
+
+If
+the user has set dt_do2d_xy
+= 3600.0
+and skip_time_do2d_xy
+= 1800.0 ,
+then the first output will be done at t = 5400 s.
+
+
+
+
+
+
+
+
+
+ skip_time_do2d_xz
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value of skip_time_
+
+
+data_output
+
+
+
+ No output of
+instantaneous vertical (xz) cross section data before this interval has
+passed (in s).
+
+
+
+
+
+This
+parameter causes that data output activities are starting not before
+this interval
+(counting from the beginning of the simulation, t=0) has passed.
+
+
+
+
+
+ Example:
+
+
+If
+the user has set dt_do2d_xz
+= 3600.0
+and skip_time_do2d_xz
+= 1800.0 ,
+then the first output will be done at t = 5400 s.
+
+
+
+
+
+
+
+
+
+ skip_time_do2d_yz
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value of skip_time_
+
+
+data_output
+
+
+
+ No output of
+instantaneous vertical (yz) cross section data before this interval has
+passed (in s).
+
+
+
+
+
+This
+parameter causes that data output activities are starting not before
+this interval
+(counting from the beginning of the simulation, t=0) has passed.
+
+
+
+
+
+ Example:
+
+
+If
+the user has set dt_do2d_yz
+= 3600.0
+and skip_time_do2d_yz
+= 1800.0 ,
+then the first output will be done at t = 5400 s.
+
+
+
+
+
+
+
+
+
+ skip_time_do3d
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value of skip_time_
+
+
+data_output
+
+
+
+ No output of
+instantaneous 3d volume data before this interval has passed (in s).
+
+
+
+
+
+This
+parameter causes that data output activities are starting not before
+this interval
+(counting from the beginning of the simulation, t=0) has passed.
+
+
+
+
+
+ Example:
+
+
+If
+the user has set dt_do3d = 3600.0 and skip_time_do3d = 1800.0 , then the
+first output will be done at t = 5400 s.
+
+
+
+
+
+
+
+
+
+
+
+
+ termination_time
+
+
+
+ _needed
+
+
+
+
+
+ R
+
+
+
+
+
+ 35.0
+
+
+
+
+
+
+
+
+
+ CPU time
+needed for terminal actions at the end of a run in
+batch mode (in s).
+
+
+
+
+
+
+
+
+ If the environment
+variable write_binary is
+set true (see chapter
+3.3 ), PALM checks the remaining CPU time of the job after
+each
+timestep. Time integration must not consume the CPU time completely,
+since several actions still have to be carried out after time
+integration has finished (e.g. writing of binary data for the restart
+run, carrying out output commands, copying of local files to their
+permanent destinations, etc.) which also takes some time. The maximum
+possible time needed for these activities plus a reserve is to be given
+with the parameter termination_time_needed . Among
+other things,
+it depends on
+the number of grid points used. If its value is selected too small,
+then the
+respective job will be prematurely aborted by the queuing system, which
+may result in a data loss and will possibly interrupt the job chain.
+
+
+
+
+
+
+
+
+
+ An abort happens in any way, if the environment
+variable write_binary
+is not set to true
+and if moreover the job has
+been assigned an insufficient CPU time by mrun
+option -t .
+
+
+
+
+
+
+
+
+
+ Note:
+
+
+
+On the IBM computers of the HLRN the time used by the job before the start of
+PALM
+have also to be accounted for (e.g. for
+compilation and copying of input files).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ use_prior_plot1d
+
+
+
+ _parameters
+
+
+
+
+
+ L
+
+
+ .F.
+
+
+
+
+
+
+ Additional
+plot of vertical profile data with profil
+from preceding runs of the
+job chain.
+
+
+
+
+
+ This parameter only applies
+for data_output_format
+= 'profil' .
+
+
+
+
+ By
+default, plots of horizontally averaged vertical profiles
+(see data_output_pr )
+only contain profiles of data produced by the model
+run. If profiles of prior times (i.e. data of preceding jobs of a
+job chain) shall be plotted additionally (e.g. for comparison
+purposes), use_prior_plot1d_parameters = .T .
+must be
+set.
+
+
+
+
+
+
+
+
+ For further explanation see chapter
+4.5.2 .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ z_max_do1d
+
+
+
+
+
+
+ R
+
+
+
+ zu(nzt+1) (model
+top)
+
+
+
+
+
+ Height level up to which horizontally averaged profiles are to
+be
+plotted with profil
+(in
+m).
+
+
+
+
+
+ This parameter only applies for
+ data_output_format
+= 'profil' .
+
+
+
+
+ It
+affects plots of horizontally averaged profiles
+(data_output_pr )
+when plotted with the plot software profil .
+By default, profiles are plotted up to the top boundary. The height
+level up to which profiles are plotted can be decreased by assigning z_max_do1d a smaller
+value.
+Nevertheless, all
+vertical
+grid points (0 <= k <= nz+1) are still output to file PLOT1D_DATA .
+
+
+
+
+
+ If a normalization for the vertical axis was selected (see cross_normalized_y ), z_max_do1d
+has no effect. Instead, z_max_do1d_normalized
+must be used.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ z_max_do1d
+
+
+
+ _normalized
+
+
+
+
+
+ R
+
+
+ determined by plot
+
+
+
+ data
+
+
+
+
+
+
+
+
+ Normalized height
+level up to which horizontally averaged
+profiles are to be plotted with profil .
+
+
+
+
+
+
+ This parameter only applies for data_output_format
+= 'profil' .
+
+
+
+
+ It
+affects plots of horizontally averaged profiles
+(data_output_pr )
+when plotted with the plot software profil ,
+if a normalization for the vertical axis is selected
+(see cross_normalized_y ).
+If e.g. the boundary layer height is used for normalization, then z_max_do1d_normalized
+= 1.5 means that all profiles up to the height
+level of z =
+1.5* zi are plotted.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ z_max_do2d
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ zu(nz)
+
+
+
+
+
+
+
+
+
+ Height level
+up to which 2d cross sections are to be plotted
+with iso2d
+(in m).
+
+
+
+
+
+ This parameter only applies for
+ data_output_format
+= 'iso2d' .
+
+
+
+
+ It
+affects plots of 2d vertical cross
+sections (data_output )
+when plotted with iso2d .
+By
+default, vertical sections are plotted up to the top boundary. In contrast, with z_max_do2d
+ the
+visualization within
+the plot can be limited to a certain height level (0 <= z
+<= z_max_do2d ).
+Nevertheless, all
+grid points
+of the complete cross section are still output to the local files PLOT2D_XZ
+or PLOT2D_YZ .
+The level up to which the section is visualized can later be changed by
+manually editing the
+file PLOT2D_XZ_GLOBAL
+or PLOT2D_YZ_GLOBAL
+(the respective iso2d -parameter
+is yright ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Particle
+parameters:
+
+
+
+ NAMELIST group name: particles_par
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Parameter
+name
+
+
+
+ Type
+
+
+
+
+
+
+ Default
+
+
+ value
+
+
+
+
+
+
+
+
+
+ Explanation
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_prel
+
+
+
+
+
+
+ R
+
+
+
+ 9999999.9
+
+
+
+
+
+
+ Temporal
+interval at
+which particles are to be released from
+a particle
+source ( in s).
+
+
+
+
+
+
+ By default
+particles are released only at the beginning of a simulation
+(t_init=0). The time of the first release (t_init) can be changed with
+package parameter particle_advection_start .
+ The time of the last release can be
+set with the package parameter end_time_prel .
+If dt_prel
+has been set, additional
+releases will be at t = t_init+dt_prel ,
+t_init+2*dt_prel ,
+t_init+3*dt_prel ,
+etc.. Actual release times
+may slightly deviate from thesel values ( see
+e.g. dt_dopr ).
+
+
+
+
+
+ The domain
+of the particle source as
+well as the distance of released particles
+within this source are determined via package
+parameters pst , psl , psr , pss , psn , psb , pdx , pdy
+ and
+ pdz . By
+default, one particle is released at all points defined by these
+parameters. The package parameter particles_per_point
+can be used to start more than one particle per point.
+
+
+
+
+
+
+
+
+
+ Up to 10
+different groups of particles can be released at the same time (see number_of_particle_groups )
+where each group may have a different source. All particles belonging
+to one group have the same density ratio and the same radius. All other
+particle features (e.g. location of the source) are
+identical for all groups of particles.
+
+
+Subgrid
+scale velocities can (optionally) be included for calculating the
+particle advection, using the method of Weil et al. (2004, JAS, 61,
+2877-2887). This method is switched on by the package
+parameter use_sgs_for_particles .
+This also forces the Euler/upstream method to be used for time
+advancement of the TKE (see initialization parameter use_upstream_for_tke ).
+The minimum timestep during the sub-timesteps is controlled by package
+parameter dt_min_part .
+
+
+ By
+default, particles are weightless and transported passively with the
+resolved scale flow. Particles can be given a mass and thus an inertia
+by assigning the
+package parameter density_ratio a
+non-zero value (it
+defines the ratio of the density of the fluid and the density of the
+particles). In these cases their radius
+must also be defined, which affects their flow resistance.
+
+
+
+
+
+ Boundary
+conditions for the particle transport can be defined with package
+parameters bc_par_t , bc_par_lr , bc_par_ns
+ and
+ bc_par_b .
+
+
+ Timeseries
+of particle quantities in NetCDF format can be output to local file DATA_1D_PTS_NETCDF
+by using package parameter dt_dopts .
+
+
+
+
+
+ For
+analysis, additional output of
+particle
+information in equidistant temporal intervals can be carried out using dt_write_particle_data
+(file PARTICLE_DATA ).
+
+
+
+
+
+
+
+
+
+ Statistical
+informations (e.g. the total number of particles used, the
+number of particles exchanged between the PEs, etc.) are output to the
+local file PARTICLE_INFOS ,
+if switched on by the parameter write_particle_statistics .
+
+
+
+
+
+
+
+
+
+ If a job
+chain is to be carried out, particle
+informations for the restart run (e.g. current
+location of
+all
+particles at the end of the
+run) is output to
+the local file PARTICLE_RESTART_DATA_OUT ,
+ which
+must be saved at the
+end of the run and
+given as an
+input file to the restart run
+under local file name PARTICLE_RESTART_DATA_IN
+using
+respective file
+connection statements in the mrun
+configuration file.
+
+
+
+
+ The output of
+particles for visualization with the graphic software dvrp is steered by
+the package
+parameter dt_dvrp .
+For visualization
+purposes particles can be given a
+diameter by the parameter dvrp_psize
+(this diameter only affects the visualization). All particles have the
+same size. Alternatively, particles can be given an individual size and
+a color by modifying the
+user-interface (subroutine user_init_particles ).
+Particles can pull a
+“tail” behind themselves to improve their
+visualization.
+This is steered via the parameter use_particle_tails .
+
+
+
+
+
+ So far, the
+particle transport realized in PALM does only
+work
+duly in case of a constant vertical grid spacing!
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_par_b
+
+
+
+
+
+
+ C*15
+
+
+
+ ´reflect´
+
+
+
+
+
+
+ Bottom
+boundary condition for particle transport.
+
+
+
+
+
+ By
+default, particles are reflected at the bottom boundary.
+Alternatively, a particle absorption can set by bc_par_b
+= ´absorb´ .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_par_lr
+
+
+
+
+
+
+ C*15
+
+
+
+ ´cyclic´
+
+
+
+
+
+
+ Lateral
+boundary condition (x-direction) for particle
+transport.
+
+
+
+
+
+ By default, cyclic boundary conditions
+are used along x.
+Alternatively, reflection (bc_par_lr
+= ´reflect´ ) or absorption (bc_par_lr
+= ´absorb´ )
+can be set.
+
+
+
+
+
+
+
+
+ This lateral boundary
+conditions should correspond to the
+lateral boundary condition used for the flow (see bc_lr ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_par_ns
+
+
+
+
+
+
+ C*15
+
+
+
+ ´cyclic´
+
+
+
+
+
+
+ Lateral
+boundary condition (y-direction) for particle
+transport.
+
+
+
+
+
+ By default, cyclic boundary conditions
+are used along y.
+Alternatively, reflection (bc_par_ns
+= ´reflect´ ) or absorption (bc_par_ns
+= ´absorb´ )
+can be set.
+
+
+
+
+
+
+This lateral boundary conditions should correspond to the lateral
+boundary condition used for the flow (see bc_ns ).
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_par_t
+
+
+
+
+
+
+ C*15
+
+
+
+ ´absorb´
+
+
+
+
+
+
+ Top boundary
+condition for particle transport.
+
+
+
+
+
+ By default,
+particles are absorbed at the top boundary.
+Alternatively, a reflection condition can be set by bc_par_t
+= ´reflect´ .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ density_ratio
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+
+ 0.0, 9
+*
+
+
+ 9999999.9
+
+
+
+
+
+
+
+
+ Ratio of the density
+of the fluid and the density of the
+particles.
+
+
+
+
+
+ With the default value the
+particles are weightless and transported passively with the resolved
+scale flow.
+In case of density_ratio
+/=
+0.0 particles have a mass and hence inertia so that their velocity
+deviates more or less from the velocity of the surrounding flow.
+Particle velocity is calculated analytically and depends on (besides
+the density ratio and the current velocity difference between particles
+and surrounding fluid) the
+particle radius which is determined via radius
+as well as on the molecular viscosity (assumed as 1.461E-5 m2 /s).
+
+
+
+
+
+
+ If density_ratio = 1.0 ,
+the particle density
+corresponds to the density of the surrounding fluid and the particles
+do not feel any buoyancy. Otherwise, particles will be accelerated
+upwards (density_ratio > 1.0 )
+or downwards (density_ratio < 1.0 ).
+
+
+
+
+
+
+
+
+
+ With several groups of particles (see number_of_particle_groups ),
+each group can be assigned a different value. If the number of values
+given for density_ratio
+is less than the number of
+groups defined by number_of_particle_groups ,
+then the last assigned value is used for all remaining groups. This
+means that by default the particle density ratio for all groups will be
+ 0.0 .
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_dopts
+
+
+ R
+
+
+ value of dt_data_
+
+
+output
+
+
+
+
+
+ Temporal
+interval at which time series data of particle quantities
+shall be output ( in s).
+
+
+
+ If
+particle advection is switched on (see dt_prel )
+this parameter can be used to assign
+th e temporal
+interval at which time series of particle quantities shall be output.
+Output is written in NetCDF format on local file DATA_1D_PTS_NETCDF .
+
+
+
+
+
+The
+following list gives a short description of the quantities
+available. Most quantities are averages over all particles. The
+quantity name given in the first column is identical to the respective
+name of the variable on the NetCDF file (see section 4.5.1 for a general
+description of the NetCDF files).
+
+
+
+
+
+In case of using
+more than one particle group (see number_of_particle_groups ),
+seperate time series are output for each of the groups. The long names
+of the variables in the NetCDF file containing the respective
+timeseries all end with the string ' PG ##' , where ## is the number of the particle
+group (01 , 02 , etc.).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ tnpt
+
+
+ total number of
+particles
+
+
+
+
+
+
+
+
+ x_
+
+
+ particle
+x-coordinate with respect to the particle origin (in m)
+
+
+
+
+
+
+
+
+ y_
+
+
+ particle
+y-coordinate with respect to the particle origin (in m)
+
+
+
+
+
+
+
+
+ z_
+
+
+ particle
+z-coordinate with respect to the particle origin (in m)
+
+
+
+
+
+
+
+
+ z_abs
+
+
+ absolute
+particle z-coordinate (in m)
+
+
+
+
+
+
+
+
+ u
+
+
+ u particle
+velocity component (in m/s)
+
+
+
+
+
+
+
+
+ v
+
+
+ v particle
+velocity component (in m/s)
+
+
+
+
+
+
+
+
+ w
+
+
+ w particle
+velocity component (in m/s)
+
+
+
+
+
+
+
+
+ u"
+
+
+ subgrid-scale u
+particle velocity component (in m/s)
+
+
+
+
+
+
+
+
+ v"
+
+
+ subgrid-scale v
+particle velocity component (in m/s)
+
+
+
+
+
+
+
+
+ w"
+
+
+ subgrid-scale w
+particle velocity component (in m/s)
+
+
+
+
+
+
+
+
+ npt_up
+
+
+ total number of
+upward moving particles
+
+
+
+
+
+
+
+
+ w_up
+
+
+ vertical
+velocity of the upward moving particles (in m/s)
+
+
+
+
+
+
+
+
+ w_down
+
+
+ vertical
+velocity of the downward moving particles (in m/s)
+
+
+
+
+
+
+
+
+ npt_max
+
+
+ maximum number
+of particles in a subdomain (=tnpt for non-parallel runs)
+
+
+
+
+
+
+
+
+ npt_min
+
+
+ minimum number
+of particles in a subdomain (=tnpt for non-parallel runs)
+
+
+
+
+
+
+
+
+ x*2
+
+
+ variance of the
+particle x-coordinate with respect to x_ (in m2 )
+
+
+
+
+
+
+
+
+ y*2
+
+
+ variance of the
+particle y-coordinate with respect to y_ (in m2 )
+
+
+
+
+
+
+
+
+ z*2
+
+
+ variance of the
+particle z-coordinate with respect to z_ (in m2 )
+
+
+
+
+
+
+
+
+ u*2
+
+
+ variance of the
+u particle velocity component with respect to u (in m2 /s2 )
+
+
+
+
+
+
+
+
+ v*2
+
+
+ variance of the
+v particle velocity component with respect to v (in m2 /s2 )
+
+
+
+
+
+
+
+
+ w*2
+
+
+ variance of the
+w particle velocity component with respect to w (in m2 /s2 )
+
+
+
+
+
+
+
+
+ u"2
+
+
+ variance of the
+subgrid-scale u particle velocity component with respect to u" (in m2 /s2 )
+
+
+
+
+
+
+
+
+ v"2
+
+
+ variance of the
+subgrid-scale v particle velocity component with respect to v" (in m2 /s2 )
+
+
+
+
+
+
+
+
+ w"2
+
+
+ variance of the
+subgrid-scale w particle velocity component with respect to w" (in m2 /s2 )
+
+
+
+
+
+
+
+
+ npt*2
+
+
+ variance of the
+number of particles with respect to the average number of particles per
+subdomain
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_min_part
+
+
+ R
+
+
+ 0.0002
+
+
+ Minimum value for the
+particle timestep when SGS velocities are used (in s).
+
+
+
+
+
+For
+a further explanation see package parameter use_sgs_for_particles .
+
+
+
+
+
+ dt_sort_particlesR 0.0 Temporal interval for sorting particles (in s). By
+default, particles are sorted in memory in a way that their order
+follows the order in which the gridpoint values are stored. This may
+improve cache coherence in case of larger numbers of particles and
+gridpoints. However, since the sorting itself is time consuming and
+since the requirement of sorting depends on the strength of mixing in
+the flow, performance can be improved if the sorting is applied only
+after certain time intervals. The proper length of this interval dt_sort_particles must be determined empirically by carrying out test runs with different intervals. Check file CPU_MEASURES to find the value of dt_sort_particles which gives the best performance.Note: In case of cloud_droplets = .T. , any given non-zero value of dt_sort_particles will be reset to zero and a corresponding warning message will appear in the job protocol.
+
+
+
+
+
+
+ dt_write_particle_
+ data
+
+
+
+
+
+ R
+
+
+
+
+
+ 9999999.9
+
+
+
+
+
+
+ Temporal
+interval for output of particle data (in s).
+
+
+
+
+
+ This
+parameter can be used to
+assign the temporal interval at which particle data shall be output.
+Data are output to
+the local file PARTICLE_DATA .
+ See the file description
+for more
+details about its format .
+
+
+
+
+
+ By
+default, no particle data are output.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dvrp_psize
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ 0.2 * dx
+
+
+
+
+
+
+
+
+
+ Diameter that
+the particles is given in visualizations with
+the dvrp
+software (in
+m).
+
+
+
+
+
+ In case that particles are
+visualized with the dvrp
+software (see chapter
+4.5.7 ), their size can be set by parameter dvrp_psize .
+All
+particles are displayed with this same size.
+
+
+
+
+
+
+
+
+ Alternatively,
+the particle diameters can be set with the
+user-interface in routine user_init_particles
+(at the beginning of the simulation) and/or can be redefined after each
+timestep in routine user_particle_attributes
+(both routines can be found in file user_interface.f90 ) .
+
+
+
+
+
+ Note: This parameter determines exclusively
+the size
+under which particles appear in the dvrp
+visualization. The flow relevant particle radius is determined via the
+particle package parameter radius !
+
+
+
+
+
+
+
+
+
+
+
+
+ end_time_prel
+
+
+ R
+
+
+ 9999999.9
+
+
+ Time of the last release of
+particles (in s).
+
+
+
+
+
+See also particle_advection_start .
+
+
+
+
+
+
+
+
+
+ initial_weighting_factor
+
+
+
+ R
+
+
+
+
+
+ 1.0
+
+
+
+
+
+
+ Factor to define the real
+number of initial droplets in a grid box.
+
+
+
+
+
+
+In case of explicitly simulating cloud droplets (see cloud_droplets ),
+the real number of initial droplets in a grid box is equal to the
+initial number of droplets in this box (defined by the particle source
+parameters pst , psl , psr , pss , psn , psb , pdx , pdy
+ and
+ pdz )
+times the initial_weighting_factor .
+
+
+
+
+
+
+
+
+
+
+
+
+ maximum_number_of_
+
+
+
+ particles
+
+
+
+
+
+ I
+
+
+ 1000
+
+
+
+
+
+
+ Maximum number
+of particles (on a PE).
+
+
+
+
+
+ This parameter
+allows to set the number of particles for which
+memory must be allocated at the beginning of the run.
+If this memory becomes insufficient during the run, due to the
+release of further particles (see dt_prel ),
+then more memory is automatically allocated.
+
+
+
+
+
+
+For runs on several processors, maximum_number_of_particles
+defines
+the maximum number on each PE. This number must be larger than the
+maximum number of particles initially released in a subdomain.
+
+
+
+
+
+
+
+
+
+
+
+
+ maximum_number_of_
+
+
+
+ tailpoints
+
+
+
+
+
+ I
+
+
+ 100
+
+
+
+
+
+
+ Maximum number
+of tailpoints that a particle tail can
+have.
+
+
+
+
+
+ maximum_number_of_tailpoints
+sets the number of descrete points the tail consists of. A new point is
+added to the particle tails after each time step. If the maximum number
+of tail
+points is reached after the corresponding number of timesteps, the
+oldest respective tail points is deleted within the following
+timestep.
+
+
+
+
+
+ All particle tails have the
+same number of points. The maximum
+length of
+these
+tails is determined by the value of maximum_number_of_tailpoints
+and by the minimum distance between each of the adjoining
+tailpoints, which can be set by minimum_tailpoint_distance .
+Additionally, it can be determined that the temporal displacement
+between the current position of the particle and the oldest point of
+the tail may become not larger than a value to be assigned by maximum_tailpoint_age .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ maximum_tailpoint_
+
+
+
+ age
+
+
+
+
+
+ R
+
+
+ 100000.0
+
+
+
+
+
+ Maximum age that the
+end point of a particle tail is allowed to have (in s).
+
+
+
+
+
+ If the temporal displacement between the oldest point of a
+particle tail and the current position of the particle becomes larger
+than the value given by maximum_tailpoint_age , this
+oldest
+point (which defines the end of the tail) is
+removed. If this time is so small that the number of points defining
+the particle tail do not exceed the value given by maximum_number_of_tailpoints ,
+then the length the particle tails is a measure for the distance the
+particle travelled along during the time interval defined via maximum_tailpoint_age ,
+i.e. for the
+particle velocity. Fast particles will have long tails, slow particles
+shorter ones (note: this will not neccessarily hold if minimum_tailpoint_distance
+= 0.0 ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ minimum_tailpoint_distance
+
+
+
+
+
+
+ R
+
+
+
+ 0.0
+
+
+
+
+
+
+ Minimum
+distance allowed between two adjacent points of a
+particle tail (in m).
+
+
+
+
+
+ In case of minimum_tailpoint_distance
+> 0.0 the
+particle tail is extended by a new point only if the distance between
+its current position and the most recent tail point exceed the
+distance given via minimum_tailpoint_distance .
+
+
+
+
+
+
+
+
+
+ If the length of the particle tails shall be
+proportional to
+the respective particle velocity, the parameter maximum_tailpoint_age
+must also be set appropriately.
+
+
+ Note:
+
+
+
+A suitable choice of minimum_tailpoint_distance
+> 0.0 is recommended, because then the tail
+coordinates of
+slowly moving particles require less memory and can also be drawn
+faster. The upper limit of minimum_tailpoint_distance
+should be chosen in a way that the visualized particle
+tails still appear as smooth lines. Example: with a model domain of
+1000 m and a monitor resolution of 1280 * 1024 pixels it
+should be sufficient to set minimum_tailpoint_distance
+= 5.0
+(m).
+
+
+
+
+
+
+
+
+ number_of_particle_groups
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+ 1
+
+
+
+
+
+ Number of particle groups to be
+used.
+
+
+
+
+
+
+Each particle group can be assigned its own source region (see pdx , psl ,
+ psr , etc.), particle diameter (radius ) and particle density ratio (density_ratio ).
+
+
+
+
+
+If
+less values are given for pdx , psl ,
+etc. than the number of particle groups, then the last value is used
+for the remaining values (or the default value, if the user did not set
+the parameter).
+
+
+
+
+
+
+The maximum allowed number of particle groups is limited to 10 .
+
+
+
+
+
+
+
+
+
+
+
+
+ particles_per_point
+
+
+ I
+
+
+ 1
+
+
+ Number of particles to be
+started per point.
+
+
+
+
+
+By default, one particle is
+started at all points of the particle source, defined by the package
+parameters pst , psl , psr , pss , psn , psb , pdx , pdy
+ and
+ pdz .
+
+
+
+
+
+
+
+
+
+
+
+ particle_advection_
+
+
+
+ start
+
+
+
+
+
+ R
+
+
+ 0.0
+
+
+
+
+
+ Time of the first
+release of particles (in s).
+
+
+
+
+
+ If particles are not
+to be released at the beginning of the
+run, the release time can be set via particle_advection_start .
+
+
+
+If particle transport is switched on in a restart run, then read_particles_from_restartfile
+= .F. is
+also required.
+
+
+
+
+ See also end_time_prel .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ particle_maximum_age
+
+
+
+
+
+
+ R
+
+
+
+ 9999999.9
+
+
+
+
+
+
+ Maximum
+allowed age of particles (in s).
+
+
+
+
+
+ If the
+age of a particle exceeds the time set by particle_maximum_age ,
+the particle as well as its tail is deleted.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ pdx
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+
+ 10 * dx
+
+
+
+
+
+
+ Distance
+along x between particles within a particle source
+(in m).
+
+
+
+
+
+ If the particle source shall be
+confined to one grid point,
+the distances given by pdx ,
+ pdy
+and pdz
+must be set larger than the respective domain size or psl
+= psr has to be set
+alternatively.
+
+
+
+
+
+
+
+
+
+ pdx
+can be assigned a different value for each particle group (see number_of_particle_groups ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ pdy
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+
+ 10
+* dy
+
+
+ Distance
+along y between
+particles within a
+particle source (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+ pdz
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+
+ 10
+* ( zu(2) - zu(1) )
+
+
+ Distance along z between
+particles within a particle source
+(in m).
+
+
+
+
+
+
+
+
+
+
+
+ psb
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+
+ 10
+* zu(nz/2)
+
+
+ Bottom
+edge of a particle
+source (in m).
+
+
+
+
+
+
+
+
+
+
+
+ psl
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+
+ 10
+* 0.0
+
+
+ Left
+edge of a particle source
+(in m).
+
+
+
+
+
+
+
+
+
+
+
+ psn
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+
+ 10
+* (ny * dy)
+
+
+ Rear
+(“north”) edge of a
+particle source (in m).
+
+
+
+
+
+
+
+
+
+
+
+ psr
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+
+ 10
+* (nx * dx)
+
+
+ Right
+edge of a particle
+source (in m).
+
+
+
+
+
+
+
+
+
+
+
+ pss
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+
+ 10
+* 0.0
+
+
+ Front
+(“south”) edge of a
+particle source (in m).
+
+
+
+
+
+
+
+
+
+
+
+ pst
+
+
+
+
+
+
+ R (10)
+
+
+
+
+
+
+ 10
+* zu(nz/2)
+
+
+ Top
+edge of a particle source
+(in m).
+
+
+
+
+
+
+
+
+
+
+
+ radius
+
+
+
+
+
+
+ R (10)
+
+
+
+ 0.0, 9 *
+
+
+
+ 9999999.9
+
+
+ Particle radius (in m).
+
+
+
+
+
+
+The viscous friction (in case of a velocity difference
+between
+particles and surrounding fluid) depends on the particle radius which
+must be assigned as soon as density_ratio
+/= 0.0 .
+
+
+
+
+
+
+With several groups of particles (see number_of_particle_groups ),
+each group can be assigned a different value. If the number of values
+given for radius
+is less than the number of
+groups defined by number_of_particle_groups ,
+then the last assigned value is used for all remaining groups. This
+means that by default the particle radius for all groups will be 0.0 .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ random_start_position
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+ Initial position of the
+particles is
+varied randomly within certain limits.
+
+
+
+
+
+ By
+default, the initial positions of particles within the
+source excatly correspond with the positions given by psl ,
+ psr , psn ,
+ pss , psb ,
+ pst , pdx ,
+ pdy ,
+and
+pdz . With random_start_position = .T.
+ the initial
+positions of the particles are allowed to randomly vary from these
+positions within certain limits.
+
+
+
+
+
+ Very
+important:
+
+
+ In case of random_start_position
+= .T. , the
+random-number generators on the individual PEs no longer
+run synchronously. If random disturbances are applied to the velocity
+field
+(see create_disturbances ),
+ then as consequence for parallel
+runs the
+realizations of the turbulent flow
+fields will deviate between runs which used different numbers of PEs!
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ read_particles_from_
+
+
+
+ restartfile
+
+
+
+
+
+ L
+
+
+
+
+
+ .T.
+
+
+
+
+
+
+ Read particle
+data from the previous run.
+
+
+
+
+
+ By default,
+with restart runs particle data is read
+from file PARTICLE_RESTART_DATA_IN ,
+which is created by the preceding run. If this is not requested or if
+in a restart run particle transport is switched on for the
+first time (see particle_advection_start ),
+then read_particles_from_restartfile = .F.
+is required.
+
+
+
+
+
+
+
+
+
+
+
+ skip_particles_for_tail
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+ 1
+
+
+
+
+
+
+ Limit the number of
+particle tails.
+
+
+
+
+
+
+If particle tails are switched on (see use_particle_tails ),
+every particle is given a tail by default. skip_particles_for_tail can
+be used to give only every n'th particle a tail.
+
+
+
+
+
+ Example:
+
+
+ skip_particles_for_tail
+= 10 means
+that only every 10th particle will be given a tail.
+
+
+
+
+
+
+
+
+
+
+
+
+ use_particle_tails
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+ Give particles a tail.
+
+
+
+
+
+
+A particle tail is defined by the path a particle has moved
+along starting from some point of time in the past. It consists of a
+set of descrete points in space which may e.g. be connected by a line
+in order visualize how the particle has moved.
+
+
+
+
+
+
+By default, particles have no tail. Parameter skip_particles_for_tail
+can be used to give only every n'th particle a tail.
+
+
+
+
+
+
+The length of the tail is controlled by parameters maximum_number_of_tailpoints , maximum_tailpoint_age ,
+and minimum_tailpoint_distance .
+
+
+
+
+
+
+
+
+
+
+
+
+ use_sgs_for_particles
+
+
+ L
+
+
+ .F.
+
+
+ Use subgrid-scale
+velocities for particle advection.
+
+
+
+
+
+These
+velocities are calculated from the resolved and subgrid-scale TKE using
+the Monte-Carlo random-walk method described by Weil et al. (2004, JAS,
+61,
+2877-2887). When using this method, the timestep for the advancement of
+the particles is limited by the so-called Lagrangian time scale. This
+may be smaller than the current LES timestep so that several particle
+(sub-) timesteps have to be carried out within one LES timestep. In
+order to limit the number of sub-timesteps (and to limit the CPU-time),
+the minimum value for the particle timestep is defined by the package
+parameter dt_min_part .
+
+
+
+
+
+Setting
+ use_sgs_for_particles
+= .TRUE.
+automatically forces use_upstream_for_tke
+= .TRUE. .
+This inhibits the occurrence of large (artificial) spatial gradients of
+the subgrid-scale TKE which otherwise would lead to wrong results for
+the particle advection.
+
+
+
+
+
+
+
+
+
+
+
+ vertical_particle_
+
+
+
+ advection
+
+
+
+
+
+ L
+
+
+
+
+
+ .T.
+
+
+
+
+
+
+ Switch on/off
+vertical particle transport.
+
+
+
+
+
+ By default,
+particles are transported along all three
+directions in space. With vertical_particle_advection
+= .F., the
+particles will only be transported horizontally.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ write_particle_
+
+
+
+ statistics
+
+
+
+
+
+ L
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+ Switch on/off
+output of particle informations.
+
+
+
+
+
+
+
+
+
+
+
+
+For write_particle_statistics
+= .T. statistical
+informations (e.g. the total number of particles used, the
+number of particles exchanged between the PEs, etc.) which may be used
+for debugging are output to the
+local file PARTICLE_INFOS .
+
+
+
+
+
+
+ Note: For parallel runs files
+may become very large
+and performance of PALM may decrease.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Package
+parameters:
+
+
+
+
+
+Package
+(mrun option
+-p): dvrp_graphics
+
+NAMELIST group name: dvrp_graphics_par
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Parameter
+name
+
+
+ Type
+
+
+
+
+
+
+ Default
+
+
+ value
+
+
+
+
+
+
+ Explanation
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_dvrp
+
+
+
+
+
+
+ R
+
+
+
+ 9999999.9
+
+
+
+
+
+
+ Temporal
+interval of scenes to be displayed with the dvrp software (in
+s).
+
+
+
+
+
+ Isosurfaces, cross sections and
+particles can be displayed
+simultaneous. The display of particles requires that the particle
+transport is switched on (see dt_prel ).
+Objects to be displayed have to be determined with mode_dvrp .
+
+
+
+
+
+ If
+output of scenes created by dvrp software is switched on
+(see mode_dvrp ),
+this parameter can be used to assign the temporal interval at which
+scenes are to be created (and the respective graphical data
+is to
+be output to the streaming server). Reference time is the beginning of
+ the simulation, i.e. output takes place at times t = dt_dvrp ,
+2*dt_dvrp , 3*dt_dvrp , etc. The
+actual output times can
+deviate from these theoretical values (see dt_dopr ).
+Is dt_dvrp < dt , then
+scenes are created and
+output after each time step (if this is requested it should be dt_dvrp
+= 0 ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dvrp_directory
+
+
+
+
+
+
+ C*80
+
+
+
+ 'default'
+
+
+
+
+
+
+ Name of the
+directory into which data created by the dvrp
+software shall be saved.
+
+
+
+
+
+ By default,
+the directory name is generated from the user
+name
+(see package parameter dvrp_username )
+and the base file name (given as the argument of mrun option -d) as '<user
+name>/<base file name>' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dvrp_file
+
+
+
+
+
+
+ C*80
+
+
+
+ 'default'
+
+
+
+
+
+
+ Name of the
+file into which data created by the dvrp
+software shall be output.
+
+
+
+
+
+ This
+parameter can be given a value only in case of dvrp_output
+= 'local'
+ which
+determines that the data created by dvrp
+is output to a local file (on the machine where PALM is executed).
+Apart from the default, it is only allowed to assign '/dev/null' (which
+means that no output is really stored). This can be used for special
+runtime measurements of the dvrp
+software.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dvrp_host
+
+
+
+
+
+
+ C*80
+
+
+
+
+
+
+ 'origin.rvs.
+
+
+
+uni- hanover.de'
+
+
+
+
+
+
+
+
+ Name of the computer
+to which data created by the dvrp
+software shall be
+transferred.
+
+
+
+
+
+ In case of dvrp_output
+= 'rtsp'
+only the default
+value is allowed (streaming server of
+the RRZN). For dvrp_output
+= 'local'
+ the
+assigned value is ignored.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dvrp_output
+
+
+
+
+
+
+ C*10
+
+
+
+ 'rtsp'
+
+
+
+
+
+
+ Output mode
+for the dvrp
+software.
+
+
+
+
+
+
+
+
+
+The following settings are allowed:
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 'rtsp'
+
+
+
+ Data created by the dvrp
+software is transferred using
+a special transmission protocol to a so-called streaming server, which
+is able to continuously transfer visualization data with a
+high transmission rate.
+
+
+
+Additionally, with this output mode a
+set of files is generated automatically
+within a directory on the streaming server (beside the visualization
+data e.g. some html-files) which can be used to
+visualize the data via an internet-browser plugin. Host
+(streaming-server) and directory can be defined by the user with dvrp_host
+and dvrp_directory .
+
+
+
+
+
+
+
+
+
+ 'ftp'
+
+
+
+ Data created by the dvrp
+software is transferred to the destination host (see dvrp_host
+and dvrp_directory )
+using ftp.
+
+
+
+
+
+
+
+
+ 'local'
+
+
+
+ Data created by the dvrp
+software is output locally on a file defined by dvrp_file
+ .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dvrp_password
+
+
+
+
+
+
+ C*80
+
+
+
+ '********'
+
+
+
+
+
+ Password for the
+computer to which data created by the dvrp software is to
+be
+transferred.
+
+
+
+
+
+ Assigning a password is
+only necessary in case of dvrp_output
+= 'ftp' .
+For dvrp_output
+= 'rtsp'
+ the default
+value must not be changed!
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dvrp_username
+
+
+
+
+
+
+ C*80
+
+
+
+
+
+
+
+
+
+
+
+
+ User name of a valid
+account on the computer to which data
+created by the dvrp
+software
+is to be
+transferred.
+
+
+
+
+
+ Assigning a value to this
+parameter is required in case of dvrp_output
+= 'rtsp'
+or 'ftp' .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mode_dvrp
+
+
+
+
+
+
+ C*20
+
+
+
+(10)
+
+
+ 10
+* ''
+
+
+
+
+
+ Graphical objects (isosurfaces, slicers, particles) which are
+to be created by the dvrp
+software.
+
+
+
+
+
+ Several different objects can
+be assigned simultaneously and
+will be displayed in the same scene. Allowed values for mode_dvrp are 'isosurface##'
+(isosurface), 'slicer##'
+(cross sections), and 'particles' .
+Within the strings the hash characters ("##") have to be replaced by two
+digits 01≤##≤99. Up to 10 objects
+can be assigned at the same time, e.g.:
+
+
+
+
+
+ mode_dvrp
+= 'isosurface02' ,
+'slicer01',
+'particles', 'slicer02'
+
+
+
+
+
+ In this
+case one isosurface, two cross sections, and particles
+will be created. The quantities for which isosurfaces or cross sections are to be
+created have to be selected with
+the parameter data_output (data_output
+also determines the
+orientation of the cross section, thus xy, xz, or yz). Since for data_output lists of
+variables may be
+assigned, the digits at the end of the mode_dvrp -string
+select the quantity, which is given
+at the respective position in the respective list (e.g. 'isosurface02'
+selects the second 3D quantity
+of data_output , 'slicer01' selects the first 2D quantity
+of data_output ).
+If e.g. data_output is assigned as data_output = 'u_xy' ,
+'w_xz', 'v_yz' , 'pt' ,
+'u', 'w' , then - assuming the above assignment of mode_dvrp - an
+isosurface of u, a
+horizontal cross section of u and
+a vertical cross section (xz) of w are created. For locations of the
+cross sections see data_output .
+The theshold value for which the isosurface is
+to be created can be defined with parameter threshold .
+
+
+
+
+
+
+
+
+
+ The vertical extension of the displayed domain is
+given by nz_do3d .
If user-defined dvrp objects exist (see chapter 3.5.4 ), then mode_dvrp may also refer to quantities selected with the parameter data_output_user (internally PALM appends them to those selected with
+the parameter data_output ).
+
+
+
Assignments
+of mode_dvrp must correspond to those of data_output
+and
+data_output_user! If e.g. data_output = 'pt_xy' , 'w' was set, then only the digits "01" are allowed
+for mode_dvrp ,
+thus 'isosurface01'
+and/or 'slicer01' .
+
+
+
+
+
+
+ Further details about using the dvrp software are
+given in chapter
+4.5.7 .
+
+
+
+
+
+ Note:
+
+
+
+The declaration color charts to be
+used still have to be given "manually" in subroutine user_dvrp_coltab
+(file user_interface.f90 ).
+
+
+
+A change of particle colors and/or particle diameters (e.g.
+according
+to the local characteristics of the flow field) to be used for the
+visualization, must be carried out by adding respective code extensions
+to user_particle_attributes
+(in file user_interface.f90 ).
+
+
+
+
+
+
+
+
+
+ slicer_range_limits_
+
+
+
+dvrp
+
+
+ R(2,10)
+
+
+
+ 10
+* (-1,1)
+
+
+ Ranges
+of values to which a color table has to be mapped (units of the
+respective quantity).
+
+
+
+
+
+
+In case that slicers have to be displayed (see mode_dvrp ),
+this parameter defines the ranges of values of the respective
+quantities to which the colortable in use has to be mapped. If e.g. a
+temperature slice shall be displayed, the colortable defines colors
+from blue to red, and slicer_range_limits_dvrp
+= 290.0, 305.0 then areas with temperature of 290 K are displayed in
+dark blue and those with 305.0 are displayed in dark red. Temperatures
+within these limits will be displayed by a continuous color gradient
+from blue to red and Temperatures outside the limits will
+be displayed either in dark blue or in dark red.
+
+
+
+
+
+
+Up to ten different ranges can be assigned in case that more than one
+slicer has to be displayed.
+
+
+
+
+
+
+See mode_dvrp
+for the declaration of color charts.
+
+
+
+
+
+
+
+
+
+
+
+
+ superelevation
+
+
+
+
+
+
+ R
+
+
+
+ 1.0
+
+
+
+
+
+
+ Superelevation
+factor for the vertical coordinate.
+
+
+
+
+
+ For
+domains with unfavorable ratio between the vertical and
+the horizontal size
+(the vertical size is determined by nz_do3d )
+a superelevation
+/= 1.0 may
+be used. If e.g. the
+horizontal size is substantially larger
+than the vertical size, a superelevation
+much larger than 1.0
+should
+be used, since otherwise the domain appears as a
+"flat disk" in the visualization and thus the vertical direction is
+only very poorly resolved.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ superelevation_x
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ 1.0
+
+
+
+
+
+
+
+
+
+ Superelevation
+factor for the horizontal (x) coordinate.
+
+
+
+
+
+ This
+parameter can be used to stretch the displayed domain
+along the x-direction. See also superelevation .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ superelevation_y
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ 1.0
+
+
+
+
+
+
+ Superelevation
+factor for the
+horizontal (y) coordinate.
+
+
+ This parameter can be
+used to
+stretch the displayed domain along the y-direction. See also superelevation .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ threshold
+
+
+
+
+
+
+ R(10)
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+ Threshold
+value for which an isosurface is to be created by
+the dvrp
+software.
+
+
+
+
+
+ If the creation of
+isosurfaces is switched on via
+parameter mode_dvrp ,
+then the respective threshold value for which the isosurface is to be
+created can be assigned via threshold . If several
+isosurfaces
+are given by mode_dvrp , then an individual
+threshold value for
+each isosurface can be assigned. The order of the threshold values
+refers to the order of the isosurfaces given by mode_dvrp .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Package (mrun
+option -p): spectra
+NAMELIST group name: spectra_par
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Parameter
+name
+
+
+ Type
+
+
+
+
+
+
+ Default
+
+
+ value
+
+
+
+
+
+
+ Explanation
+
+
+
+
+
+
+
+
+
+
+
+
+ averaging_interval_sp
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value of averaging_
+
+
+
+interval
+
+
+
+
+
+ Averaging interval
+for spectra output to local
+file DATA_1D_SP_NETCDF
+ and/or PLOTSP_X_DATA
+/ PLOTSP_Y_DATA
+(in s).
+
+
+
+
+
+ If
+this parameter is given a non-zero value, temporally
+averaged spectra data are output. By default, spectra data data are not
+subject to temporal averaging. The interval length is limited by the
+parameter dt_dosp . In any
+case averaging_interval_sp <= dt_dosp
+ must
+hold.
+
+
+If an interval is defined, then by default the average
+is calculated
+from the data values of all timesteps lying within this interval. The
+number of time levels entering into the average can be reduced with the
+parameter dt_averaging_input_pr .
+
+
+ If
+an averaging interval can not be completed at the end of a run, it will
+be finished at the beginning of the next restart run. Thus for restart
+runs, averaging intervals do not
+necessarily begin at the beginning of the run.
+
+
+
+
+
+
+
+
+
+
+
+
+ comp_spectra_level
+
+
+
+ I(10)
+
+
+ no level
+
+
+
+
+
+
+ Vertical level
+for which horizontal spectra are to be
+calculated and output (gridpoints).
+
+
+
+
+
+
+
+
+
+Spectra can be calculated for up to ten levels.
+
+
+
+
+
+
+
+
+
+
+
+
+ data_output_sp
+
+
+
+
+
+ C*10 (10)
+
+
+ 10 * ' '
+
+
+
+
+
+ Quantities for which
+horizontal spectra are to be calculated
+and output.
+
+
+
+
+
+ Allowed values are: data_output_sp
+= 'u' , 'v' , 'w' , 'pt' , 'q' .
+
+
+
+
+
+
+
+
+ Spectra are calculated using the FFT-method defined by fft_method .
+
+
+
+
+
+ By default spectra data are output to the local file DATA_1D_SP_NETCDF .
+The file's format is NetCDF. Further details about processing
+NetCDF data are given in chapter 4.5.1 .
+
+
+
+
+ The
+temporal interval of the output times of profiles is
+assigned via the parameter dt_dosp .
+
+
+
+
+ The
+vertical levels for which spectra are to be computed and output must be
+given by parameter comp_spectra_level .
+
+
+
+ Note:
+
+
+
+Beside data_output_sp ,
+values must
+be given for each of the
+parameters, comp_spectra_level ,
+and spectra_direction ,
+otherwise no
+output will be
+created!
+
+
+
+
+
+
+
+
+
+Calculation of spectra requires cyclic boundary conditions
+along the respective directions (see bc_lr
+and bc_ns ).For
+historical reasons, data can also be output in ASCII-format on local
+files PLOTSP_X_DATA
+and/or PLOTSP_Y_DATA
+(depending on the direction(s) along which spectra are to be
+calculated; see spectra_direction ),
+which are readable by the graphic software profil . See
+parameter data_output_format
+for defining the format in which data shall be output. Within
+these file, the spectra are ordered with respect to their
+output times. Spectra can also be temporally averaged (see averaging_interval_sp
+). Each data point of a
+spectrum is output in a single line (1st column:
+wavenumber, 2nd column: spectral coefficient). If spectra are to be
+calculated and output for more than one height (see comp_spectra_level ),
+the spectral coefficients for the further heighs can be found in the
+subsequent columns. The order
+of the data in the file follows the order used in the assignment for data_output_sp
+(data_output_sp = 'u' , 'v' ,…
+means that the file starts with the spectra of the u-component,
+followed by the v-component spectra, etc.). Additional to the files
+PLOTSP_X_DATA and PLOTSP_Y_DATA which contain
+the data,
+PALM creates NAMELIST parameter files (local name PLOTSP_X_PAR
+and PLOTSP_Y_PAR )
+which can be used as parameter input file for the plot software profil .
+Spectra can be directly plotted with profil
+using the data and the corresponding parameter file. The
+plot layout is
+steered via the parameter input file. The vertical levels for which
+spectra are to be plotted must be given by plot_spectra_level . Otherwise, no
+spectra
+will appear on the plot, although data are available on file. All
+parameter values can be changed by editing the parameter
+input
+file.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_dosp
+
+
+
+
+
+
+ R
+
+
+
+ value of
+ dt_data_
+
+
+output
+
+
+
+
+
+
+ Temporal
+interval at which spectra data shall be output
+(in s).
+
+
+
+
+
+ If output of
+horizontal spectra is switched on (see data_output_sp ), this
+parameter can be used to
+assign the temporal interval at which spectral data shall be
+output. Output can be skipped at the beginning of a
+simulation using parameter skip_time_dosp ,
+which has zero value by default. Reference
+time is the beginning of
+ the simulation, i.e. output takes place at times t = skip_time_dosp + dt_dosp ,
+ skip_time_dosp
++ 2*dt_dosp , skip_time_dosp + 3*dt_dosp ,
+etc. The actual output times can
+deviate from these theoretical values (see dt_dopr ).
+If dt_dosp < dt , then
+spectral data are output
+after each time step (if this is requested it should be dt_dosp
+= 0 ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ plot_spectra_level
+
+
+
+
+
+
+ I(10)
+
+
+
+ no level
+
+
+
+
+
+
+ Vertical
+level(s) for which horizontal spectra are to be
+plotted (in gridpoints).
+
+
+
+
+
+ This parameter
+only affects the display of spectra in plots
+created with profil .
+The
+spectral data created and output to file are exclusively determined via
+ comp_spectra_level .
+
+
+
+
+
+
+
+
+
+
+
+
+ skip_time_dosp
+
+
+
+ R
+
+
+
+
+
+ value of skip_time_
+
+
+data_output
+
+
+
+ No output of
+spectra data before this interval has passed (in s).
+
+
+
+
+
+This
+parameter causes that data output activities are starting not before
+this interval
+(counting from the beginning of the simulation, t=0) has passed.
+
+
+
+
+
+ Example:
+
+
+If
+the user has set dt_dosp = 3600.0 and skip_time_dosp = 1800.0 , then the
+first output will be done at t = 5400 s.
+
+
+
+
+
+
+
+
+
+
+
+
+ spectra_direction
+
+
+
+
+
+
+ C*2 (10)
+
+
+
+ 10 * ' '
+
+
+
+
+
+
+ Direction(s)
+along which spectra are to be calculated.
+
+
+
+
+
+ Allowed
+values are 'x' ,
+ 'y' and 'xy' . For
+every quantity given by data_output_sp
+a corresponding
+direction must
+be assigned.
+
+
+
+
+
+
+
+
+ Calculation of spectra
+requires cyclic boundary conditions
+along the respective directions (see bc_lr
+and bc_ns ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Last change:
+$Id$
+
+
+
+
+
+
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.3.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.3.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.3.html (revision 141)
@@ -0,0 +1,63 @@
+
+
+PALM chapter 4.3
+4.3 User-defined parameters
+
+ Parameter name
+ Type
+ Default
+ value
+ Explanation
+ data_output_pr_userC * 10 (200) 200 * ' ' User defined quantities for
+which horizontally averaged profile data is to be output. Beside
+the PALM standard output quantities (which can be selected via
+parameter data_output_pr ),
+the user can define (without any restriction) additional output
+quantities (e.g. turbulent resolved-scale horizontal momentum fluxes, etc.). Each of these
+quantities has to be given a unique identifier (string) which must be
+different from the strings defining the standard output quantities (see
+list from the description of data_output_pr ).
+Data output can be switched on by assigning the respective strings to data_output_user . The
+user has to calculate/provide the respective data array(s) by
+appropriately extending the user interface (see 3.5.4 ). For
+further steering of the user defined output (output times, cross
+section levels, time averaging, etc.), the steering parameters for data_output_pr
+apply accordingly. data_output_user C * 10 (100) 100 * ' ' User defined quantities for
+which 2d cross section and/or 3d volume data are to be output. Beside
+the PALM standard output quantities (which can be selected via
+parameter data_output ),
+the user can define (without any restriction) additional output
+quantities (e.g. the temperature variance, etc.). Each of these
+quantities has to be given a unique identifier (string) which must be
+different from the strings defining the standard output quantities (see
+list from the description of data_output ).
+Data output can be switched on by assigning the respective strings to data_output_user . The
+user has to calculate/provide the respective data array(s) by
+appropriately extending the user interface (see 3.5.4 ). For
+further steering of the user defined output (output times, cross
+section levels, time averaging, etc.), the steering parameters for data_output
+apply accordingly.Example: If
+the user defined output quantity is the temperature variance and if the
+user has chosen the string 'pt2'
+as an identifier for this quantity, then output of horizontal cross
+sections can be selected by assigning data_output_user = 'pt2_xy' . region
+ C*40 (0:9)
+ Name(s) of the subdomain(s) defined
+by the user.
With this variable, names
+can be assigned to the subsections
+defined by the user (see statistic_regions )
+which afterwards appear in the headers of the respective files (PLOT1D_DATA )
+and within the respective plots. Up to 9 subdomains are allowed (region
+(1) to region (9)), the total domain has the index
+0 (region
+(0)).
+
+
+
+
Last change:
+$Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.4.1.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.4.1.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.4.1.html (revision 141)
@@ -0,0 +1,179 @@
+
+
+PALM chapter 4.4
+
+
+4.4.1 A minimum
+parameter set for the CBL
+
+In this chapter a brief,
+simple and
+complete parameter set is described, which can be used to simulate a quasi-stationary,
+convective, atmospheric boundary layer with zero
+mean horizontal
+wind. For evaluation purposes, cross sections and
+horizontally averaged vertical
+profiles of typical boundary layer variables
+are output at the end of the run. The run shall be carried out in
+batch mode on the IBM Regatta "hanni" of the HLRN.
+The parameter file necessary
+to carry
+out a run must be provided to the model as an input file under the
+local name PARIN
+and has the following contents:
+&inipar nx = 39 , ny = 39 , nz = 40 , dx = 50.0 , dy = 50.0 , dz = 50.0 , dz_stretch_level = 1200.0 , fft_method = 'temperton-algorithm' , initializing_actions = 'set_constant_profiles' , ug_surface = 0.0 , vg_surface = 0.0 , pt_vertical_gradient = 0.0 , 1.0 , pt_vertical_gradient_level = 0.0 , 800.0 , surface_heatflux = 0.1 , bc_pt_b = 'neumann' ,/ &d3par end_time = 3600.0 , create_disturbances = .T. , dt_disturb = 150.0 , disturbance_energy_limit = 0.01 , dt_run_control = 0.0 , data_output = 'w_xy' , 'w_xz' , 'w_xz_av' , 'pt_xy' , 'pt_xz' , dt_data_output = 900.0 , dt_data_output_av = 1800.0 , averaging_interval = 900.0 , dt_averaging_input = 10.0 , section_xy = 2 , 10 , section_xz = 20 , data_output_2d_on_each_pe = .F. , dt_dopr = 900.0 , averaging_interval_pr = 600.0 , dt_averaging_input_pr = 10.0 , data_output_pr = '#pt' , 'w”pt”' , 'w*pt*' , 'wpt' , 'w*2' , 'pt*2' , cross_profiles = ' pt ' , ' w"pt" w*pt* wpt ' , ' w*2 ' , ' pt*2 ' , cross_xtext = 'pot. temperature in K' , 'heat flux in K ms>->1' , 'velocity variance in m>2s>->2' , 'temperature variance in K>2' , z_max_do1d = 1500.0 , /
+The initialization
+parameters (&inipar )
+are located at the beginning of the file. For analysis of a
+convective boundary layer of approx. 1000 m thickness the horizontal
+size of the model domain should amount to at least 2 km x 2 km. In
+order to resolve the convective structures a grid spacing of dx
+=
+dy = dz = 50 m
+is enough, since the typical
+diameter of convective plumes is more than 100 m. Thereby the
+upper array index in the two horizontal directions needs to be nx
+= ny = 39 . Since in
+each case the lower array index has the value 0, 40 grid points are
+used along both horizontal directions. In the vertical
+direction
+the domain must be high enough to include the entrainment processes at
+the top of the boundary layer as well as the propagation of gravity
+waves, which were stimulated by
+the convection. However, in the stably stratified region the grid
+resolution has not necessarily to be as high as within the boundary
+layer. This can be obtained by a vertical stretching of the grid
+starting
+from 1200 m via dz_stretch_level = 1200.0
+m. This saves
+grid points and computing time. T he
+upper boundary of the model is located at (see dz_stretch_factor )
+… m (computed by the model) .
Fast Fourier transformations are
+calculated using the Temperton-algorithm, which -on the IBM Regatta- is
+faster than the default system-specific algorithm (from IBM essl
+library).
The
+initial profiles for
+wind and temperature can be assigned via initializing_actions
+= 'set_constant_profiles' .
+The wind speed, constant with
+height, amounts to ug_surface = vg_surface
+= 0.0 m/s . In order
+to allow for a fast onset of convection, a neutral stratified layer up
+to z
+= 800 m capped by an inversion with dtheta/dz = 1K/100 m is given:
+pt_vertical_gradient = 0.0, 1.0 ,
+pt_vertical_gradient_level = 0.0, 800.0.
+The surface
+temperature, which by default amounts to 300 K, provides the fixed
+point for the temperature profile (see pt_surface ).
+Convection is driven by a given, near-surface sensible heat flux via surface_heatflux
+= 0.1 K m/s. A given surface sensible heta flux
+requires the
+bottom boundary condition for potential temperature to be bc_pt_b
+=
+'neumann' .
+Thus
+all initialization parameters are determined. These can not be
+changed during the run (also not for restart runs).
+Now the run parameters (&d3par )
+must be specified. To produce a quasi stationary boundary layer the
+simulated time should be at least one hour, i.e. end_time
+= 3600
+s. To stimulate convection, the initially homogeneous (zero)
+wind
+field must be disturbed (create_disturbances = .T. ).
+These perturbations should be repeated in a temporal interval of
+dt_disturb = 150.0 s until the
+energy of the
+perturbations exceeds the value disturbance_energy_limit
+= 0.01
+m2 /s2 . After
+each time step run time
+informations (e.g. size of the timestep, maximum velocities, etc.) are
+to be written to the local file RUN_CONTROL
+(dt_run_control = 0.0 s ).
Instantaneous cross section data
+of vertical velocity (w )
+and potential temperature (pt )
+are to be output for horizontal (xy )
+and vertical (xz )
+cross sections, and additionally, time averaged (av ) vertical cross
+section data are to be output for the vertical velocity: data_output = 'w_xy' , 'w_xz' , 'w_xz_av' , 'pt_xy' , 'pt_xz' . Output of
+instantaneous (time averaged) data is done after each 900 (1800)s: dt_data_output = 900.0 , dt_data_output_av = 1800.0 . The
+averaged data are time averaged over the last 900.0 s, where the
+temporal interval of data entering the average is 10 s: averaging_interval =
+900.0 , dt_averaging_input =
+10.0 .
+Horizontal cross sections are output for vertical levels with grid
+index k=2 and k=10, vertical cross sections are output for index j=20: section_xy = 2 , 10 , section_xz = 20 . For runs on
+more than one processor, cross section data are collected and output on
+PE0: data_output_2d_on_each_pe
+= .F. .
Output
+of vertical profiles is to be done after each 900 s. The profiles shall
+be temporally averaged over the last
+600 seconds, whereby
+the temporal interval of the profiles entering the average has to be
+10 s: dt_dopr = 900.0 s , averaging_interval_pr
+=
+600.0 s , dt_averaging_input_pr =
+10.0 s. The temperature
+profile including the initial temperature profile (therefore '#pt' ),
+the subgrid scale, resolved and total vertical sensible heat flux as
+well as the variances of the vertical velocity and the potential
+temperature are to be output: data_output_pr
+= '#pt' ,
+'w"pt”',
+'w*pt*', 'wpt', 'w*2', 'pt*2' .
If the data output format for
+graphic software profil
+is selected (see data_output_format ),
+the temperature
+profile and the individual variances are to be drawn into independent
+coordinate systems, and in contrast to this all heat flux profiles are
+to
+be
+drawn into the same system: cross_profiles = 'pt' ,
+'w"pt"w*pt*wpt', 'w*2', 'pt*2' . The legend of the x
+axes of these systems is set to cross_xtext = 'pot.
+temperature in K', 'heat flux in K ms>->1', 'velocity
+variance
+in m>2s>->2', 'temperature variance in K>2' .
+The profiles are to be drawn up to a height level of z_max_do1d
+=
+1500.0 m .
+Before starting the model
+on the parallel computer, the number of processing elements must be
+specified. Since relatively few grid points are used for
+this run, choosing of e.g. 8 PEs is sufficient. By default, a 1d domain
+decomposition along x is used on the IBM-Regatta, which means that a
+virtual processor topology (grid) of 8*1 (x*y) is used. (Note: the user may
+adjust this
+default domain decomposition with the help of the parameters npex
+and npey ).
+
Provided that the
+parameters
+file described above are set within the file
+~/palm/current_version/JOBS/example/INPUT/example_p3d and that the conditions
+mentioned in the
+first sections of chapter
+3.2 are met, the model run can be started with the command
+mrun
+-d example -h ibmh -K parallel -X 8 -T 8 -t 1800 -q cdev -r
+“d3# xy# xz# pr#”
+The output files will appear
+in the
+directories
+~/palm/current_version/JOBS/example/MONITORING ~/palm/current_version/JOBS/example/OUTPUT
+,
+while the job protocol will
+appear in
+directory ~/ job_queue .
+
+
+
Last change:
+ $Id$
+
+
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.4.2.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.4.2.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.4.2.html (revision 141)
@@ -0,0 +1,183 @@
+
+
+PALM chapter 4.4
+
+
+4.4.2 A parameter set for ocean runs
+... to be completed ...
In this chapter a brief,
+simple and
+complete parameter set is described, which can be used to carry out a
+model run. The presented example is available via example
+file and can be used (together with the configuration
+file described in chapter
+3.2) for the execution of a simple model run.
+This run simulates a
+quasi-stationary,
+convective, atmospheric boundary layer with zero
+mean horizontal
+wind. For evaluation purposes, cross sections and
+horizontally averaged vertical
+profiles of typical boundary layer variables
+are output at the end of the run. The run shall be carried out in
+batch mode on the IBM Regatta "hanni" of the HLRN.
+The parameter file necessary
+to carry
+out a run must be provided to the model as an input file under the
+local name PARIN
+and has the following contents:
+&inipar nx = 39 , ny = 39 , nz = 40 , dx = 50.0 , dy = 50.0 , dz = 50.0 , dz_stretch_level = 1200.0 , fft_method = 'temperton-algorithm' , initializing_actions = 'set_constant_profiles' , ug_surface = 0.0 , vg_surface = 0.0 , pt_vertical_gradient = 0.0 , 1.0 , pt_vertical_gradient_level = 0.0 , 800.0 , surface_heatflux = 0.1 , bc_pt_b = 'neumann' ,/ &d3par end_time = 3600.0 , create_disturbances = .T. , dt_disturb = 150.0 , disturbance_energy_limit = 0.01 , dt_run_control = 0.0 , data_output = 'w_xy' , 'w_xz' , 'w_xz_av' , 'pt_xy' , 'pt_xz' , dt_data_output = 900.0 , dt_data_output_av = 1800.0 , averaging_interval = 900.0 , dt_averaging_input = 10.0 , section_xy = 2 , 10 , section_xz = 20 , data_output_2d_on_each_pe = .F. , dt_dopr = 900.0 , averaging_interval_pr = 600.0 , dt_averaging_input_pr = 10.0 , data_output_pr = '#pt' , 'w”pt”' , 'w*pt*' , 'wpt' , 'w*2' , 'pt*2' , cross_profiles = ' pt ' , ' w"pt" w*pt* wpt ' , ' w*2 ' , ' pt*2 ' , cross_xtext = 'pot. temperature in K' , 'heat flux in K ms>->1' , 'velocity variance in m>2s>->2' , 'temperature variance in K>2' , z_max_do1d = 1500.0 , /
+The initialization
+parameters (&inipar )
+are located at the beginning of the file. For analysis of a
+convective boundary layer of approx. 1000 m thickness the horizontal
+size of the model domain should amount to at least 2 km x 2 km. In
+order to resolve the convective structures a grid spacing of dx
+=
+dy = dz = 50 m
+is enough, since the typical
+diameter of convective plumes is more than 100 m. Thereby the
+upper array index in the two horizontal directions needs to be nx
+= ny = 39 . Since in
+each case the lower array index has the value 0, 40 grid points are
+used along both horizontal directions. In the vertical
+direction
+the domain must be high enough to include the entrainment processes at
+the top of the boundary layer as well as the propagation of gravity
+waves, which were stimulated by
+the convection. However, in the stably stratified region the grid
+resolution has not necessarily to be as high as within the boundary
+layer. This can be obtained by a vertical stretching of the grid
+starting
+from 1200 m via dz_stretch_level = 1200.0
+m. This saves
+grid points and computing time. T he
+upper boundary of the model is located at (see dz_stretch_factor )
+… m (computed by the model) .
Fast Fourier transformations are
+calculated using the Temperton-algorithm, which -on the IBM Regatta- is
+faster than the default system-specific algorithm (from IBM essl
+library).
The
+initial profiles for
+wind and temperature can be assigned via initializing_actions
+= 'set_constant_profiles' .
+The wind speed, constant with
+height, amounts to ug_surface = vg_surface
+= 0.0 m/s . In order
+to allow for a fast onset of convection, a neutral stratified layer up
+to z
+= 800 m capped by an inversion with dtheta/dz = 1K/100 m is given:
+pt_vertical_gradient = 0.0, 1.0 ,
+pt_vertical_gradient_level = 0.0, 800.0.
+The surface
+temperature, which by default amounts to 300 K, provides the fixed
+point for the temperature profile (see pt_surface ).
+Convection is driven by a given, near-surface sensible heat flux via surface_heatflux
+= 0.1 K m/s. A given surface sensible heta flux
+requires the
+bottom boundary condition for potential temperature to be bc_pt_b
+=
+'neumann' .
+Thus
+all initialization parameters are determined. These can not be
+changed during the run (also not for restart runs).
+Now the run parameters (&d3par )
+must be specified. To produce a quasi stationary boundary layer the
+simulated time should be at least one hour, i.e. end_time
+= 3600
+s. To stimulate convection, the initially homogeneous (zero)
+wind
+field must be disturbed (create_disturbances = .T. ).
+These perturbations should be repeated in a temporal interval of
+dt_disturb = 150.0 s until the
+energy of the
+perturbations exceeds the value disturbance_energy_limit
+= 0.01
+m2 /s2 . After
+each time step run time
+informations (e.g. size of the timestep, maximum velocities, etc.) are
+to be written to the local file RUN_CONTROL
+(dt_run_control = 0.0 s ).
Instantaneous cross section data
+of vertical velocity (w )
+and potential temperature (pt )
+are to be output for horizontal (xy )
+and vertical (xz )
+cross sections, and additionally, time averaged (av ) vertical cross
+section data are to be output for the vertical velocity: data_output = 'w_xy' , 'w_xz' , 'w_xz_av' , 'pt_xy' , 'pt_xz' . Output of
+instantaneous (time averaged) data is done after each 900 (1800)s: dt_data_output = 900.0 , dt_data_output_av = 1800.0 . The
+averaged data are time averaged over the last 900.0 s, where the
+temporal interval of data entering the average is 10 s: averaging_interval =
+900.0 , dt_averaging_input =
+10.0 .
+Horizontal cross sections are output for vertical levels with grid
+index k=2 and k=10, vertical cross sections are output for index j=20: section_xy = 2 , 10 , section_xz = 20 . For runs on
+more than one processor, cross section data are collected and output on
+PE0: data_output_2d_on_each_pe
+= .F. .
Output
+of vertical profiles is to be done after each 900 s. The profiles shall
+be temporally averaged over the last
+600 seconds, whereby
+the temporal interval of the profiles entering the average has to be
+10 s: dt_dopr = 900.0 s , averaging_interval_pr
+=
+600.0 s , dt_averaging_input_pr =
+10.0 s. The temperature
+profile including the initial temperature profile (therefore '#pt' ),
+the subgrid scale, resolved and total vertical sensible heat flux as
+well as the variances of the vertical velocity and the potential
+temperature are to be output: data_output_pr
+= '#pt' ,
+'w"pt”',
+'w*pt*', 'wpt', 'w*2', 'pt*2' .
If the data output format for
+graphic software profil
+is selected (see data_output_format ),
+the temperature
+profile and the individual variances are to be drawn into independent
+coordinate systems, and in contrast to this all heat flux profiles are
+to
+be
+drawn into the same system: cross_profiles = 'pt' ,
+'w"pt"w*pt*wpt', 'w*2', 'pt*2' . The legend of the x
+axes of these systems is set to cross_xtext = 'pot.
+temperature in K', 'heat flux in K ms>->1', 'velocity
+variance
+in m>2s>->2', 'temperature variance in K>2' .
+The profiles are to be drawn up to a height level of z_max_do1d
+=
+1500.0 m .
+Before starting the model
+on the parallel computer, the number of processing elements must be
+specified. Since relatively few grid points are used for
+this run, choosing of e.g. 8 PEs is sufficient. By default, a 1d domain
+decomposition along x is used on the IBM-Regatta, which means that a
+virtual processor topology (grid) of 8*1 (x*y) is used. (Note: the user may
+adjust this
+default domain decomposition with the help of the parameters npex
+and npey ).
+
Provided that the
+parameters
+file described above are set within the file
+~/palm/current_version/JOBS/example/INPUT/example_p3d and that the conditions
+mentioned in the
+first sections of chapter
+3.2 are met, the model run can be started with the command
+mrun
+-d example -h ibmh -K parallel -X 8 -T 8 -t 1800 -q cdev -r
+“d3# xy# xz# pr#”
+The output files will appear
+in the
+directories
+~/palm/current_version/JOBS/example/MONITORING ~/palm/current_version/JOBS/example/OUTPUT
+,
+while the job protocol will
+appear in
+directory ~/ job_queue .
+
+
+
Last change:
+ $Id$
+
+
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.4.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.4.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.4.html (revision 141)
@@ -0,0 +1,29 @@
+
+
+PALM chapter 4.4
+
+
+4.4 Examples of
+parameter sets
+This chapter gives examples of complete
+parameter sets for a variety of model runs. These parameter files can
+be found in the directory trunk/INSTALL and can be used together with the mrun configuration file (.mrun.config ) to carry out the respective model runs.
For
+a description of the basic parameter settings which are generally
+required, see chapter 4.4.1, which explains the settings for a simple
+run of a quasi-stationary,
+convective, atmospheric boundary layer with zero
+mean horizontal
+wind.
+All other examples only explain those settings which are specific for
+the respective runs (e.g. only the specific ocean parameters are
+described in the parameter set for simulating ocean convection).
+
+
Last change:
+ $Id$
+
+
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.5.1.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.5.1.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.5.1.html (revision 141)
@@ -0,0 +1,476 @@
+
+
+PALM chapter 4.5.1
+
+
+4.5.1
+NetCDF data output
+The standard data output of
+PALM is NetCDF (Net work
+C ommon D ata F orm). NetCDF is an
+interface to a library of data access functions for
+storing and retrieving data in the form of arrays. NetCDF is an
+abstraction that supports a view of data as a collection of
+self-describing, portable
+objects that can be accessed through a simple interface (protable means
+that NetCDF data files can be read on any machine regardless of where
+they
+have been created). Array values may be accessed directly, without
+knowing details of how the data are stored. Auxiliary information about
+the data, such as what units are used, may be stored with the data.
+Generic utilities and application programs can access NetCDF datasets
+(files) and transform, combine, analyze, or display specified fields of
+the data, e.g. the contents of a NetCDF dataset can be viewed using the
+command ncdump
+(see further below ).
+Many (public domain) graphic software has built in interfaces to read
+NetCDF datasets (e.g. ferret
+or NCL ).
+The complete NetCDF documentation
+is available from the NetCDF
+homepage . The NetCDF tutorial for FORTRAN90 can also be found
+on our
+web server .
The
+output format of PALM data is determined by the runtime-parameter data_output_format
+(data_output_format
+= 'netcdf' ,
+by default). For historical reasons, some alternative formats can be
+selected (see data_output_format ).
+The accuracy of the NetCDF output data can be set with parameter netcdf_precision .
+By default, data have single (4 byte) precision. Also by default,
+NetCDF datasets (files) are not allowed to be larger than 2 GByte.
+Larger datasets can be created by setting netcdf_64bit
+= .TRUE. .
+These files then have the so-called 64bit-offset format. However,
+currently, many of the existing application programs may not support
+this 64-bit offset format.
PALM allows the output of
+various
+data (e.g. cross sections, vertical profiles, timeseries, etc.) into
+different files. The following table gives an overview about the
+different kind of NetCDF output data offered by PALM. Beside the local
+names of the files, the table also lists the minimum parameter settings
+which
+are necessary to switch on the output, as well as the parameters to be
+used to control the output.kind of data local filename parameter settings necessary to
+switch on output further
+parameters for output control vertical profiles DATA_1D_PR_NETCDF data_output_pr ,
+dt_data_output
+(or dt_dopr )averaging_interval ,
+(or averaging_interval_pr ),
+data_output_format ,
+dt_averaging_input ,
+dt_averaging_input_pr ,
+skip_time_data_output
+(or skip_time_dopr ),
+statistic_regions timeseries DATA_1D_TS_NETCDF dt_dots data_output_format ,
+statistic_regions spectra DATA_1D_SP_NETCDF comp_spectra_level ,
+data_output_sp ,
+dt_data_output
+(or dt_dosp ),
+spectra_direction averaging_interval (or
+averaging_interval_sp ),
+data_output_format ,
+dt_averaging_input_pr ,
+skip_time_data_output
+(or skip_time_dosp) 2d cross section (xy) DATA_2D_XY_NETCDF data_output
+(or data_output_user ),
+dt_data_output
+(or dt_do2d_xy ),
+section_xy data_output_format ,
+data_output_2d_on_each_pe ,
+do2d_at_begin ,
+skip_time_data_output
+(or skip_time_do2d_xy )2d cross section (xy),
+time-averaged DATA_2D_XY_AV_NETCDF data_output
+(or data_output_user ),
+dt_data_output
+(or dt_data_output_av or
+dt_do2d_xy ),
+section_xy averaging_interval ,
+dt_averaging_input ,
+data_output_format ,
+data_output_2d_on_each_pe ,
+do2d_at_begin ,
+skip_time_data_output
+(or skip_time_data_output_av ,
+or skip_time_do2d_xy )2d cross section (xz) DATA_2D_XZ_NETCDF data_output
+(or data_output_user ),
+dt_data_output
+(or dt_do2d_xz ),
+section_xz data_output_format ,
+data_output_2d_on_each_pe ,
+do2d_at_begin ,
+skip_time_data_output
+(or skip_time_do2d_xz )2d cross section (xz),
+time-averaged DATA_2D_XZ_AV_NETCDF data_output
+(or data_output_user ),
+dt_data_output
+(or dt_data_output_av or
+dt_do2d_xz ),
+section_xz averaging_interval ,
+dt_averaging_input ,
+data_output_format ,
+data_output_2d_on_each_pe ,
+do2d_at_begin ,
+skip_time_data_output
+(or skip_time_data_output_av ,
+or skip_time_do2d_xz )2d cross section (yz) DATA_2D_YZ_NETCDF data_output
+(or data_output_user ),
+dt_data_output
+(or dt_do2d_yz ),
+section_yz data_output_format ,
+data_output_2d_on_each_pe ,
+do2d_at_begin ,
+skip_time_data_output
+(or skip_time_do2d_yz )2d cross section (yz),
+time-averaged DATA_2D_YZ_AV_NETCDF data_output
+(or data_output_user ),
+dt_data_output
+(or dt_data_output_av or
+dt_do2d_yz ),
+section_yz averaging_interval ,
+dt_averaging_input ,
+data_output_format ,
+data_output_2d_on_each_pe ,
+do2d_at_begin ,
+skip_time_data_output
+(or skip_time_data_output_av ,
+or skip_time_do2d_yz )3d volume DATA_3D_NETCDF data_output
+(or data_output_user ),
+dt_data_output
+(or dt_do3d )data_output_format ,
+do3d_at_begin ,
+nz_do3d , skip_time_data_output
+(or skip_time_do3d )3d volume, time-averaged DATA_3D_AV_NETCDF data_output
+(or data_output_user ),
+dt_data_output
+(or dt_data_output_av or
+dt_do3d )averaging_interval ,
+dt_averaging_input ,
+data_output_format , do3d_at_begin ,
+nz_do3d , skip_time_data_output
+(or skip_time_data_output_av ,
+or skip_time_do3d )particle
+timeseries DATA_1D_PTS_NETCDF dt_data_output
+(or dt_dopts )particle attributes DATA_PRT_NETCDF dt_write_particle_data
Creating, contents and
+post-processing of a PALM NetCDF file This
+section describes, step-by-step, the creation, storage, and
+post-processing of PALM NetCDF datasets considering the output of 2d
+horizontal (xy) cross sections as example. The parameter settings
+described below are those of the example
+parameter file (see chapter
+4.4.1 ) so this parameter file can be used to retrace the
+following explanations.Output
+of xy cross
+sections requires to set at least three parameters: first, the temporal
+interval of the output time (run parameter dt_data_output
+or dt_do2d_xy) , second ,
+the names of the quantities for which cross section output is wanted (data_output ),
+and third, the position (height level given as gridpoint index) of the
+cross sections (section_xy ).
+The string '_xy'
+must be appended to the name strings assigned to data_output in
+either case. Output times
+cannot be defined
+directly but only via the output time interval, starting from the
+beginning of the initial 3d run (t=0, but no cross sections are
+written at the time t=0; exceptions see do2d_at_begin ).
+As an exception, the first output time can be set independently with
+parameter skip_time_data_output
+(or skip_time_do2d_xy ).Very important: If
+no values have been assigned to data_output , dt_data_output (or dt_do2d_xy ), and section_xy ,
+or
+if the values given for dt_data_output
+(or dt_do2d_xy ) or skip_time_data_output
+(or skip_time_do2d_xy )
+are
+larger than the simulated time (see end_time ),
+then there will be no output! For
+output of time-averaged data, the string '_av' has to be
+additionally appended to the respective name string (see data_output ).
+Instantaneous data are
+output in NetCDF
+format
+into the
+local file DATA_2D_XY_NETCDF .
+This file must be linked with a permanent file by
+using a file connection statement in the mrun
+configuration
+file (see e.g. chapter
+3.2 ). At the end of the run the local file is copied to this
+file. Such a statement can look like this:
+ DATA_2D_XY_NETCDF out:loc:tr xy#
+~/$fname/OUTPUT/$fname _xy nc . If
+the respective mrun call is
+like
+ mrun -d test -r “xy#” ... then the local
+file DATA_2D_XY_NETCDF
+is copied to the permanent file ~/test/OUTPUT/test/test_xy.nc
+ . However, the character string ' xy# ' activating the
+file connection statement (see third column of the
+statement) must be given in the mrun call as
+argument of the
+option -r (and/or -o). If
+t his is forgotten by mistake, the model outputs the data
+to
+the local file, but this is not copied to the permanent file and thus
+the data are not available for the user after the run has finished. The
+last (6th) column of the file connection statement, which defines the
+additional file suffix, should be the string 'nc' , because many
+application programs expect NetCDF files to have the file extension '.nc' . (This
+additional suffix given in the 6th column is always put at the very end
+of the filename, even
+in case of cycle numbers.) Time averaged data are
+output into local file DATA_2D_XY_AV_NETCDF
+which requires an additional file connection statement
+DATA_2D_XY_AV_NETCDF out:loc:tr xy#
+~/$fname/OUTPUT/$fname _xy_av nc .
With
+parallel runs and choice of data_output_2d_on_each_pe
+= .T.
+each PE outputs the data of its subdomain
+not directly to the NetCDF file but to a separate file with the name
+PLOT2D_XY_<processor-Id>,
+where <processor-Id> is a four digit number (e.g.
+PLOT2D_XY_0000). These files have FORTRAN binary format. After PALM has
+finished, their content is merged into the final local destination file
+DATA_2D_XY_NETCDF by the program combine_plot_fields . This is done by
+adding the following output command to the configuration file: OC:[[$
+( echo $localhost | cut -c1-3 ) = imbh ]] &&
+combine_plot_fields.x . Using
+this call, possibly existing
+files of the other cross sections (xz, yz) and of 3d volume data are
+also merged to their respective NetCDF files. The tool writes
+informative messages about the actions accomplished into the job
+protocol, even if no files were found (i.e. the output command
+may remain in the configuration file, even if no appropriate files
+are created during the simulation). The contents of a NetCDF dataset can
+be simply analyzed with the tool ncdump
+(which is part of the NetCDF software). It can be used to display the
+dimension (coordinate) names and lengths; variable names, types, and
+shapes; attribute names and values; and optionally, the values
+of
+data for all variables or selected variables in a netCDF dataset. The
+file content (without displaying the gridpoint data of the quantities)
+can be displayed with the command ncdump
+-c <filename> . Usage
+of the ncdump
+command requires that the path to the NetCDF software is appropriately
+set. On the IMUK-Linux-cluster this path is set by default, on the
+HLRN-IBM-Regatta, the user has to execute the command module
+load netcdf . Please
+refer to the system documentation or system administrator on
+how
+to setup the correct NetCDF path on the respective host. An
+example how to interpret the ncdump -output
+will be given further below .There
+are several application programs which can be used for graphical
+display of NetCDF datasets. One of the easiest ways to display the PALM
+data is the ferret
+graphical user interface (GUI). On the IMUK-Linux-cluster, this can be
+called by
+executing the command ferret
+-gui . ferret is also
+available at HLRN .
+Another possible tool is ncview ,
+which is also available at HLRN (see the HLRN
+documentation ). Beside these general tools, the PALM group
+will develop a graphical interface based on NCL
+(NCAR Command Language). This interface will be specially
+designed
+to display the PALM Data. A detailed documentation will be linked here
+as soon as available. One
+of the most flexible general ways for postprocessing NetCDF data
+is reading these data into a FORTRAN program. The example program shows
+how to read 2d or 3d NetCDF datasets created by PALM. Compiling this
+program requires that the
+NetCDF library is installed (if neccessary, please ask your system
+administrator). Some compilation instructions are given in the header
+of the
+example program.By
+default, each PALM job creates its own NetCDF files. If permanent files
+with respective filenames are already existing then new files with
+higher cycle numbers will be created. However, in case of a job chain,
+it is possible to extend the NetCDF datasets created by the initial
+run with data from the restart run(s). As a result, data of
+all
+output times of the complete job chain are contained in one file and
+the number of data files to be handled by the user may be reduced
+significantly. To extend a NetCDF dataset (created by a
+previous run
+of a job chain) with data from the current run requires that this
+dataset must be provided as an INPUT file. This may be difficult in
+case that PALM is running on a remote host because typically the output
+data files from the previous run have been already transferred by mrun to the local
+workstation with a file connection statement like
+ DATA_2D_XY_NETCDF
+ out:loc:tr xy#:xyf
+ ~/palm/current_version/JOBS/$fname/OUTPUT
+ _xy nc and thus
+they are not available on the remote host any more. A
+workaround for solving this problem is to create an additional copy of
+the output file on the remote machine by adding the file connection
+statement
+DATA_2D_XY_NETCDF out:loc xy#:xyf
+~/palm/current_version/JOBS/$fname/OUTPUT _xy nc This
+additional copy can then be accessed from a restart job as an input
+file using the file connection statement
+DATA_2D_XY_NETCDF in:locopt xyf
+~/palm/current_version/JOBS/$fname/OUTPUT _xy nc Here
+the file attribut locopt
+(2nd column) guarantees that the job continues if a permanent file does
+not exist (e.g. in case of an initial run). Otherwise, the job would be
+aborted. Although the dataset created by the last run of a job
+chain
+will contain data from all selected time levels of the complete job
+chain, the main disadvantage of this workaround is that the datasets
+created by the remaining jobs (with lower cycle numbers) still exist
+and may consume large disc space. They have to be deleted "by hand" by
+the user on the local machine as well as on the remote
+machine because they only contain redundant data from the
+earlier
+time levels which are already contained in the dataset created
+by
+the last job of the job chain.Note: Extension
+of PALM NetCDF datasets of 2d horizontal cross sections requires that
+parameters data_output
+and section_xy
+for the restart runs are set identical to the initial run. In case of a
+value mismatch between initial and restart runs, a warning is issued in
+the job protocol file and the dataset will contain only data from those
+timelevels calculated within the restart run. Similar
+restrictions apply for all other PALM NetCDF datasets (i.e. profiles,
+vertical cross sections, volume data, etc.). Example
+of a PALM NetCDF dataset The
+NetCDF dataset described here contains data of instantaneous horizontal
+cross sections and has been created using the settings of the example
+parameter file (see chapter
+4.4.1 ),
+i.e. it contains section data of the w-velocity-component and of the
+potential temperature for vertical grid levels with index k = 2 and k = 10 ,
+selected by the respective parameter settings data_output = 'w_xy' , 'pt_xy' , and section_xy = 2 , 10 . Output has been
+created after every 900 s (dt_data_output
+= 900.0 ).
+Because of end_time
+= 3600.0 ,
+the file contains data of 4 time levels (t = 900, 1800, 2700, 3600 s). Supposed
+that the name of the NetCDF dataset is example_xy.nc ,
+an analysis of the file contents using the command ncdump
+-c example_xy.nc will create the
+following output. The original ncdump output is displayed using fixed spacing ,
+additional explanations are given in italian .netcdf example_xy {
+
+ ! filename dimensions:
+
+
+ !
+41 gridpoints along x and y, 4 timelevels
+time = UNLIMITED ; // (4 currently) ! unlimited means
+that additional time levels can be added (e.g. by
+
+
+
+
+ ! restart jobs)
+zu_xy = 2 ;
+
+ !
+vertical dimension (2, because two cross sections are selected);
+zw_xy = 2 ;
+
+ !
+there are two different vertical dimensions zu and zw because due
+zu1_xy = 1 ;
+
+ !
+to the staggered grid the z-levels of variables are those of the
+x = 41 ;
+
+ ! u- or the w-component of the
+velocity
+y = 41 ; variables:
+
+
+ !
+precision, dimensions, and units of the variables
+double time(time) ;
+ ! the variables containing the
+time levels and grid point coordinates
+ time:units = "seconds" ;
+ ! have the same names as the
+respective dimensions
+double zu_xy(zu_xy) ;
+ zu_xy:units = "meters" ;
+double zw_xy(zw_xy) ;
+ zw_xy:units = "meters" ;
+double zu1_xy(zu1_xy) ;
+ zu1_xy:units = "meters" ;
+double ind_z_xy(zu_xy) ;
+ ind_z_xy:units = "gridpoints" ;
+double x(x) ;
+ x:units = "meters" ;
+double y(y) ;
+ y:units = "meters" ;
+float w_xy(time, zw_xy, y, x) ;
+ ! array of the
+vertical velocity; it has 4 dimensions: x and y,
+ w_xy:long_name = "w_xy" ;
+ ! because it is a horizontal
+cross section, zw_xy, which defines
+ w_xy:units = "m/s" ;
+ ! the vertical levels of the
+sections, and time, for the time levels
+float pt_xy(time, zu_xy, y, x) ; ! array of the potential
+temperature, which is defined on the u-grid
+ pt_xy:long_name = "pt_xy" ;
+ pt_xy:units = "K" ; // global attributes:
+ :Conventions = "COARDS" ;
+ :title = "PALM
+3.0 run:
+example.00 host: ibmh 13-04-06 15:12:43" ;
+ ! PALM
+run-identifier
+ :VAR_LIST = ";w_xy;pt_xy;" ;
+ !
+the list of output quantities contained in this dataset;
+
+
+
+
+ ! this global
+attribute can be used by FORTRAN programs to identify
+
+
+
+
+ ! and read the
+quantities contained in the file data: time = 905.3,
+1808.98, 2711.98, 3603.59 ; !
+values of the four time levels zu_xy = 75, 475 ;
+
+ ! heights of the two selected
+cross sections (u-grid) zw_xy = 100, 500 ; zu1_xy = 25 ; x = 0, 50, 100,
+150, 200, 250, 300, 350, 400, 450, 500, 550, 600, 650, 700, ! x-coordinates of the gridpoints
+750, 800, 850, 900, 950, 1000, 1050, 1100, 1150, 1200, 1250, 1300,
+1350,
+1400, 1450, 1500, 1550, 1600, 1650, 1700, 1750, 1800, 1850, 1900, 1950,
+
+2000 ; y = 0, 50, 100,
+150, 200, 250, 300, 350, 400, 450, 500, 550, 600, 650, 700,
+750, 800, 850, 900, 950, 1000, 1050, 1100, 1150, 1200, 1250, 1300,
+1350,
+1400, 1450, 1500, 1550, 1600, 1650, 1700, 1750, 1800, 1850, 1900, 1950,
+
+2000 ; }
If
+the option -c
+is omitted in the ncdump
+call, then also the complete grid point data of all quantities are
+output to the terminal. The example program shows how to read
+this 2d
+horizontal cross section dataset from a FORTRAN program (see above ).
+
Last
+change: $Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.5.2.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.5.2.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.5.2.html (revision 141)
@@ -0,0 +1,186 @@
+
+
+PALM chapter 4.5.2
+
+4.5.2
+Plots of vertical
+profiles with profil
+Output of vertical
+profile data is enabled by providing values for the run parameters dt_dopr
+and data_output_pr
+which specify the
+temporal
+interval of the output times (in s) and the quantities for which output
+is to be made. Output times cannot be defined
+directly but only via the output time interval, starting from the
+beginning of the initial 3d run (t=0, but no profiles are
+written at the time t=0; exceptions see data_output_pr ).
+By default, vertical profiles represent an instantaneous horizontal
+average of the
+total model domain at the respective output time. Temporal averaging
+can be initiated with
+the run parameter averaging_interval_pr .
+Beyond that, an output of profiles for user-defined subdomains is
+possible via the
+initialization parameter statistic_regions .
+Output of desired profiles
+(temperature,
+velocity, etc.) is steered with the run parameter data_output_pr .
+If this parameter is not set by the user, then, independently of the
+value of dt_dopr , there will be no output! PALM
+creates the local file PLOT1D_DATA ,
+which must be linked with a permanent file (see e.g. chapter
+3.2 ) via a file connection statement in the mrun
+configuration file. At the end of the run the local file is copied
+to this file. Such a statement can look like this:
+PLOT1D_DATA out:loc:tr pr ~/PLOT/$fname _pr_in.
+If the respective mrun
+call is
+like
+
mrun -d test -r “pr” …
+then the local file
+ PLOT1D_DATA
+ is copied to the permanent file ~/PLOT/test/test_pr_in .
+However, the character string “ pr ”
+activating the file connection statement (see third column of the
+statement) must
+be given in the mrun
+call as argument of the
+option -r (and/or -o). If t his is
+forgotten by mistake, the model outputs the data to the local file, but
+this is
+not copied to the permanent file and thus the data are not available
+for the user after the run has finished.
+The created data file can be
+directly used as input file for the plot software profil .
+profil needs another file, the so-called parameter
+file, which
+specifies the plot layout. This file is created by PALM under the local
+name PLOT1D_PAR
+and also needs a file connection statement, e.g.:
+PLOT1D_PAR out:loc:tr pr ~/PLOT/$fname _pr_par.
+If you are in the directory
+~/PLOT/test , the
+data can be plotted by entering
+profil -d test_pr_in -p test_pr_par
+The default plot layout as
+specified in the parameter file is as follows: the profiles of the
+different quantities are plottet into
+one or more coordinate systems (panels). Every profile is plotted only
+once,
+however several profiles of different quantities can be plottet into
+the same panel. If case of this, the different quantities are
+marked by different styles of lines. Which variables
+are drawn into which coordinate system is specified by the user via
+the run parameter cross_profiles .
+It is very important to note that only profiles are plottet, which are
+assigned to
+a coordinate system via cross_profiles . If a
+certain
+variable is selected by data_output_pr but not
+assigned to a coordinate
+system via cross_profiles , then the appropriate
+profile data
+are written to the file PLOT1D_DATA but they are not plotted! All
+panels for which data
+exist are plotted. For example, if only the profiles of the potential
+temperature are
+to be plottet in a panel but output of potential temperature is not set
+via
+data_output_pr , then the respective panel is not
+drawn
+(thus no 'empty' panels appear in the plot). The
+parameters profile_columns
+and profile_rows
+determine how the panels are arranged in columns and rows. The panels
+are plotted in the order given by data_output_pr
+starting in the top row from left to right.
+If the number of panels to be plotted is larger than the
+product profile_columns * profile_rows ,
+then the plot
+is continued on a second page.
+During a model run output of
+profiles to
+file PLOT1D_DATA is usually carried out for several times (as
+determined by dt_dopr ).
+All of these profiles belonging to the same quantity are plotted in the
+same panel. The different output times are marked by different line
+colors. All profiles of a certain output time have the
+same color, even if they are plotted into different panels. Beyond
+that, a legend entry is made for each, containing the name of the
+respective quantity and the output time.
+This legend string is taken from file PLOT1D_DATA
+in which a comment line is placed ahead of each profile data.
+For identification, each
+plot is
+provided with a title, which contains the model version number, the
+run identifier (base file name + number of the restart run), the name
+of the host where the run was executed, the date and time of the
+beginning
+of the run as well as the averaging domain (by default: 'total
+domain' ). If the profiles are additionally temporally
+averaged,
+each panel gets an appropriate sub-label ('time
+averaged over… s' ). The axes labels of the x
+axes of the
+individual panels are specified with the run parameter
+cross_xtext ,
+the y axes always have the label 'height
+in m' . For better
+comparison, the profiles can be normalized with respect to different
+quantities
+(see cross_normalized_x
+and cross_normalized_y ).
+The respective normalization is noted in the axes label.
+As
+already
+mentioned, the profiles of a quantity
+for all output times are plotted into the same panel. This is not
+possible if a simulation needs restart runs, since the restart runs
+write the
+profile data to separate files (with appropriate cycle numbers) and
+create own parameter files. Thus by default profiles can only be drawn
+separately for each respective run. However there is a possibility to
+plot
+all profiles of a quantity in one plot, regardless of the number of
+restart runs. For this
+purpose the configuration file must be changed such that for restart
+runs the profile data are appended to already existing
+data (thus all data are output into one file). Then the
+configuration file has two entries for PLOT1D_DATA :
+
PLOT1D_DATA out:loc:tr pr# ~/PLOT/$fname _pr_in PLOT1D_DATA out:loc:tra prf ~/PLOT/$fname _pr_in.
+The first run of
+the job chain is now
+mrun - D test - r “pr#…
+For the restart runs, the
+"#" in the mrun
+call is automatically replaced by an "f". At the end of the job chain
+there will only be one data file containing the complete profile data.
+The file connection statement for the parameter file
+PLOT1D_PAR has not changed,
+thus a new cycle of
+the respective permanent file is created for each run. To plot
+the combined data with the parameter file created by the last run of
+the job chain, the run parameter
+use_prior_plot1d_parameters
+= .TRUE. must be additionally set for the restart
+runs. If this
+is
+forgotten, the parameter file is useless and the data cannot
+be plotted.
+The default layout of the
+plots of
+vertical profiles can be changed by editing the
+parameter file. For a detailed description of the profil parameters
+see the
+profil
+manual (only in German).
+
+
+Last
+change: $Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.5.3.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.5.3.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.5.3.html (revision 141)
@@ -0,0 +1,17 @@
+
+
+PALM
+chapter 4.5.3
+4.5.3
+Plots of time
+series
+with profil Sorry, this feature isn't supported
+any more.
+
+ Last
+change: $Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.5.4.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.5.4.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.5.4.html (revision 141)
@@ -0,0 +1,159 @@
+
+
+PALM
+chapter 4.5.4
+
+4.5.4
+Plots of 2d cross
+sections with iso2d
+PALM permits simultaneous
+output xy, xz
+and
+yz cross sections. Since the output of all three cross section plots is
+steered in the same way, only the creation of xy plots is described.
+Output of xy cross
+sections requires to set at least two parameters: first, the temporal
+interval of the output time (run parameter dt_do2d_xy)
+and second
+the names of the quantities for which cross section output is wanted (data_output ).
+The string '_xy'
+must be appended to these name strings in either case. Output times
+cannot be defined
+directly but only via the output time interval, starting from the
+beginning of the initial 3d run (t=0, but no cross sections are
+written at the time t=0; exceptions see do2d_at_begin ).
+The exact location (height level) of the cross
+section(s) can be defined with run parameter section_xy .
+If no values have been assigned to data_output and section_xy
+or
+if the value given for dt_do2d_xy is
+larger than the simulated time (see end_time ),
+then there will be no output!
+
Data is output in
+binary format
+into the
+local file PLOT2D_XY .
+This file must be linked with a permanent file by
+using a file connection statement in the mrun
+configuration
+file (see e.g. chapter
+3.2 ). At the end of the run the local file is copied to this
+file. Such a statement can look like this:
+PLOT2D_XY out:loc:tr pxy ~/PLOT/$fname _pxy_in.
+If the respective mrun
+call is
+like
+mrun -d test -r “pxy”…
+then the local file PLOT2D_XY
+is copied to the permanent file ~/PLOT/test/test_pxy_in
+ . However, the character string “ pxy ”
+activating the file connection statement (see third column of the
+statement) must be given in the mrun call as
+argument of the
+option -r (and/or -o). If
+t his is forgotten by mistake, the model outputs the data
+to
+the local file, but this is not copied to the permanent file and thus
+the data are not available for the user after the run has finished.
+The created data file can be
+directly used as input file for the plot software iso2d .
+However, this requires the user to assign data_output_2d_on_each_pe
+= .FALSE. (see also at the end of this chapter) . iso2d
+needs another file, the so-called parameter file, which specifies the
+plot
+layout. This file contains a
+so-called global parameter set which applies to all plots as well as
+a local parameter set which is valid for each individual plot. These
+global and
+local parameter sets are also created by PALM and output into two
+different local files named PLOT2D_XY_GLOBAL
+and PLOT2D_XY_LOCAL .
+These must be combined to one file via a so-called output
+command in the configuration file. The resulting file also
+needs a
+file connection statement:
+OC: [[ -f PLOT2D_XY_GLOBAL]] && cat PLOT2D_XY_LOCAL >> PLOT2D_XY_GLOBAL PLOT2D_XY_GLOBAL out:loc:tr pxy ~/PLOT/$fname _pxy_par.
+The output command (corn
+shell syntax)
+tests whether the file PLOT2D_XY_GLOBAL
+exists and if so the file PLOT2D_XY_LOCAL
+is appended via the "cat" command to the file PLOT2D_XY_GLOBAL
+which then contains all parameters needed by iso2d .
+This
+relatively pedantic proceeding is due to the fact that PALM
+can produce the file PLOT2D_XY_GLOBAL only at the end of the simulation
+(when the final value of the global iso2d -parameter
+planz
+is known), while the local parameter sets are written continuously
+to the file PLOT2D_XY_LOCAL during the run. A consequence is, that in
+case of aborts of a run the file PLOT2D_XY_GLOBAL
+has possibly not been created and thus a visualization of the data -
+although they may be available - is
+not possible (in such a case, the user may create the parameter file
+manually).
+If you are in the directory ~/PLOT/test ,
+the data
+can be plotted by entering
+
iso2d -d test _pxy_in -p test_pxy_par
+By default plot
+layout as specified in
+the parameter file is as follows: for each cross section of each
+individual quantity a seperate plot is created using isolines. Isolines
+with negative values are displayed in
+red color. The axes do not have labels and the units are [m]. For
+identification, each plot is
+provided with a title, which contains the model version number, the
+run identifier (base file name + number of the restart run), the name
+of the host where the run was executed, and the date and time of the
+beginning
+of the run. Furthermore each plot carries a
+caption where the name of the displayed quantity, the output time
+(starting from
+beginning of the 3d simulation, t=0) and the location of the cross
+sections (as height level and grid point number) is noted.
+The layout of the plots can
+be
+varied by editing the parameter file (according to the
+various features of iso2d : color shading,
+vector plots, streamlines, etc.). For a detailed description of the iso2d parameters see
+the
+iso2d
+manual (only in German).
+With parallel runs and
+choice of data_output_2d_on_each_pe
+= .T. each PE outputs the data of its subdomain
+to a separate file with the name
+PLOT2D_XY_<processor-Id>,
+whereby <processor-Id> is a four digit number (e.g.
+PLOT2D_XY_0000). These files are not suitable for iso2d , but after the
+end
+of a run they can be combined to one file readable by iso2d . This is done
+via a
+further output command in the configuration file:
+OC:[[$ ( echo $localhost | cut -c1-3 ) = imbh ]] && combine_plot_fields.x
+The program combine_plot_fields.x
+collects the data from the individual processor files and outputs it
+into the local file PLOT2D_XY
+which can be processed by iso2d .
+Using this call, possibly existing
+files of the other cross sections (xz, yz) and of 3d volume data are
+also combined. The tool writes
+informative messages about the actions accomplished into the job
+protocol, even if no files were found (i.e. the output command
+may remain in the configuration file, even if no appropriate files
+are created during the simulation).
+ Note: due to internal
+restrictions of iso2d the file PLOT2D_XY
+may not contain more than 99 cross sections. This restriction does not
+apply
+for the production of video clips via iso2d .
+
+
+
Last
+change:
+$Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.5.5.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.5.5.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.5.5.html (revision 141)
@@ -0,0 +1,167 @@
+
+
+PALM
+chapter 4.5.5
+
+4.5.5
+Plots of 3d volume
+data with AVS
+In contrast to the plot
+output described
+so far, which can be handled more or less automatically, the creation
+of
+plots with AVS requires programming a so-called
+network by
+using the AVS
+network editor
+to design the plot
+layout. Details are not given here because it is assumed that the user
+is familiar with AVS .
+Output
+of 3d volume
+data requires to set at least two parameters: first, the
+temporal
+interval of the output time (run parameter dt_do3d)
+and second
+the names of the quantities for which volume data output is wanted (data_output ). The
+parameter nz_do3d
+can be used to limit data output in vertical direction up to a certain
+grid
+point. If no value has been assigned to data_output
+or
+if the value given for dt_do3d is
+larger than the simulated time (see end_time ),
+then there will be no output! By default, data is
+output in
+32-bit real format. Alternatively, for parallel runs, data can also be
+output in compressed format using 32-bit integers. This yields
+a loss of accuracy, but the file size is clearly reduced. The output of
+compressed data is described in more detail in chapter
+4.5.6 .
+Data, whether compressed or
+uncompressed, is output into the local file PLOT3D_DATA .
+This file must be linked with a permanent file by
+using a file connection statement in the mrun
+configuration
+file (see e.g. chapter
+3.2 ). At the end of the run the local file is copied to this
+file. Additionally, mrun creates a file containing some coordinate
+informations about the 3d data, which also has to be copied. The
+statements can look like this:
+PLOT3D_DATA out:loc:tr avs ~/PLOT/$fname _avs PLOT3D_COOR out:loc:tr avs ~/PLOT/$fname _coor .
+If the respective mrun
+call is
+like
+mrun -d test -r “avs”…
+then the local file PLOT3D_DATA
+is copied to the permanent file ~/PLOT/test/test_avs
+.
+However, the character string “avs ”
+activating the file connection staement (see third column of the
+statement) must be given in the mrun call as
+argument of the
+option -r (and/or -o). If
+t his
+is forgotten by mistake, the model outputs the data to the local
+file, but this is not copied to the permanent file and thus the data
+are not available for the user after the run has finished.
+
The created data
+file can be used as
+input file for the plot software AVS
+although for parallel runs another step is necessary which is
+described at the end of this chapter. However, after starting AVS
+(by executing the command “avs”), these data file
+is not read
+immediately. First, the user has to
+load a
+suitable network (created by the
+network editor). This module usually contains the module
+“read
+field”, which requires an input
+file in the so-called "fld-format", which in turn refers to the two
+files
+specified above (containing the volume data and coordinate
+informations) and describes their exact structure. This fld file is
+also generated by PALM by creating two different
+local files with the names PLOT3D_FLD
+and PLOT3D_FLD_COOR ,
+which must be combined into one file by a so-called output
+command :
+OC:[[ -f PLOT3D_FLD ]] && cat PLOT3D_FLD_COOR >> PLOT3D_FLD
+The new file PLOT3D_FLD also
+needs a file
+connection statement:
+PLOT3D_FLD out:loc:tr avs ~/PLOT/$fname _fld fld
+The above mrun call
+then copies the local file PLOT3D_FLD
+to the permanent file ~/PLOT/test/test_fld.fld
+. In
+this case the entry
+“fld ”
+in the sixth column of the file connection statement is
+very important because this ensures that the permanent file name gets
+the suffix ” .fld
+". The AVS
+module “read field” expects all files to have this
+suffix. (Note: With
+this file
+connection statements files with cycle numbers receive the names
+”…
+_fld.<number of cycle>.fld
+ ".)
+The
+file
+connection statements must guarantee that all three permanent files
+(volume
+data, coordinates, fld file) lie in the same directory. The names of
+the volume data file and coordinate file may not be changed after
+creation of the files, since they are registered in the fld file and
+otherwise cannot be found by the "read field" module.
+Sometimes
+it may happen
+that incorrect file names are registered into the fld file. In such
+cases the user must edit and correct the fld file accordingly.
+
After
+the AVS
+module “read
+fields” has read in the data, the
+content of this
+file is listed in a separate AVS
+window where each quantity is represented by its name and output time.
+
With
+parallel runs each PE outputs the
+volume data of its subdomain to a separate file with the name
+PLOT3D_DATA_<processor-Id>,
+whereby <processor-Id> is a four digit number (e.g.
+PLOT3D_DATA_0000). These files are not suitable for AVS ,
+but after the end of a run they can be combined to one file readable by
+AVS . This is
+done via a
+further output command in the configuration file:
+OC:[[$ ( echo $localhost | cut -c1-3 ) = ibmh ]] && combine_plot_fields.x
+The program combine_plot_fields.x
+collects the data from the individual processor files and outputs it
+into the local file PLOT2D_DATA
+which can be processed by AVS .
+Using this call, possibly existing
+files of 2d cross sections (xy, xz, yz) are
+also combined. The tool writes
+informative messages about the actions accomplished into the job
+protocol, even if no files were found (i.e. the output command
+may remain in the configuration file, even if no appropriate files
+are created during the simulation).
+
Note:
+AVS can
+process 64 arrays at maximum
+in one file (with vector representations even
+only 25). If more arrays should be output, surplus arrays must be
+removed from the fld file (see PLOT3D_FLD )
+manually.
+
+
Last
+change: $Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.5.6.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.5.6.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.5.6.html (revision 141)
@@ -0,0 +1,90 @@
+
+
+PALM
+chapter 4.5.6
+
+4.5.6
+Plots of compressed
+3d volume data with AVS
+Files containing 3d volume
+data usually
+need large amounts of disc space. For parallel runs, the disc space
+requirement can
+be clearly reduced if the data are output in compressed format (note:
+currently a data
+compression is permitted only for parallel runs on Cray-T3E). Data
+compression
+can switched on by setting the initialization parameter do3d_compress
+= .TRUE. and by assigning the desired accuracy
+(number of
+significant digits) via do3d_precision .
+A separate accuracy must be assigned for each individual quantity.
+Using uncompressed data, each grid point value is
+represented by a 32-bit real number, in case of compression the grid
+point values are represented by integers whose length depends
+on the desired accuracy (in general clearly smaller than 32 bits).
+The individual grid point values are packed into 32-bit integers and
+output. To plot these compressed data the following output command must
+be inserted into the
+mrun
+configuration file (in
+addition to the steps described
+in chapter
+4.5.5 ):
+OC:[[ -f PLOT3D_COMPRESSED ]] && tar cf PLOT3D_DATA PLOT3D_DATA_*
+If a file named PLOT3D_COMPRESSED
+exists in the local working directory, t he
+files produ ced by the individual processors are packed
+into one
+file (PLOT3D_DATA )
+using the "tar"
+command. The flag file
+PLOT3D_COMPRESSED is
+created by PALM
+whenever data in compressed form is to be output. For
+uncompressed output, the individual files have to be joined via the
+program combine_plot_fields.x
+ . In this case, an additional output command is also
+necessary
+(see chapter 4.5.5). For compressed output, this output command may
+remain
+unchanged in the configuration file, since combine_plot_fields.x
+recognizes the
+existen ce of PLOT3D_COMPRESSED
+and carries out no actions in such cases.
+The file connection
+statements for the
+local file PLOT3D_DATA
+and all further necessary statements to create plots of 3d volume
+data can be found in chapter
+4.5.5 .
+After been transferred to
+the local
+computer
+of the user, the tar file with the compressed data cannot be read
+with the usual AVS
+module
+“read field”. Alternatively,
+the module “read_compressed_field” particularly
+developed
+for this purpose must be used. This module is located in a module
+library under:
+http://www.muk.uni-hannover.de/~raasch/PALM_group/AVS/Libraries/palm This module must be loaded within
+AVS
+(network editor - > module
+tools - > read module library) and then it can be used like all
+other modules. Further
+information about using this module is available (e.g. for
+accelerated treatment of compressed data with AVS the module
+write_compressed_field
+is available).
+
+
+
+
Last
+change: $Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.5.7.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.5.7.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.5.7.html (revision 141)
@@ -0,0 +1,90 @@
+
+
+PALM
+chapter 4.5.7
+
+4.5.7
+Plots of
+isosurfaces, 2d cross sections and particles with dvrp
+The dvrp
+software developed by the RRZN
+(Stephan Olbrich, Carsten Chmielewski) allows a creation of plot
+sequences with PALM,
+which can be animated via a special plugin for internet browsers. With
+suitable graphic hardware even stereoscopic views are
+possible.
+In contrast to the other kinds of visualization output realized
+in PALM (profil , iso2d and AVS ),
+where the data
+is output in a format suitable for the plot software, the creation of
+plots via dvrp
+software is
+integrated in PALM, i.e. respective routines are directly called within
+the PALM code. The
+dvrp
+routines then output the
+graphic data
+(so-called plot-primitives, e.g. polygones of isosurfaces) in a special
+dvr format. Since the dvrp
+software is parallelized (i.e. each PE calculates the graphic data for
+its subdomain), the visualization of simulations with very
+large numbers of grid points is possible (which so far failed because
+of
+several problems: volume of the raw data, which rapidly may sum-up to
+several Terabytes; main memory size needed for graphic workstations, on
+which the visualization is to be carried out; the insufficient scalar
+(!)
+computing speed of commercial graphic software in case of such
+large numbers of grid points).
+The coupling of dvrp software and
+PALM
+as well as the visualization of the model results via dvrp has been
+the main focus of the BMBF project "Application of
+tele-immersion in long-distance networks" (2001-2002),
+which was a joint project of RRZN, ZIB and IMUK. This work is currently
+continued by RRZN in the new DFG-funded project "EVITA - Untersuchung
+effizienter
+ Methoden zur visuellen und haptischen tele-immersiven
+Exploration
+ komplexer Volumen- und Strömungsdaten aus
+parallelisierten,
+ dynamischen 3D-Simulationen" (2005-2007).
+The calls of the dvrp routines are
+contained within a
+PALM software package (see chapter 3.7 ).
+To use this package, the additional option -p
+“dvrp_graphics”
+has to be given in the mrun call. This
+automatically links the
+required libraries.
+Steering of the plot output is done via the package
+parameters (see chapter 4.2 ).
+In contrast to all other PALM output, dvrp
+graphic
+data are not output to local files but directly to a special remote
+computer which is defined via the package parameter dvrp_host .
+The
+default values of the dvrp parameters are cause the output to be
+directed to a so-called streaming server at the
+RRZN. Apart from graphic data an additional html file is created, which
+can be used by an internet browser to view the data (a special dvrp plugin is
+needed).
+Since July 2001, the basic
+functionality
+of the dvrp
+software is
+installed in PALM and steerable via the
+package parameters. However, some code modifications may still need to
+be done by the user (e.g. in
+the subroutine plot_dvrp
+in order to define suitable color tables).
+ For further detailed information please ask Siegfried Raasch.
+
+
+
Last
+change: $Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.5.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.5.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.5.html (revision 141)
@@ -0,0 +1,67 @@
+
+
+PALM chapter 4.5
+4.5 Data analysis and
+visualization
+ PALM is able to
+output
+data of different quantities as time series,
+vertical profiles (usually horizontally averaged), two-dimensional
+cross sections or 3d-volume data.
+Depending on the kind of output (time series, profiles, etc.) and the
+output format (ASCII or binary) data are written
+to different files (file descriptions can be found in
+chapter
+3.4 ). By default, all data
+output files are in NetCDF format (link to the NetCDF documentations in
+the Internet and on the PALM homepage), which can be processed by many
+public domain and commercial (graphic) software. Data from NetCDF files
+can also be easily read from FORTRAN programs provided that a NetCDF
+library is available. More detailed informations about the
+PALM-NetCDF-output is given in the next subchapter (4.5.1 ).
+Due to historical reasons,
+PALM can also
+output data in other formats suitable for some special graphic
+software. The exact format of these files corresponds to the
+requirements of the respective software. Still available at IMUK are profil
+(time series, profiles), iso2d
+(2d cross sections) and AVS (e.g. iso-surfaces of
+3d volume
+data). The special files created by PALM can be directly used
+as input files for these plot programs. Beyond that, profil
+and
+iso2d need additional information
+about the plot layout (e.g. titles, axes labels, arrangement of the
+coordinate systems, etc.) provided by so-called parameter files.
+ Thes e
+files are also created by
+the PALM, providing a default layout (e.g. plots produced by iso2d
+show. only isolines and no color shading). Within certain
+limits the plot layout can be steered by some PALM parameters.
+Beyond that the user can edit the parameter files created by PALM and
+change, supplement or remove the given default values
+according to his needs. Beside the file with the (binary) data to be
+visualized, AVS additionally needs a file with
+coordinate information (likewise binary) and an ASCII file in the
+so-called FLD format, which describes the structure of the two binary
+files. Coordinate and FLD file are also created by the PALM. However,
+with AVS (differently than with profile
+or iso2d )
+the plot layout must always be additionally designed by the user
+with the help of the AVS network editor.
+In the following
+subchapters, steering
+of the different data output and how to create plots of the data is
+described by some examples. Not all details of steering
+are mentioned. If necessary, these can be found within the
+description of the respective parameters.
+
For most purposes it should be sufficient to read chapter 4.5.1
+which explains the PALM-NetCDF-output.
+
+ Last
+change: $Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_4.6.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_4.6.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_4.6.html (revision 141)
@@ -0,0 +1,11820 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ PALM chapter 4.6
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+4.6
+Listing of the steering parameters in alphabetical order
+
+
+
+
+
+
+Initialization
+parameters
+(class = I),
+run parameters (R), package parameters (P) as well as user-defined
+parameters (U) are alphabetically listed in the following table.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Parameter name
+
+
+
+
+
+
+
+
+ Class
+
+
+
+
+
+
+
+
+
+ Type
+
+
+
+
+
+
+
+
+ Default
+
+
+
+value
+
+
+
+
+
+
+
+
+ Explanation
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ adjust_mixing_length
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+ Near-surface
+adjustment of the
+mixing length to the Prandtl-layer law.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ alpha_surface
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Inclination
+of the model domain
+with respect to the horizontal (in degrees).
+
+
+
+
+
+
+
+
+
+
+
+
+ averaging_interval
+
+
+
+ R
+
+
+ R
+
+
+ 0.0
+
+
+ Averaging
+interval for all output of temporally averaged data (in s).
+
+
+
+
+
+
+
+
+
+
+
+
+ averaging_interval_pr
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value of averaging_
+
+
+
+interval
+
+
+
+Averaging interval for vertical profiles output to local
+file DATA_1D_PR_NETCDF
+ and/or PLOT1D_DATA
+(in s).
+
+
+
+
+
+
+
+
+
+
+
+ averaging_interval_sp
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value of averaging_
+
+
+
+interval
+
+
+ Averaging
+interval for spectra output to local
+file DATA_1D_SP_NETCDF
+ and/or PLOTSP_X_DATA
+/ PLOTSP_Y_DATA
+(in s).
+
+
+
+
+
+
+
+
+
+
+
+ bc_e_b
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 20
+
+
+
+
+
+
+
+
+ 'neumann'
+
+
+
+
+
+
+
+
+
+ Bottom boundary condition of the
+TKE.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_lr
+
+
+
+ I
+
+
+
+
+
+
+ C * 20
+
+
+
+
+
+
+ ´cyclic´
+
+
+
+
+
+
+ Boundary
+condition along x (for all quantities).
+
+
+
+
+
+
+
+
+
+ bc_ns
+
+
+
+ I
+
+
+
+
+
+
+ C * 20
+
+
+ 'cyclic'
+
+
+
+ Boundary
+condition along y (for all quantities).
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_p_b
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 20
+
+
+
+
+
+
+
+
+ 'neumann'
+
+
+
+
+
+
+
+
+
+ Bottom boundary condition of the
+perturbation pressure.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_p_t
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 20
+
+
+
+
+
+
+
+
+ 'dirichlet'
+
+
+
+
+
+
+
+
+
+ Top boundary condition of the
+perturbation pressure.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_par_b
+
+
+
+ P
+
+
+
+
+
+
+ C*15
+
+
+ ´reflect´
+
+
+
+
+
+
+ Bottom
+boundary condition for particle transport.
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_par_lr
+
+
+
+ P
+
+
+
+
+
+
+ C*15
+
+
+ ´cyclic´
+
+
+
+ Lateral boundary
+condition
+(x-direction) for particle
+transport.
+
+
+
+
+
+
+
+
+ bc_par_ns
+
+
+
+ P
+
+
+
+
+
+
+ C*15
+
+
+ ´cyclic´
+
+
+
+ Lateral boundary
+condition
+(y-direction) for particle
+transport.
+
+
+
+
+
+
+
+
+ bc_par_t
+
+
+
+ P
+
+
+
+
+
+
+ C*15
+
+
+ ´absorb´
+
+
+
+ Top boundary
+condition for
+particle transport.
+
+
+
+
+
+
+
+
+
+
+
+ bc_pt_b
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 20
+
+
+
+
+
+
+
+
+ 'dirichlet'
+
+
+
+
+
+
+
+
+
+ Bottom boundary condition of the
+potential temperature.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_pt_t
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 20
+
+
+
+
+
+
+
+
+ 'initial_gradient'
+
+
+
+
+
+
+
+
+
+ Top boundary condition of the
+potential temperature.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_q_b
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 20
+
+
+
+
+
+
+
+
+ 'dirichlet'
+
+
+
+
+
+
+
+
+
+ Bottom boundary condition of the
+specific humidity / total water content.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_q_t
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 20
+
+
+
+
+
+
+
+
+ 'neumann'
+
+
+
+
+
+
+
+
+
+ Top boundary condition of the
+specific humidity / total water content.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_s_b
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 20
+
+
+
+
+
+
+
+
+ 'dirichlet'
+
+
+
+
+
+
+
+
+
+ Bottom boundary condition of the
+scalar concentration.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_s_t
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 20
+
+
+
+
+
+
+
+
+ ´neumann´
+
+
+
+
+
+
+
+
+
+ Top boundary condition of the
+scalar concentration.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_sa_t
+
+
+ I
+
+
+ C * 20
+
+
+ 'neumann'
+
+
+ Top boundary condition of the salinity.
+
+
+
+
+
+
+
+
+
+
+
+ bc_uv_b
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 20
+
+
+
+
+
+
+
+
+ 'dirichlet'
+
+
+
+
+
+
+
+
+
+ Bottom boundary condition of the horizontal wind
+components u
+and v.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ bc_uv_t
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 20
+
+
+
+
+
+
+
+
+ 'dirichlet'
+
+
+
+
+
+
+
+
+
+ Top boundary condition of the
+horizontal velocity components u and v.
+
+
+
+
+
+
+
+
+
+
+
+
+ bottom_salinityflux
+
+
+ I
+
+
+ R
+
+
+ 0.0
+
+
+ Kinematic salinity flux near the surface (in psu m/s).
+
+
+
+
+
+
+
+
+ building_height
+
+
+
+ I
+
+
+ R
+
+
+ 50.0
+
+
+ Height
+of a single building in m.
+
+
+
+
+
+
+
+
+ building_length_x
+
+
+
+ I
+
+
+ R
+
+
+ 50.0
+
+
+ Width
+of a single building in m.
+
+
+
+
+
+
+
+
+ building_length_y
+
+
+
+ I
+
+
+ R
+
+
+ 50.0
+
+
+ Depth
+of a single building in m.
+
+
+
+
+
+
+
+
+ building_wall_left
+
+
+
+ I
+
+
+ R
+
+
+ building centered in x-direction
+
+
+
+ x-coordinate of the
+left building wall in m.
+
+
+
+
+
+
+
+
+ building_wall_south
+
+
+
+ I
+
+
+ R
+
+
+ building centered in y-direction
+
+
+
+ y-coordinate of the
+South building wall in m.
+
+
+
+
+
+
+
+
+ call_psolver_at_all_substeps
+
+
+
+ R
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+ .T..
+
+
+
+
+
+
+ Switch
+to steer the call of the pressure solver.
+
+
+
+
+
+ canopy_mode I C * 20 'block' Canopy mode
+
+
+
+ cfl_factor
+
+
+
+ R
+
+
+ R
+
+
+ 0.1,
+0.8 or 0.9 (see parameter description)
+
+
+ Time
+step limiting factor.
+
+
+
+
+
+
+
+
+ cloud_droplets
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+ L
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+ Parameter to switch
+on usage of cloud droplets.
+
+
+
+
+
+
+
+
+
+
+
+ cloud_physics
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+ Parameter
+to switch on the condensation scheme.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ comp_spectra_level
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ I
+(10)
+
+
+
+
+
+
+
+
+ no level
+
+
+
+
+
+
+
+
+
+ Vertical level for which horizontal spectra are to be
+calculated and output (gridpoints).
+
+
+
+
+
+
+
+
+
+
+
+
+ conserve_volume_flow
+
+
+
+ I
+
+
+ L
+
+
+ .F.
+
+
+ Conservation
+of volume flow in x- and y-direction.
+
+
+
+
+
+
+
+
+
+
+
+
+ create_disturbances
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .T.
+
+
+
+
+
+
+
+
+ Switch
+to impose random perturbations to the horizontal
+velocity field.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ cross_normalized_x
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ C
+* 10 (100)
+
+
+
+
+
+
+
+
+ 100
+* ' '
+
+
+
+
+
+
+
+
+ Type
+of normalization applied to the x-coordinate of
+vertical
+profiles to be plotted with profil .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ cross_normalized_y
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ C
+* 10
+
+
+
+(100)
+
+
+
+
+
+
+
+
+ 100 * ' '
+
+
+
+
+
+
+
+
+
+ Type of normalization applied to the y-coordinate of
+vertical
+profiles to be plotted with profil .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ cross_profiles
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ C
+* 100 (100)
+
+
+
+
+
+
+
+
+ see
+parameter description
+
+
+
+
+
+
+
+
+ Determines
+which vertical profiles are to be presented
+in
+which coordinate system if the plot software profil is
+used.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ cross_xtext
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ C
+* 40
+
+
+
+ (100)
+
+
+
+
+
+
+
+
+ see
+parameter description
+
+
+
+
+
+
+
+
+ x-axis
+labels of vertical profile coordinate systems to
+be
+plotted with profil .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ cut_spline_overshoot
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .T.
+
+
+
+
+
+
+
+
+ Cut
+off of so-called overshoots, which can occur with
+the upstream-spline-scheme.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ cycle_mg
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ C
+* 1
+
+
+
+
+
+
+
+
+ 'w'
+
+
+
+
+
+
+ Type
+of cycle to
+be used with the multi-grid
+method.
+
+
+
+
+
+
+
+
+
+
+
+ damp_level_1d
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ zu(nz+1)
+
+
+
+
+
+
+
+
+ Height
+where the damping layer begins in the 1d-model
+(in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ data_output
+
+
+
+ R
+
+
+ C * 10 (100)
+
+
+ 100 * ´ ´
+
+
+
+ Quantities for which 2d cross section and/or 3d volume data
+are to be output.
+
+
+
+
+
+
+
+
+ data_output_format
+
+
+
+ R
+
+
+ C * 10 (10)
+
+
+ 'netcdf'
+
+
+
+ Format of output data.
+
+
+
+
+
+
+
+
+ data_output_pr
+
+
+
+ R
+
+
+ C * 10 (100)
+
+
+ 100 * ' '
+
+
+
+ Quantities for which vertical profiles (horizontally
+averaged)
+are to be output.
+
+
+
+
+
+
+
+
+ data_output_pr_user
+
+
+ U
+
+
+ C * 10
+
+
+(200)
+
+
+ 200 * ' '
+
+
+ User defined quantities for which horizontally averaged profile data is to be output.
+
+
+
+
+
+
+
+
+ data_output_sp
+
+
+
+ P
+
+
+ C * 10 (10)
+
+
+ 10 * ' '
+
+
+
+ Quantities for which horizontal spectra are to be calculated
+and output.
+
+
+
+
+
+
+
+
+ data_output_user
+
+
+
+ U
+
+
+ C * 10 (100)
+
+
+ 100 * ' '
+
+
+
+ User defined quantities for which 2d cross section and/or 3d
+volume data are to be output.
+
+
+
+
+
+
+
+
+ data_output_2d_on_each_pe
+
+
+
+ R
+
+
+ L
+
+
+ .T.
+
+
+ Output
+2d cross section data by one or
+all processors.
+
+
+
+
+
+
+
+
+
+
+
+
+ density_ratio
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+(10)
+
+
+
+
+
+
+
+
+ 0.0, 9 * 9999999.9
+
+
+
+
+
+
+
+
+
+ Ratio of the density of the fluid and the density of the
+particles.
+
+
+
+
+
+
+
+
+
+
+
+ dissipation_1d
+
+
+
+ I
+
+
+ C * 20
+
+
+ 'as_in_3d_model'
+
+
+
+ Calculation method for the energy dissipation term in the TKE
+equation of the 1d-model.
+
+
+
+
+
+
+
+
+
+
+
+ disturbance
+
+
+
+ _amplitude
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.25
+
+
+
+
+
+
+
+
+ Maximum
+perturbation amplitude of the random
+perturbations
+imposed to the horizontal velocity field (in m/s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ disturbance_energy
+
+
+
+ _limit
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.01
+
+
+
+
+
+
+
+
+ Upper limit value of the
+perturbation energy of
+the velocity field used as a criterion for imposing random
+perturbations (in m2 /s2 ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ disturbance_level_b
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ zu(3) or zu(nz*2/3)
+
+
+
+
+
+
+
+
+ Lower
+limit of the vertical range for which random perturbations are to be
+imposed on the horizontal wind field ( in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ disturbance_level_t
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ zu(nz/3) or zu(nzt-3)
+
+
+
+
+
+
+
+
+ Upper
+limit of the vertical range for which random perturbations are to be
+imposed on the horizontal wind field ( in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ do2d_at_begin
+
+
+
+ R
+
+
+ L
+
+
+ .F.
+
+
+ Output
+2d cross section data by one or
+all processors.
+
+
+
+
+
+
+
+
+ do3d_at_begin
+
+
+
+ R
+
+
+ L
+
+
+ .F.
+
+
+ Output
+of 3d volume data at the beginning
+of a run.
+
+
+
+
+
+
+
+
+ do3d_compress
+
+
+
+ R
+
+
+ L
+
+
+ .F.
+
+
+ Output
+of data for 3d plots in compressed form.
+
+
+
+
+
+
+
+
+
+ do3d_precision
+
+
+
+ R
+
+
+ C * 7 (100)
+
+
+ see
+parameter description
+
+
+ Significant digits in case
+of compressed data output.
+
+
+
+
+
+ drag_coefficient I R 0.0 Drag coefficient used in the plant canopy model.
+
+
+
+
+
+
+ dt
+
+
+
+
+
+
+
+
+
+ I/R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ variable
+
+
+
+
+
+
+
+
+ Time
+step for the 3d-model ( in s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_averaging_input
+
+
+
+ R
+
+
+ R
+
+
+ 0.0
+
+
+ Temporal
+interval of data which are subject to temporal averaging (in
+s).
+
+
+
+
+
+
+
+
+
+
+
+ dt_averaging_input_pr
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value of dt_
+
+
+
+averaging_
+
+
+
+input
+
+
+ Temporal
+interval of data which are subject to temporal averaging of vertical
+profiles and/or spectra ( in s).
+
+
+
+
+
+
+
+
+
+ dt_coupling
+
+
+ R
+
+
+ R
+
+
+ 9999999.9
+
+
+ Temporal interval for the data exchange in case of runs with coupled models (e.g. atmosphere - ocean) (in s).
+
+
+
+
+
+
+
+
+ dt_data_output
+
+
+
+ R
+
+
+ R
+
+
+ 9999999.9
+
+
+
+
+
+
+ Temporal interval
+at which data (3d volume data (instantaneous or time
+averaged),
+cross sections (instantaneous or time averaged), vertical profiles,
+spectra) shall be output ( in s).
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_data_output_av
+
+
+
+ R
+
+
+ R
+
+
+ value
+of dt_data_
+
+
+
+output
+
+
+
+
+
+ Temporal
+interval
+at which time averaged 3d volume data and/or 2d cross section data
+shall be output ( in s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_disturb
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 9999999.9
+
+
+
+
+
+
+
+
+ Temporal interval at
+which random
+perturbations are to be imposed on the horizontal velocity field
+( in s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_dopr
+
+
+
+ R
+
+
+ R
+
+
+ value
+of dt_data_
+
+
+
+output
+
+
+ Temporal interval at
+which data of vertical profiles shall be output (to local
+file DATA_1D_PR_NETCDF
+or/and PLOT1D_DATA ) ( in
+ s).
+
+
+
+
+
+
+
+
+
+ dt_dopr_listing
+
+
+
+ R
+
+
+ R
+
+
+ 9999999.9
+
+
+
+
+
+
+ Temporal
+interval at which data of
+vertical
+profiles shall be output (output for printouts, local file LIST_PROFIL ) ( in
+ s).
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_dopts
+
+
+
+ P
+
+
+
+ R
+
+
+
+ value
+of dt_data_
+
+
+
+output
+
+
+
+
+
+ Temporal
+interval at which time series data of particle quantities
+shall be output ( in s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_dosp
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value
+of dt_data_
+
+
+
+output
+
+
+ Temporal
+interval at which spectra data shall be output
+(in s).
+
+
+
+
+
+
+
+
+
+
+
+ dt_dots
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ see parameter description
+
+
+
+
+
+
+
+
+ Temporal interval at
+which time series data shall be output ( in s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_do2d_xy
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value
+of dt_data_
+
+
+
+output
+
+
+
+
+
+ Temporal interval at
+which horizontal cross section data shall be output ( in s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_do2d_xz
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value
+of dt_data_
+
+
+
+output
+
+
+
+
+
+ Temporal interval at
+which vertical cross section data (xz) shall be output ( in
+ s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_do2d_yz
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value
+of dt_data_
+
+
+
+output
+
+
+
+
+
+ Temporal interval at
+which vertical cross section data (yz) shall be
+output ( in s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_do3d
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ value
+of dt_data_
+
+
+
+output
+
+
+
+
+
+ Temporal interval at
+which 3d volume data shall be output ( in s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_dvrp
+
+
+
+ P
+
+
+ R
+
+
+ 9999999.9
+
+
+
+ Temporal interval of scenes to be displayed with the dvrp software (in
+s).
+
+
+
+
+
+
+
+
+ dt_max
+
+
+ R
+
+
+ R
+
+
+ 20.0
+
+
+ Maximum
+allowed value of the timestep (in s).
+
+
+
+
+
+
+
+
+ dt_min_part
+
+
+
+ P
+
+
+
+ R
+
+
+
+ 0.0002
+
+
+ Minimum value
+for the particle timestep when SGS velocities are used (in s).
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_prel
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 9999999.9
+
+
+
+
+
+
+
+
+ Temporal
+interval at
+which particles are to be released from
+a particle
+source ( in s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_pr_1d
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 9999999.9
+
+
+
+
+
+
+
+
+ Temporal
+interval of vertical profile output of the
+1D-model
+(in s).
+
+
+
+
+
+
+
+
+
+
+
+ dt_restart
+
+
+
+ R
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ 9999999.9
+
+
+
+
+
+
+ Temporal
+interval at which a new
+restart run is to be carried out ( in s).
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_run_control
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 60.0
+
+
+
+
+
+
+
+
+ Temporal interval at
+which run control
+output is to be made ( in s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dt_run_control_1d
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 60.0
+
+
+
+
+
+
+
+
+ Temporal
+interval of runtime control output of the
+1d-model
+(in s).
+
+
+
+
+
+
+
+
+ dt_sort_particles P R 0.0 Temporal interval for sorting particles (in s).
+
+
+ dt_write_particle_data
+
+
+
+ P
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ 9999999.9
+
+
+
+ Temporal
+interval for output
+of particle data (in s).
+
+
+
+
+
+
+
+
+
+
+
+
+ dvrp_directory
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ C
+* 80
+
+
+
+
+
+
+
+
+ 'default'
+
+
+
+
+
+
+
+
+
+ Name of the directory into which data created by the dvrp
+software shall be saved.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dvrp_file
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ C
+* 80
+
+
+
+
+
+
+
+
+ 'default'
+
+
+
+
+
+
+
+
+
+ Name of the file into which data created by the dvrp software shall
+be output.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dvrp_host
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ C
+* 80
+
+
+
+
+
+
+
+
+ 'origin.rvs.
+
+
+
+uni- hanover.de'
+
+
+
+
+
+
+
+
+ Name
+of the computer to which data created by the dvrp software shall
+be
+transferred.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dvrp_output
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ C
+* 10
+
+
+
+
+
+
+
+
+ 'rtsp'
+
+
+
+
+
+
+
+
+
+ Output
+mode for the dvrp
+software.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dvrp_password
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ C
+* 80
+
+
+
+
+
+
+
+
+ '********'
+
+
+
+
+
+
+ Password
+for the
+computer to which data created
+by the dvrp
+software is to be
+transferred.
+
+
+
+
+
+
+
+
+
+
+
+ dvrp_psize
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.2 * dx
+
+
+
+
+
+
+
+
+
+ Diameter
+that the particles is given in visualizations
+with
+the dvrp
+software (in
+m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dvrp_username
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ C
+* 80
+
+
+
+
+
+
+
+
+ no default value
+
+
+
+
+
+
+
+
+
+ User
+name of a valid account on the computer to which
+data
+created by the dvrp
+software
+is to be
+transferred.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dx
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 1.0
+
+
+
+
+
+
+
+
+ Horizontal
+grid spacing along the x-direction (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dy
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 1.0
+
+
+
+
+
+
+
+
+ Horizontal
+grid spacing along the y-direction (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dz
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ no default, see parameter description
+
+
+
+
+
+
+
+
+
+ Vertical
+grid spacing (in m).
+
+
+
+
+
+
+
+
+
+
+
+ dz_max
+
+
+
+ I
+
+
+
+ R
+
+
+
+ 9999999.9
+
+
+
+ Allowed
+maximum vertical grid spacing (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dz_stretch_factor
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 1.08
+
+
+
+
+
+
+
+
+ Stretch
+factor for a vertically stretched grid (see dz_stretch_level ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ dz_stretch_level
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 100000.0
+
+
+
+
+
+
+
+
+ Height
+level above/below which the grid is to be stretched
+vertically (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ e_init
+
+
+ I
+
+
+ R
+
+
+ 0.0
+
+
+ Initial TKE in m2 s-2 .
+
+
+
+
+
+
+
+
+
+ e_min
+
+
+
+ I
+
+
+ R
+
+
+ 0.0
+
+
+
+ Minimum TKE in m2 s-2 .
+
+
+
+
+
+
+
+
+
+
+
+
+ end_time
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Simulation
+time of the 3D
+model ( in s) .
+
+
+
+
+
+
+
+
+
+
+
+
+ end_time_prel
+
+
+
+ P
+
+
+
+ R
+
+
+
+ 9999999.9
+
+
+
+ Time of
+the last release of particles (in s).
+
+
+
+
+
+
+
+
+
+
+
+
+ end_time_1d
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 864000.0
+
+
+
+
+
+
+
+
+ Time
+to be simulated for the 1D-model (in s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ fft_method
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 20
+
+
+
+
+
+
+
+
+ 'system specific'
+
+
+
+
+
+
+
+
+
+ FFT-method to be used.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ force_print_header
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+ Steering
+of header output to the local file RUN_CONTROL .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ galilei_transformation
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+ Application
+of a Galilei-transformation to the
+coordinate
+system of the model.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ grid_matching
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 6
+
+
+
+
+
+
+
+
+ 'match'
+
+
+
+
+
+
+
+
+
+ Variable
+to adjust the subdomain sizes in parallel runs.
+
+
+
+
+
+
+
+
+
+
+
+
+ humidity
+
+
+ I
+
+
+ L
+
+
+ .F.
+
+
+ Parameter
+to switch on the prognostic equation for
+specific
+humidity q.
+
+
+
+
+
+
+
+
+ inflow_disturbance_begin
+
+
+
+ I
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+ MIN(10,
+
+
+ nx/2 or ny/2)
+
+
+
+ Lower
+limit of the horizontal range for which random perturbations are to be
+imposed on the horizontal velocity field (gridpoints).
+
+
+
+
+
+
+
+
+
+ inflow_disturbance_end
+
+
+
+ I
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+ MIN(100,
+
+
+ 3/4*nx or
+
+
+ 3/4*ny)
+
+
+ Upper
+limit of the horizontal range for which random perturbations are
+to be imposed on the horizontal velocity field (gridpoints).
+
+
+
+
+
+
+
+
+
+
+
+
+ initializing_actions
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 100
+
+
+
+
+
+
+
+
+ no default, see parameter description
+
+
+
+
+
+
+
+
+
+ Initialization
+actions
+to be carried out.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ initial_weighting_factor
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+ R
+
+
+
+
+
+ 1.0
+
+
+
+
+
+
+ Factor to define
+the real number of initial droplets in a grid cell.
+
+
+
+
+
+
+
+
+
+
+
+
+ km_constant
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ variable (computed from TKE)
+
+
+
+
+
+
+
+
+
+ Constant
+eddy diffusivities are used (laminar
+simulations).
+
+
+
+
+
+
+
+
+
+
+
+
+ km_damp_max
+
+
+
+ I
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ 0.5*(dx
+or dy)
+
+
+ Maximum
+diffusivity used for filtering the velocity field in the vicinity of
+the outflow (in m2 /s).
+
+
+
+
+
+ lad_surface I R 0.0 Surface value of the leaf area density (in m2 /m3 ) lad_vertical_gradient I R (10) 10 * 0.0 Gradient(s) of the leaf area density (in m2 /m4 ) lad_vertical_gradient_level I R (10) 10 * 0.0 Height level from which on the gradient
+of the leaf area density defined by lad_vertical_gradient_level
+is effective (in m).
+
+
+
+
+
+
+ long_filter_factor
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Filter
+factor for the so-called Long-filter.
+
+
+
+
+
+
+
+
+
+
+
+
+ loop_optimization
+
+
+ I
+
+
+ C * 16
+
+
+ see parameter description
+
+
+ Method used to optimize loops for solving the prognostic equations .
+
+
+
+
+
+
+
+
+
+
+
+ maximum_number_
+
+
+
+ of_particles
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+ 1000
+
+
+
+
+
+
+
+
+ Maximum
+number of particles (on a PE).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ maximum_number_
+
+
+
+ of_tailpoints
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+ 100
+
+
+
+
+
+
+
+
+ Maximum
+number of tailpoints that a particle tail can
+have.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ maximum_tailpoint_
+
+
+
+ age
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 100000.0
+
+
+
+
+
+
+
+
+ Maximum
+age that the end point of a particle tail is allowed to have (in s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mg_cycles
+
+
+
+ R
+
+
+ I
+
+
+ - 1
+
+
+
+ Number of cycles to be used with the multi-grid scheme.
+
+
+
+
+
+
+
+
+
+ mg_switch_to_pe0_level
+
+
+
+ R
+
+
+ I
+
+
+ see parameter
+description
+
+
+ Grid
+level at which data shall be gathered on PE0.
+
+
+
+
+
+
+
+
+
+
+
+
+ minimum_tailpoint_
+
+
+
+ distance
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Minimum
+distance allowed between two adjacent points of
+a
+particle tail (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ mixing_length_1d
+
+
+
+ I
+
+
+ C * 20
+
+
+ 'as_in_3d_model'
+
+
+
+ Mixing length used in the 1d-model.
+
+
+
+
+
+
+
+
+
+
+
+ mode_dvrp
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ C
+* 20 (10)
+
+
+
+
+
+
+
+
+ 10 * ' '
+
+
+
+
+
+
+
+
+
+ Graphical objects (isosurfaces, slicers, particles)
+which are
+to be created by the dvrp
+software.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ momentum_advec
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 10
+
+
+
+
+
+
+
+
+ 'pw-scheme '
+
+
+
+
+
+
+
+
+
+ Advection scheme to be used for the momentum equations.
+
+
+
+
+
+
+
+
+
+
+
+
+ netcdf_precision
+
+
+
+ I
+
+
+ C * 20 (10)
+
+
+ single preci sion for all
+
+
+ output quan tities
+
+
+ Defines
+the accuracy of the NetCDF output.
+
+
+
+
+
+
+
+
+
+
+
+
+ netcdf_64bit
+
+
+
+ R
+
+
+ L
+
+
+ .F.
+
+
+ All NetCDF files - except those containing 3d
+volume data - will have 64 bit offset format.
+
+
+
+
+
+
+
+
+ netcdf_64bit_3d
+
+
+ R
+
+
+ L
+
+
+ .T.
+
+
+ NetCDF
+files containing 3d volume data will have 64 bit offset format.
+
+
+
+
+
+
+
+
+
+
+
+ ngsrb
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+ 2
+
+
+
+
+
+
+
+
+ Grid
+level at which data shall be gathered on PE0.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ normalizing_region
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+ 0
+
+
+
+
+
+
+
+
+ Determines
+the subdomain from which the normalization
+quantities are calculated.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ npex
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+ no default, see parameter description
+
+
+
+
+
+
+
+
+ Number
+of processors along x-direction of the virtual
+processor
+net.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ npey
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+ no default, see parameter description
+
+
+
+
+
+
+
+
+ Number
+of processors along y-direction of the virtual
+processor
+net.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ nsor
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+ 20
+
+
+
+
+
+
+
+
+ Number
+of iterations to be used with the SOR-scheme.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ nsor_ini
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+ 100
+
+
+
+
+
+
+
+
+ Initial
+number of iterations with the SOR algorithm
+
+
+
+
+
+
+
+
+
+
+
+
+ number_of_particle_groups
+
+
+
+ P
+
+
+ I
+
+
+ 1
+
+
+ Number
+of particle groups to be used.
+
+
+
+
+
+
+
+
+
+
+
+ nx
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+ no default, see parameter description
+
+
+
+
+
+
+
+
+ Number
+of grid points in x-direction.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ny
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+ no default, see parameter description
+
+
+
+
+
+
+
+
+ Number
+of grid points in y-direction.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ nz
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+ no default, see parameter description
+
+
+
+
+
+
+
+
+ Number
+of grid points in z-direction.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ nz_do3d
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+ nz+1
+
+
+
+
+
+ Limits
+the output of 3d volume data along the vertical direction (grid point
+index k).
+
+
+
+
+
+
+
+
+ ocean
+
+
+ I
+
+
+ L
+
+
+ .F.
+
+
+ Parameter to switch on ocean runs.
+
+
+
+
+
+
+
+
+
+
+
+ omega
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 7.29212E-5
+
+
+
+
+
+
+
+
+ Angular
+velocity of the rotating system (in rad s-1 ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ omega_sor
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 1.8
+
+
+
+
+
+
+
+
+ Convergence
+factor to be used with the the SOR-scheme.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ outflow_damping_width
+
+
+
+ I
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+ MIN(20,
+nx/2 or ny/2)
+
+
+
+ Width of
+the damping range in the vicinity of the outflow (gridpoints).
+
+
+
+
+
+
+
+
+
+
+
+
+ overshoot_limit_e
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Allowed
+limit for the overshooting of subgrid-scale TKE
+in
+case that the upstream-spline scheme is switched on (in m2 /s2 ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ overshoot_limit_pt
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Allowed
+limit for the overshooting of potential
+temperature in
+case that the upstream-spline scheme is switched on (in K).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ overshoot_limit_u
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Allowed
+limit for the
+overshooting of
+the u-component of velocity in case that the upstream-spline scheme is
+switched on (in m/s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ overshoot_limit_v
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Allowed
+limit for the overshooting of the v-component of
+velocity in case that the upstream-spline scheme is switched on
+(in m/s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ overshoot_limit_w
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Allowed
+limit for the overshooting of the w-component of
+velocity in case that the upstream-spline scheme is switched on
+(in m/s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ particles_per_point
+
+
+
+ P
+
+
+
+ I
+
+
+
+ 1
+
+
+ Number of
+particles to be started per point.
+
+
+
+
+
+
+
+
+ particle_advection_start
+
+
+
+ P
+
+
+
+
+
+ R
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+ Time of the first
+release of
+particles (in s).
+
+
+
+
+
+
+
+
+
+
+
+ particle_maximum_age
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 9999999.9
+
+
+
+
+
+
+
+
+ Maximum
+allowed age of particles (in s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ passive_scalar
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+ Parameter
+to switch on the prognostic equation for a
+passive
+scalar.
+
+
+
+
+
+
+
+
+ pch_index I I
0 Grid point index (scalar) of the upper boundary of the plant canopy layer
+
+
+
+
+
+
+ pdx
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+(10)
+
+
+
+
+
+
+
+
+ 10 * dx
+
+
+
+
+
+
+
+
+
+ Distance
+along x between particles within a particle
+source
+(in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ pdy
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+(10)
+
+
+
+
+
+
+
+
+ 10 * dy
+
+
+
+
+
+
+
+
+
+ Distance
+along y between
+particles within a
+particle source (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ pdz
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+(10)
+
+
+
+
+
+
+
+
+ 10 * ( zu(2) - zu(1) )
+
+
+
+
+
+
+
+
+
+ Distance along z between
+particles within a particle source
+(in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ phi
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 55.0
+
+
+
+
+
+
+
+
+ Geographical
+latitude (in degrees).
+
+
+
+
+
+
+
+
+
+
+
+
+ plant_canopy I L .F. Parameter to switch on the plant canopy model
+
+
+
+
+
+ plot_spectra_level
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ I
+(10)
+
+
+
+
+
+
+
+
+ No level
+
+
+
+
+
+
+
+
+
+ Vertical level(s) for which horizontal spectra are to be
+plotted (in gridpoints).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ prandtl_layer
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .T.
+
+
+
+
+
+
+
+
+ Parameter
+to switch on a Prandtl layer.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ prandtl_number
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 1.0
+
+
+
+
+
+
+
+
+ Ratio
+of the eddy diffusivities for momentum and heat (Km /Kh ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ precipitation
+
+
+
+ I
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+ .F.
+
+
+ Parameter to
+switch on the
+precipitation scheme.
+
+
+
+
+
+
+
+
+ precipitation_amount_
+
+
+interval
+
+
+ R
+
+
+ R
+
+
+ value
+of dt_do2d_
+
+
+
+xy
+
+
+ Temporal
+interval for which the precipitation amount (in mm) shall be calculated and output ( in s).
+
+
+
+
+
+
+
+
+
+
+
+ profile_columns
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+ 3
+
+
+
+
+
+
+
+
+ Number
+of coordinate systems to be plotted
+in one row by profil .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ profile_rows
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+ 2
+
+
+
+
+
+
+
+
+ Number
+of rows of coordinate systems to be plotted on
+one page
+by profil .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ psb
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+(10)
+
+
+
+
+
+
+
+
+ 10 * zu(nz/2)
+
+
+
+
+
+
+
+
+
+ Bottom edge of a particle
+source (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ psl
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+(10)
+
+
+
+
+
+
+
+
+ 10 * 0.0
+
+
+
+
+
+
+
+
+
+ Left edge of a particle source
+(in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ psn
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+(10)
+
+
+
+
+
+
+
+
+ 10 * ( ny * dy )
+
+
+
+
+
+
+
+
+
+ Rear (“north”) edge of a particle
+source (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ psolver
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ C
+* 10
+
+
+
+
+
+
+
+
+ 'poisfft'
+
+
+
+
+
+
+
+
+
+ Scheme to be used to solve the Poisson equation for the
+perturbation pressure.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ psr
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+(10)
+
+
+
+
+
+
+
+
+ 10 * ( nx * dx )
+
+
+
+
+
+
+
+
+
+ Right edge of a particle source (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ pss
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+(10)
+
+
+
+
+
+
+
+
+ 10 * 0.0
+
+
+
+
+
+
+
+
+
+ Front (“south”) edge of a particle
+source (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ pst
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+(10)
+
+
+
+
+
+
+
+
+ 10 * zu(nz/2)
+
+
+
+
+
+
+
+
+
+ Top edge of a particle source (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+ pt_reference
+
+
+ I
+
+
+ R
+
+
+ use horizontal average as
+reference
+
+
+ Reference temperature to be
+used in all buoyancy terms (in K).
+
+
+
+
+
+
+
+
+
+
+
+ pt_surface
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 300.0
+
+
+
+
+
+
+
+
+ Surface
+potential temperature (in K).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ pt_surface_initial
+
+
+
+ _change
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+ Change
+in surface
+temperature to be made at the
+beginning of
+the 3d run
+(in K).
+
+
+
+
+
+
+
+
+
+
+
+ pt_vertical_gradient
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+(10)
+
+
+
+
+
+
+
+
+ 10 * 0.0
+
+
+
+
+
+
+
+
+
+ Temperature gradient(s) of the initial temperature
+profile (in
+K
+/ 100 m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ pt_vertical_gradient
+
+
+
+ _level
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+(10)
+
+
+
+
+
+
+
+
+ 10 * 0.0
+
+
+
+
+
+
+
+
+
+ Height level from which on the temperature gradient
+defined by pt_vertical_gradient
+is effective (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ q_surface
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Surface
+specific humidity / total water content (kg/kg).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ q_surface_initial
+
+
+
+ _change
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Change
+in surface specific humidity / total water
+content to
+be made at the beginning
+of the 3d run (kg/kg).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ q_vertical_gradient
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+(10)
+
+
+
+
+
+
+
+
+ 10 * 0.0
+
+
+
+
+
+
+
+
+
+ Humidity gradient(s) of the initial humidity profile
+(in 1/100 m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ q_vertical_gradient
+
+
+
+ _level
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+(10)
+
+
+
+
+
+
+
+
+ 10 * 0.0
+
+
+
+
+
+
+
+
+
+ Height level from which on the humidity gradient defined
+by q_vertical_gradient
+is effective (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ radiation
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+ Parameter
+to switch on longwave radiation cooling at
+cloud-tops.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ radius
+
+
+
+ P
+
+
+ R (10)
+
+
+ 0.0,
+9 *
+
+
+ 9999999.9
+
+
+ Particle
+radius (in m).
+
+
+
+
+
+
+
+
+
+
+
+ random_generator
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 20
+
+
+
+
+
+
+
+
+ 'numerical recipes'
+
+
+
+
+
+
+
+
+
+ Random number generator to be used for creating
+uniformly
+distributed random numbers.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ random_heatflux
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+ Parameter
+to impose random perturbations on the internal two-dimensional near
+surface heat flux field shf .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ random_start_position
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+ Initial position of the
+particles is
+varied randomly within certain limits.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ rayleigh_damping
+
+
+
+ _factor
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+and/or 0.01
+(see parameter description)
+
+
+
+
+
+
+
+
+ Factor
+for Rayleigh damping.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ rayleigh_damping
+
+
+
+ _height
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 2/3 * zu(nz)
+
+
+
+
+
+
+
+
+ Height where the Rayleigh damping starts (in
+m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ read_particles_from_
+
+
+
+ restartfile
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .T.
+
+
+
+
+
+
+
+
+ Read
+particle data from the previous run.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ region
+
+
+
+
+
+
+
+
+
+ U
+
+
+
+
+
+
+
+
+ C
+* 40 (0:9)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Name(s) of the subdomain(s) defined by the user.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ residual_limit
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 1.0E-6
+
+
+
+
+
+
+
+
+ Largest
+residual permitted for the multi-grid scheme (in
+s-2 m-3 ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ restart_time
+
+
+
+ R
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ 9999999.9
+
+
+
+
+
+
+ Simulated time
+after which a
+restart run is to be carried out
+(in s).
+
+
+
+
+
+
+
+
+
+
+
+ rif_max
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 1.0
+
+
+
+
+
+
+
+
+ Upper
+limit of the flux-Richardson number.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ rif_min
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ - 5.0
+
+
+
+
+
+
+
+
+ Lower
+limit of the flux-Richardson number.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ roughness_length
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.1
+
+
+
+
+
+
+
+
+ Roughness
+length (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ sa_surface
+
+
+ I
+
+
+ R
+
+
+ 35.0
+
+
+ Surface salinity (in psu).
+
+
+
+
+
+
+
+
+ sa_vertical_gradient
+
+
+ I
+
+
+ R(10)
+
+
+ 10 * 0.0
+
+
+ Salinity gradient(s) of the initial salinity profile (in psu
+/ 100 m).
+
+
+
+
+
+
+
+
+ sa_vertical_gradient_level
+
+
+ I
+
+
+ R(10)
+
+
+ 10 * 0.0
+
+
+ Height level from which on the salinity gradient defined by sa_vertical_gradient
+is effective (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+ scalar_advec
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 10
+
+
+
+
+
+
+
+
+ 'pw-scheme'
+
+
+
+
+
+
+
+
+
+ Advection scheme to be used for the scalar quantities.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ section_xy
+
+
+
+ R
+
+
+ I (100)
+
+
+ no section
+
+
+
+ Position
+of cross section(s) for output of 2d horizontal cross
+sections (grid point index k).
+
+
+
+
+
+
+
+
+
+ section_xz
+
+
+
+ R
+
+
+ I (100)
+
+
+ no section
+
+
+
+ Position
+of cross section(s) for output of 2d (xz) vertical
+cross sections (grid point index j).
+
+
+
+
+
+
+
+
+
+ section_yz
+
+
+
+ R
+
+
+ I (100)
+
+
+ no section
+
+
+
+ Position
+of cross section(s) for output of 2d (yz) vertical
+cross sections (grid point index i).
+
+
+
+
+
+
+
+
+
+ skip_particles_for_tail
+
+
+
+ P
+
+
+ I
+
+
+ 1
+
+
+ Limit
+the number of particle tails.
+
+
+
+
+
+
+
+
+ skip_time_data_output
+
+
+
+ R
+
+
+ R
+
+
+ 0.0
+
+
+ No
+data output before this interval has passed (in s).
+
+
+
+
+
+
+
+
+
+ skip_time_data_output_av
+
+
+
+ R
+
+
+ R
+
+
+ value of skip_time_
+
+
+
+data_output
+
+
+ No output of
+temporally averaged 2d/3d data before this interval has passed (in s).
+
+
+
+
+
+
+
+
+
+ skip_time_dopr
+
+
+
+ R
+
+
+ R
+
+
+ value of skip_time_
+
+
+
+data_output
+
+
+ No output of
+vertical profile data before this interval has passed (in s).
+
+
+
+
+
+
+
+
+
+ skip_time_dosp
+
+
+
+ P
+
+
+ R
+
+
+ value of skip_time_
+
+
+
+data_output
+
+
+ No output of
+spectra data before this interval has passed (in s).
+
+
+
+
+
+
+
+
+
+ skip_time_do2d_xy
+
+
+
+ R
+
+
+ R
+
+
+ value of skip_time_
+
+
+
+data_output
+
+
+ No output of
+instantaneous horizontal cross section data before this interval has
+passed (in s).
+
+
+
+
+
+
+
+
+ skip_time_do2d_xz
+
+
+
+ R
+
+
+ R
+
+
+ value of skip_time_
+
+
+
+data_output
+
+
+ No output of
+instantaneous vertical (xz) cross section data before this interval has
+passed (in s).
+
+
+
+
+
+
+
+
+ skip_time_do2d_yz
+
+
+
+ R
+
+
+ R
+
+
+ value of skip_time_
+
+
+
+data_output
+
+
+ No output of
+instantaneous vertical (yz) cross section data before this interval has
+passed (in s).
+
+
+
+
+
+
+
+
+
+
+
+ skip_time_do3d
+
+
+
+ R
+
+
+ R
+
+
+ value of skip_time_
+
+
+
+data_output
+
+
+ No output of
+instantaneous 3d volume data before this interval has passed (in s).
+
+
+
+
+
+
+
+
+
+ slicer_range_limits_dvrp
+
+
+
+ P
+
+
+
+
+
+
+ R(2,10)
+
+
+
+
+
+
+ 10
+* (-1,1)
+
+
+ Ranges
+of values to which a color table has to be mapped (units of the
+respective quantity).
+
+
+
+
+
+
+
+
+
+
+
+ spectra_direction
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ C
+* 2 (10)
+
+
+
+
+
+
+
+
+ 10 * ' '
+
+
+
+
+
+
+
+
+
+ Direction(s) along which spectra are to be calculated.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ statistic_regions
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+
+ 0
+
+
+
+
+
+
+
+
+ Number
+of additional user-defined subdomains for which
+statistical analysis
+and corresponding output (profiles, time series) shall be made.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ superelevation
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 1.0
+
+
+
+
+
+
+
+
+ Superelevation
+factor for the vertical coordinate.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ superelevation_x
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 1.0
+
+
+
+
+
+
+
+
+ Superelevation
+factor for the horizontal (x) coordinate.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ superelevation_y
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 1.0
+
+
+
+
+
+
+
+
+ Superelevation
+factor for the
+horizontal (y) coordinate.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ surface_heatflux
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ no prescribed
+heatflux
+
+
+
+
+
+
+
+
+ Kinematic
+sensible heat flux at the bottom surface (in K m/s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ surface_pressure
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 1013.25
+
+
+
+
+
+
+
+
+ Atmospheric
+pressure at the surface (in hPa)
+
+
+
+
+
+
+
+
+
+
+
+
+ surface_scalarflux
+
+
+
+ I
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ 0.0
+
+
+
+ Scalar flux at
+the surface
+(in kg/(m2 s)).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ surface_waterflux
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Kinematic
+water flux near the surface (in m/s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ s_surface
+
+
+
+ I
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ 0.0
+
+
+
+ Surface value of
+the passive
+scalar (in kg/m3 ).
+
+
+
+
+
+
+
+
+
+
+
+
+ s_surface_initial_change
+
+
+
+ I
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ 0.0
+
+
+
+ Change in
+surface scalar
+concentration to be made at the
+beginning of the 3d run (in kg/m3 ).
+
+
+
+
+
+
+
+
+
+
+
+
+ s_vertical_gradient
+
+
+
+ I
+
+
+
+
+
+
+ R(10)
+
+
+
+
+
+
+ 10 * 0 .0
+
+
+
+ Scalar
+concentration
+gradient(s) of the initial scalar
+concentration profile (in kg/m3 /
+100 m).
+
+
+
+
+
+
+
+
+
+
+
+ s_vertical_gradient_level
+
+
+
+ I
+
+
+ R(10)
+
+
+ 10 * 0.0
+
+
+
+ Height level from which on the scalar gradient defined by s_vertical_gradient
+is effective (in m).
+
+
+
+
+
+
+
+
+
+
+
+ termination_time
+
+
+
+ _needed
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 35.0
+
+
+
+
+
+
+
+
+ CPU
+time needed for terminal actions at the end of a run
+in
+batch mode (in s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ threshold
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+
+
+ R
+(10)
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+
+ Threshold
+value for which an isosurface is to be created
+by
+the dvrp
+software.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ timestep_scheme
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ C
+* 20
+
+
+
+
+
+
+
+
+ 'runge-kutta-3'
+
+
+
+
+
+
+
+
+
+ Time step scheme to be used for integration of the prognostic
+variables.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ topography
+
+
+
+ I
+
+
+ C * 40
+
+
+ 'flat'
+
+
+ Topography
+mode.
+
+
+
+
+
+
+
+
+ top_heatflux
+
+
+ I
+
+
+ R
+
+
+ no prescribed heatflux
+
+
+ Kinematic
+sensible heat flux at the top surface (in K m/s).
+
+
+
+
+
+
+
+
+ top_momentumflux_u
+
+
+ I
+
+
+ R
+
+
+ no prescribed momentumflux
+
+
+ Momentum flux along x at the top boundary (in m2/s2).
+
+
+
+
+
+
+
+
+ top_momentumflux_v
+
+
+ I
+
+
+ R
+
+
+ no prescribed momentumflux
+
+
+ Momentum flux along y at the top boundary (in m2/s2).
+
+
+
+
+
+
+
+
+ top_salinityflux
+
+
+ I
+
+
+ R
+
+
+ no prescribed
+
+
+ salinityflux
+
+
+ Kinematic
+salinity flux at the top boundary, i.e. the sea surface (in psu m/s).
+
+
+
+
+
+
+
+
+
+
+
+
+ ug_surface
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ u-component
+of the geostrophic wind at the surface (in m/s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ug_vertical_gradient
+
+
+
+ I
+
+
+ R(10)
+
+
+ 10 * 0.0
+
+
+
+ Gradient(s) of the initial
+profile of the u-component of the geostrophic wind (in
+1/100s).
+
+
+
+
+
+
+
+
+ ug_vertical_gradient_level
+
+
+
+ I
+
+
+ R(10)
+
+
+ 10 * 0.0
+
+
+
+ Height level from which on the
+gradient defined by ug_vertical_gradient
+is effective (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ups_limit_e
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Subgrid-scale
+turbulent kinetic energy difference used
+as
+criterion for applying the upstream scheme when upstream-spline
+advection is switched on (in m2 /s2 ).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ups_limit_pt
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Temperature
+difference used as criterion for
+applying
+the upstream scheme when upstream-spline advection is
+switched on
+(in K).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ups_limit_u
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Velocity
+difference (u-component) used as criterion for
+applying the upstream scheme
+when upstream-spline advection is switched on (in m/s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ups_limit_v
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Velocity
+difference (v-component) used as criterion for
+applying the upstream scheme
+when upstream-spline advection is switched on (in m/s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ups_limit_w
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ Velocity
+difference (w-component) used as criterion for
+applying the upstream scheme
+when upstream-spline advection is switched on (in m/s).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ use_particle_tails
+
+
+
+ P
+
+
+ L
+
+
+ .F.
+
+
+
+ Give particles a tail.
+
+
+
+
+
+
+
+
+
+
+
+ use_prior_plot1d
+
+
+
+ _parameters
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+ Additional plot of vertical profile data with profil from
+preceding runs of the
+job chain.
+
+
+
+
+
+
+
+
+
+
+
+ use_sgs_for_particles
+
+
+
+ P
+
+
+
+ L
+
+
+
+ .F.
+
+
+ Use
+subgrid-scale velocities for particle advection.
+
+
+
+
+
+
+
+
+
+
+
+
+ use_surface_fluxes
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .F.
+
+
+
+
+
+
+
+
+ Parameter
+to steer the treatment of the subgrid-scale
+vertical
+fluxes within the diffusion terms at k=1 (bottom boundary).
+
+
+
+
+
+
+
+
+
+
+
+
+ use_top_fluxes
+
+
+ I
+
+
+ L
+
+
+ .F.
+
+
+ Parameter
+to steer the treatment of the subgrid-scale
+vertical
+fluxes within the diffusion terms at k=nz (top boundary).
+
+
+
+
+
+
+
+
+
+
+
+ use_ug_for_galilei_tr
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .T.
+
+
+
+
+
+
+
+
+ Switch
+to determine the translation velocity in case
+that a
+Galilean transformation is used.
+
+
+
+
+
+
+
+
+
+
+
+
+ use_upstream_for_tke
+
+
+
+ I
+
+
+
+ L
+
+
+
+ .F.
+
+
+ Parameter to
+choose the advection/timestep scheme to be used for the subgrid-scale
+TKE.
+
+
+
+
+
+
+
+
+
+
+
+ vertical_particle_advection
+
+
+
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+ .T.
+
+
+
+ Switch on/off
+vertical
+particle transport.
+
+
+
+
+
+
+
+
+
+
+
+ vg_surface
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ 0.0
+
+
+
+
+
+
+
+
+ v-component
+of the geostrophic wind at the surface (in m/s).
+
+
+
+
+
+
+
+
+
+
+
+
+ vg_vertical_gradient
+
+
+
+ I
+
+
+ R(10)
+
+
+ 10 * 0.0
+
+
+
+ Gradient(s) of the initial
+profile of the v-component of the geostrophic wind (in
+1/100s).
+
+
+
+
+
+
+
+
+ vg_vertical_gradient_level
+
+
+
+ I
+
+
+ R(10)
+
+
+ 10 * 0.0
+
+
+
+ Height level from which on the
+gradient defined by vg_vertical_gradient
+is effective (in m).
+
+
+
+
+
+
+
+
+
+
+
+
+ wall_adjustment
+
+
+
+
+
+
+
+
+
+ I
+
+
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+
+
+
+ .T.
+
+
+
+
+
+
+
+
+ Parameter
+to restrict the mixing length in the vicinity
+of the
+bottom
+boundary (and near vertical walls of a non-flat topography ).
+
+
+
+
+
+
+
+
+
+
+
+ wall_heatflux
+
+
+
+ I
+
+
+ R(5)
+
+
+ 5 * 0.0
+
+
+ Prescribed
+kinematic sensible heat flux in K m/s at
+the five topography faces.
+
+
+
+
+
+
+
+
+
+
+
+ write_particle_
+
+
+
+ statistics
+
+
+
+
+
+
+ P
+
+
+
+
+
+
+ L
+
+
+
+
+
+
+ .F.
+
+
+
+ Switch on/off
+output of
+particle informations.
+
+
+
+
+
+
+
+
+
+
+
+ z_max_do1d
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+ zu(nzt+1)
+(model top)
+
+
+
+
+
+ Height level up to which horizontally
+averaged profiles
+are to
+be
+plotted with profil
+(in
+m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ z_max_do1d
+
+
+
+ _normalized
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ determined by plot
+
+
+
+data
+
+
+
+
+
+
+
+
+ Normalized
+height level up to which horizontally
+averaged
+profiles are to be plotted with profil .
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ z_max_do2d
+
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+ R
+
+
+
+
+
+
+
+
+
+ zu(nz)
+
+
+
+
+
+
+
+
+ Height
+level up to which 2d cross sections are to be
+plotted
+with iso2d
+(in m).
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Last change:
+$Id$
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_5.0.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_5.0.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_5.0.html (revision 141)
@@ -0,0 +1,310 @@
+
+
+PALM chapter 5.0
+5.0
+Installation of the
+model
+This chapter
+describes the installation of PALM on a Linux workstation (local host)
+and a suitable remote computer, on which the
+model runs are to be carried out. The local host is used to
+start batch jobs with mrun and to analyze the
+results
+which are produced by the model on the remote host and send back to the
+local host. Alternatively, mrun
+can also be used to start PALM on the local host in interactive mode or
+as a batch job (if a queueing system like NQS, PBS, or LoadLeveler is available).
Requirements
The
+installation and operation of PALM requires at mimimum (on both, the
+local and the remote host, unless stated otherwise):
The Korn-shell (AT&T ksh or public domain ksh) must be
+available under /bin/ksh . The
+NetCDF-library with version number not earlier than 3.6.0-p1 (for
+NetCDF, see under www.unidata.ucar.edu ). A FORTRAN90/95 compiler. The Message Passing Interface (MPI), at
+least on the remote host, if the parallel version of PALM shall be used. On the local host, the revision control
+system subversion
+(see subversion.tigris.org ).
+This is already included in many Linux distributions (e.g. SuSe). subversion requires port 3690 to
+be open for tcp/udp. If
+there are firewall restrictions concerning this port, the PALM code
+cannot be accessed. The
+user needs a permit to access the PALM repository. For getting a permit
+please contact the PALM group (raasch@muk.uni-hannover.de )
+and define a username under which you like to access the repository.
+You will then receive a password which allows the access under this
+name. A
+job queueing system must be available on the remote host. Currently, mrun can handle
+LoadLeveler (IBM-AIX) and NQS/PBS (Linux-Clusters, NEC-SX). ssh/scp-connections to and from the remote
+host must not be blocked by a firewall. Currently, mrun is configured
+to be used on a limited number of selected machines. These are
+IBM-Regatta at computing center HLRN in Hannover (ibmh ), Berlin (ibmb ), at KISTI,
+Korea (ibms ),
+at Yonsei University, Seoul (ibms ),
+on NEC-SX6/8 systems at DKRZ, Hamburg (nech ) and RIAM,
+Kyushu University, Fukuoka (neck ),
+as well as on the Linux cluster of IMUK (lcmuk ) and Tokyo
+Institute of Technology (lctit ).
+The strings given in brackets are the systems names (host identifiers) under which mrun identifies the
+different hosts. You can also use mrun /PALM on other Linux-Cluster, IBM-AIX, or NEC-SX machines. See below on how to configure mrun for other machines. However, these configurations currently (version 3.2a) allow to run PALM in interactive mode only. The
+examples given in this chapter refer to an
+installation of PALM on an IMUK Linux workstation and the IBM-Regatta
+system of
+the HLRN used as remote host. They are just called local and
+remote host from now on.
+
The installation
+process requires a valid
+account on the local and on the remote host as well.
+
+ All hosts (local as well as remote) are
+accessed via the secure shell (ssh). The user must establish
+passwordless login using the private/public-key mechanism (see e.g. the
+HLRN
+documentation ). To ensure proper function of mrun,
+passwordless login must be
+established in both directions, from the local to the remote host as
+well as from the remote to the local host! Test this by
+carrying
+out e.g. on the local host:
+ ssh
+<username on remote host>@<remote
+IP-address>
and on the remote host:
+
+ ssh
+<username on local host>@<local IP-adddress>
+
In both cases you should not be
+prompted for a password. Before continuing the further
+installation
+process, this must be absolutely guaranteed! This must also
+be
+guaranteed for all other remote hosts, on which
+PALM shall run.
+
Package
+Installation
In
+the first installation step a
+set of directories must be created both on the local and on the
+remote host. These directories are:
~/job_queue
~/palm
~/palm/current_version
~/palm/current_version/JOBS
The names of these directories
+are
+freely selectable (except ~/job_queue ),
+however new users should use them as suggested, since many
+examples in this documentation as well as all example files are
+assuming these settings. The directory ~/palm/current_version
+on the local host will be called the working directory from now on.
+In
+the second
+step
+a working copy of the recent version of the PALM software package,
+including the source code, scripts, documentation, etc. must
+be
+copied to the working directory ( local
+host!) by executing the following
+commands. Replace <your username> by the name that you
+chose to
+access the repository, and <#> by any of the available
+PALM
+releases, e.g. "3.1c "
+(new releases will be anounced by email to the PALM mailing list).
cd
+~/palm/current_version svn
+checkout --username <your username>
+svn://130.75.105.45/palm/tags/release-<#> trunk
You
+will then be prompted for your password. After finishing, the
+subdirectory trunk should
+appear in your working directory. It contains a number of further
+subdirectories which contain e.g. the PALM source code ( SOURCE )
+and the scripts for running PALM ( SCRIPTS ).
Alternatively, executing
svn checkout --username <your username> svn://130.75.105.45/palm/tags/release-<#> abcde will place your working copy in a
+directory named abcde instead
+of a directory named trunk .
+But keep in mind that you will have to adjust several paths given
+below, if you do not use the default directory trunk .
Please never touch any file in
+your working copy of PALM, unless you know exactly what you
+are doing.
You can also get a copy of the
+most recent code by executing
svn checkout --username <your username> svn://130.75.105.45/palm/trunk trunk However,
+this version may contain bugs and new features may not be documented. In future PALM releases,
+repository access to this most recent version will
+probably be restricted to the PALM developers.
Package
+Configuration
To
+use the PALM scripts, the PATH -variable has to be extended and the
+environment variable PALM_BIN has to be set (on local and remote host)
+in the respective profile of the users default shell (e.g. in .profile ,
+if
+ksh is used):
export
+PATH=$HOME/palm/current_version/trunk/SCRIPTS:$PATH export
+PALM_BIN= $HOME/palm/current_version/trunk/SCRIPTS
You
+may have to login again in order to activate these settings.
On the local and on the remote host, some
+small helper/utility programs have to be installed, which are later used by mrun e.g. for PALM data postprocessing. The installation is done by mbuild . This script
+requires a configuration file
+.mrun.config , which will be also used by mrun in the
+following. A copy has to be put into the working directory under the
+name
+.mrun.config by cp
+trunk/SCRIPTS/.mrun.config.default .mrun.config
Beside many other things, this file contains
+typical installation parameters
+like compiler name, compiler options, etc.
+for a set of different (remote) hosts. Please edit this file, uncomment
+lines like #%remote_username
+ <replace by your ... username>
+<host identifier>
by
+removing the first hash (# )
+character and replace the string "<replace
+by ...> " by your username on the respective host
+given in the <host identifier> .
+You only have to uncomment lines for those hosts on which you intend to
+use PALM.
After modifying the configuration file, the
+respective executables are generated by executing
mbuild -u -h lcmuk mbuild -u -h ibmh
The
+second call also copies the PALM scripts (like mrun and mbuild ) to the remote
+host.
Pre-Compilation
+of PALM Code
+ To avoid the
+re-compilation of the complete source code for each model run, PALM
+willl be pre-compiled once on the remote host by again using the script
+mbuild . Due
+to the use of
+FORTRAN modules in the source code, the subroutines must be compiled
+in a certain order. Therefore the so-called make
+mechanism
+is used (see the respective man-page of the Unix operating system),
+requiring a
+ Makefile ,
+in which the dependencies are described. This file is found in
+subdirectory trunk/SOURCE, where
+also the PALM code is stored . The compiled
+sources (object
+files) are
+stored on the remote computer in the default directory
+ ~/palm/current_version/MAKE_DEPOSITORY .The
+pre-compilation for the remote host (here the IBM-Regatta of HLRN) is
+done by
mbuild
+-h ibmh
mbuild
+ will prompt some queries,
+which must all be
+answered "y" by the user. The compiling process will take some time. mbuild transfers
+the respective compiler calls to the remote
+host where they are carried out interactively. You can follow the
+progress at the terminal window, where also error messages
+are displayed (hopefully not for this standard installation). By just
+entering
+
mbuild
+PALM
+will
+be (consecutively) pre-compiled for all remote hosts listed in
+the configuration file. If you want to compile for the local host only,
+please enter
mbuild
+-h lcmuk
+
Installation Verification
As a last step,
+after the compilation has been finished, the PALM installation has to
+be verified. For this
+purpose a simple test run is carried out. This once again requires the mrun
+ configuration file (described in chapter
+3.2 ), as well
+as the parameter
+file
+(described in chapter
+4.4.1 ). The
+parameter file must be
+copied from the PALM working copy by
+ mkdir -p JOBS/example/INPUT cp
+trunk/INSTALL/example_p3d JOBS/example/INPUT/example_p3d
+The
+test run can
+now be started by executing the command
+
mrun -d example -h ibmh -K parallel -X 8 -T 8 -t 500 -q cdev -r “d3# pr#”
+This specific run
+will be carried out on 8 PEs and is allowed to use up to 500 seconds
+CPU time. After pressing <return>, the most important
+settings of
+the job are displayed at the terminal window
+and the user is prompted for o.k. (“ y ”).
+Next, a message of the queuing system like “Request
+…
+Submitted to queue… by…” should
+be displayed. Now the job is
+queued and either started immediately or at a later time, depending on
+the
+current workload of the remote host. Provided that it is executed
+immediately and that all things work as designed, the job protocol of
+this run will appear under the file name ~/job_queue/ibmh_example no
+more than a few minutes later. The content of this
+file should be carefully examined for any error messages.
+
Beside the job
+protocol and according to
+the configuration file and arguments given for mrun
+options
+-d and -r , further
+files should be found in
+the
+directories
~/palm/current_version/JOBS/example/MONITORING
and
+
+ ~/palm/current_version/JOBS/example/OUTPUT
+
Please compare the
+contents of file
+
+ ~/palm/current_version/JOBS/example/MONITORING/ibmh_example_rc
+
with those of the
+example result file which can be found under
+trunk/INSTALL/example_rc ., e.g. by using the standard
+diff command:
diff
+ JOBS/example/MONITORING/ibmh_example_rc
+trunk/INSTALL/example_rc
where
+it is assumed that your working directory is
+~/palm/current_version .
You should not find any
+difference between these two files , except of the run date
+and time displayed at the top of the file header. If
+the file contents are identical, the installation is successfully
+completed.
Configuration for other machines
Starting
+from version 3.2a, beside the default hosts (HLRN, etc.), PALM can also
+be installed and run on other Linux-Cluster-, IBM-AIX, or
+NEC-SX-systems. To configure PALM for a non-default host only requires
+to add some lines to the configuration file .mrun.config . First,
+you have to define the host identifier (a string of arbitrary length)
+under which your local host shall be identified by adding a line %host_identifier <hostname> <host identifier>
to the configuration file (best to do this in the section where the other default host identifiers are defined). Here <hostname> must be the name of your local host as provided by the unix-command "hostname ". The first characters of <host identifier> have to be "lc ", if your system is (part of) a linux-cluster, "ibm ", or "nec "
+in case of an IBM-AIX- or NEC-SX-system, respectively. For example, if
+you want to install on a linux-cluster, the line may read as%host_identifier foo lc_bar
In
+the second step, you have to give all informations neccessary to
+compile and run PALM on your local host by adding an additional section
+to the configuration file:%remote_username <1> <host identifier> parallel %tmp_user_catalog <2> <host identifier> parallel %compiler_name <3> <host identifier> parallel %compiler_name_ser <4> <host identifier> parallel %cpp_options
+<5> <host identifier> parallel %netcdf_inc <6> <host identifier> parallel %netcdf_lib <7> <host identifier> parallel %fopts
+<8> <host identifier> parallel %lopts
+ <9> <host identifier> parallel
The
+section consists of four columns each separated by one or more blanks.
+The first column gives the name of the respective environment variable
+used by mrun and mbuild ,
+while the second column defines its value. The third column has to be
+the host identifier as defined above, and the last column in each line
+must contain the string "parallel ".
+Otherwise, the respective line(s) will be interpreted as belonging to
+the setup for compiling and running a serial (non-parallel) version of
+PALM. All brackets have to be replaced by the appropriate settings for your local host:<1> is the username on your LOCAL host<2> is the temporary directory in which PALM runs will be carried out<3> is the compiler name which generates parallel code<4> is the compiler name for generating serial code<5> are
+the preprocessor options to be invoked. In most of the cases, it will
+be neccessary to adjust the MPI data types to double precision by
+giving -DMPI_REAL=MPI_DOUBLE_PRECISION -DMPI_2REAL=MPI_2DOUBLE_PRECISION . To switch on the NetCDF support, you also have to give -D__netcdf and -D__netcdf_64bit (if you like to have 64bit NetCDF output).<6> is the compiler option for specifying the include path to search for the NetCDF module/include files<7> are the linker options to search for the NetCDF library<8> are the general compiler options to be used. You should allways switch on double precision (e.g. -r8 ) and code optimization (e.g. -O2 ).<9> are the linker options<host identifier> is the host identifier as defined before A typical example may be:%remote_username
+raasch
+ lc_bar parallel %tmp_user_catalog
+/tmp lc_bar
+parallel %compiler_name
+mpif90 lc_bar
+parallel %compiler_name_ser
+ifort lc_bar
+parallel %cpp_options
+-DMPI_REAL=MPI_DOUBLE_PRECISION:-DMPI_2REAL=MPI_2DOUBLE_PRECISION:-D__netcdf:-D__netcdf_64bit
+lc_bar parallel %netcdf_inc
+-I:/usr/local/netcdf/include
+lc_bar parallel %netcdf_lib
+-L/usr/local/netcdf/lib:-lnetcdf
+lc_bar parallel %fopts
+-axW:-cpp:-openmp:-r8:-nbs
+ lc_bar parallel %lopts
+-axW:-cpp:-openmp:-r8:-nbs:-Vaxlib lc_bar
+parallel
Currently (version 3.2a), depending on the MPI
+version which is running on your local host, the options for the
+execution command (which may be mpirun or mpiexec )
+may have to be adjusted manually in the mrun-script. A future version
+will allow to give the respective settings in the configuration file.
+If you have any problems
+with the PALM
+installation, the members of the PALM working group are pleased to
+help you.
+
+Last
+change: $Id$
+
Index: /palm/tags/release-3.4a/DOC/app/chapter_5.1.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/chapter_5.1.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/chapter_5.1.html (revision 141)
@@ -0,0 +1,71 @@
+
+
+PALM chapter 5.1
+
+
+5.1
+Installation of new / other versions, version update
+The PALM group announces code revisions by emails
+send to the
+PALM mailing list. If you like to be put on this list, just send an
+email to raasch@muk.uni-hannover.de .
+Details about new releases can be found in the
+technical/numerical
+documentation .
Generally,
+there are two ways of installing new / other versions. You can install
+a version from the list of available PALM releases or you can update
+your current installation with the newest developer version of PALM.
If you have previously checked out the most recent (at that time) PALM developer version by using
svn checkout ...../palm/trunk trunk ,
you can easily make an update to the newest version by
+changing into
+the working directory
+~/palm/current_version
+ and executing
svn
+update trunk
This
+updates all files in the PALM working copy in subdirectory trunk .
+The update may fail due the subversion rules, if
+you have modified the contents of trunk .
+In case of any conflicts with the repository, please refer to the subversion
+documentation on how to remove them. In order to avoid such
+conflicts, modifications of the default PALM code should be omitted and
+be restricted to the user-interface only
+(see chapter
+3.5 ).
+
+Alternatively, you can install new or other releases in a
+different directory, eg.
mkdir
+~/palm/release-3.1c cd
+~/palm/release-3.1c svn
+checkout --username <your username>
+svn://130.75.105.45/palm/tags/release-3.1c trunk
+However, this would require to carry out again the complete
+installation process described in chapter 5.0. So far, differet
+versions of PALM cannot be used at the same time. The PALM releases from palm/tags never have to be updated with "svn update ", since these releases are frozen!
After
+updating the working copy, please check for any differences between
+your current configuration file (.mrun.config )
+and the default configuration file under
+trunk/SCRIPTS/.mrun.config.default and adjust your
+current file, if neccessary.
The scripts and the
+pre-compiled code must then be updated
+via
mbuild
+-u -h lcmuk mbuild -u -h ibmh mbuild -h ibmh
or
+via
+
+mbuild
+-u mbuild
+on all remote hosts listed in the configuration file
+.mrun.config .
You
+can use "subversion" for code comparison between the different
+versions. Also, modified code can be committed to the repository,
+but this is restricted to PALM developers.
+As a last step, a suitable test run should be carried out. It
+should
+be carefully examined whether and how the results created by the new
+version differ from those of the old version. Possible discrepancies
+which go beyond the ones announced in the technical/numerical
+documentation
+should be communicated as soon as possible to the PALM group.
+
+
+
+ Last
+change: $Id$
+
Index: /palm/tags/release-3.4a/DOC/app/index.html
===================================================================
--- /palm/tags/release-3.4a/DOC/app/index.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/app/index.html (revision 141)
@@ -0,0 +1,292 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ PALM table of contents
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
PALM a pa rallelized
+L ES m odel
+
+
+
+
+
+
+
+Documentation
+
+
Current
+model
+version: 3.4a
+For date of last change see bottom line of each page.
+
+
+
+
+
Table
+of contents
+
+
+
+
1.0 Introduction
+
+
2.0 Basic
+techniques of the LES model and its parallelization
+
+
3.0 Execution of
+model runs
+
+
3.1 Job control
+with mrun
+
+ 3.2 Example of a
+minimum configuration file
+
+ 3.3
+Initialization and restart runs
+
+ 3.4 Input and
+output files
+
+ 3.5 Programming
+of user-defined code extensions
+
+
3.5.1 Interfaces for
+user-defined code
+
+ 3.5.2 Definition of
+user-defined parameters
+
+ 3.5.3 Definition of
+user-defined subdomains
+
3.5.4 User-defined output quantities
+
+3.5.5 Compiling and linking
+user-defined code
+
+
3.6 Interactive mode and
+debugging
+
+ 3.7 Optional
+software packages
+
+3.8 Coupled model runs
+
+
4.0 Steering
+parameters
+
+
4.1
+Initialization parameters
+
+ 4.2 Runtime
+parameters and package parameters
+
+ 4.3 User-defined
+parameters
+
+ 4.4 Examples of parameter sets
+
4.4.1 A minimum parameter set for the CBL
+
4.4.2 A parameter set for ocean runs
+
+ 4.5 Data analysis and
+visualization
+
+
+
4.5.1 NetCDF data output
+
+4.5.2 Plots of
+vertical profiles with profil
+
+4.5.3 Plots of time
+series with profil
+
+ 4.5.4 Plots of 2D
+cross sections with iso2d
+
+ 4.5.5 Plots of 3D
+volume data with AVS
+
+ 4.5.6 Plots of
+compressed 3D volume data with AVS
+
+ 4.5.7 Plots of isosurfaces , 2D cross sections and particles
+with dvrp
+
+
4.6 Listing of the steering
+parameters in alphabetical order
+
+
5.0 Installation
+of the model
+
+
5.1
+Installation of new / other
+versions, version update
+
+
+
+
+Last change:
+$Id$
+
+
+
+
Index: /palm/tags/release-3.4a/DOC/misc/Tsubame.html
===================================================================
--- /palm/tags/release-3.4a/DOC/misc/Tsubame.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/misc/Tsubame.html (revision 141)
@@ -0,0 +1,56 @@
+
+
+Tsubame
+
+
+
+
+
+Tsubame
+This document contains local
+support information for PALM users on the Linux Cluster Tsubame of the Tokyo
+Institute of Technology, Tokyo, Japan (http://www.gsic.titech.ac.jp/~ccwww ).
+Japanese and English user manuals are available for download (http://www.gsic.titech.ac.jp/~ccwww/tebiki ).
Subversion Installation: The
+following lines should be added to your ~/.profile
(for ksh users - create if necessary) or ~/.bashrc
(for bash users). These settings will be active from the next login.
export
+LD_LIBRARY_PATH=~mkanda/svn/lib
+export PATH=~mkanda/svn/bin:$PATH
Usage: Since
+Tsubame is located behind a firewall, the usual address svn://130.75.105.45 is unreachable from Tsubame. Instead, please login to media-o
+and use svn://p9c.cc.titech.ac.jp:36900 .
+This port works in both directions, i.e. for svn update
as well as svn commit
commands.
Batch system The implementation of the n1ge command on
+Tsubame requires modifications to mrun and subjob for PALM to
+run on Tsubame. Since mrun
+must be executed on one PE only, a one-PE "submitting job" is created
+when the user calls mrun .
+At the time when this "submitting job" is actually executed, it starts
+the main PALM job in the foreground. However, this only works if
+enough resources are available at that time. Therefore PALM users on
+Tsubame are advised to consider the queue load of the available queues
+for the main job (qstat -g c
) before job submission.
According
+to the current queue configuration (http://www.gsic.titech.ac.jp/~ccwww/tgc/q_e.html ),
+the following mrun
+options are available:
mrun optionexplanation possible
+values default value -q
queue
+name for main job novice, sla1, sla2,
+sla3, RAM64GB, RAM128GB sla3 -n
queue
+name for "submitting job" (always runs on 1 PE only) novice,
+sla1, sla2, sla3 sla3 -g
group number name of the N1GE_GROUP that is required to utilize the bes or sla queues none
Note that the default value "sla3" of the
+mrun option -q
may
+not always be the best choice. For code development, debugging or short
+test runs the value "novice" for both options may be suitable.
+Production runs should use the respective production queues (see http://www.gsic.titech.ac.jp/~ccwww/tgc/q_e.html for details). In the past the queueing system on Tsubame has undergone several changes, so this information may change.
The
+computer center advised us that due to restrictions of the batch system
+the value "novice" should not be mixed with the other queues. Please
+specify either a combination of slan for -n
and slan or RAM* for -q
, or specify the combination "novice" + "novice".
The group number contains the accounting information. You must specify it using the mrun option -g
. Alternatively, you may set also a default value in your .mrun.config
file like this:
%group_number
+12345678
+
+lctit parallel
The mrun option -t
+contains the CPU time demand for the main job in s which will be
+automatically converted into min for the n1ge command. The
+option -m
+contains the memory demand for the main job in MB which will be
+automatically converted into GB for the n1ge command.
Finally, PALM batch jobs on Tsubame require the mrun option -b
.
NetCDF In order to use NetCDF commands like ncdump
and the graphical NetCDF tools NCL , Ncview and Ferret , please add the following lines to ~/.profile
(for ksh users) or ~/.bashrc
(for bash users):
# NetCDF export PATH=$PATH:~mkanda/netcdf-3.6.2/bin:~mkanda/netcdf-3.6.2/include
# NCL export NCARG_ROOT=~mkanda/ncl PATH=~mkanda/ncl/bin:$PATH # Ncview export PATH=$PATH:~mkanda/ncview/bin export XAPPLRESDIR=~mkanda/.app-defaults
# Ferret export FER_DIR=~mkanda/ferret export LD_LIBRARY_PATH=$LD_LIBRARY_PATH:$FER_DIR/lib export PATH=$PATH:$FER_DIR:$FER_DIR/bin export FER_DSETS=$FER_DIR export FER_WEB_BROWSER=firefox export FER_EXTERNAL_FUNCTIONS="$FER_DIR/lib" export FER_GO=". $FER_DIR/go $FER_DIR/examples $FER_DIR/contrib" export FER_DATA="." export FER_DESCR="." export FER_GRIDS=". $FER_DSETS/grids" export TMAP="$FER_DIR/fmt" export PLOTFONTS="$FER_DIR/ppl/fonts" export SPECTRA="$FER_DIR/ppl" # for old ferret versions export FER_PALETTE=". $FER_DIR/ppl" # palette search list
Last
+change: $Id$
Index: /palm/tags/release-3.4a/DOC/tec/technical_documentation.html
===================================================================
--- /palm/tags/release-3.4a/DOC/tec/technical_documentation.html (revision 141)
+++ /palm/tags/release-3.4a/DOC/tec/technical_documentation.html (revision 141)
@@ -0,0 +1,2517 @@
+
+
+ PALM technical/numerical documentation
+PALM
+ a
+pa rallelized
+L ES m odel
+
+technical/numerical documentation
+
+
+
+ Current
+model version: 3.4a
+ Last
+change of this document : $Id$
+
+
+Table of contents
+
+
+
1.0
+History of changes 2.0
+How to change the model source
+code
3.0
+Description of selected parts
+of
+the model source code
+
+ Please note: Parts of this document are still in
+German. We
+apologize
+for any inconvenience.
+
+ 1.0
+History of changes
+The following table documents all changes to the model since July, 7th
+1998. Entries in the fourth column specify the type of the change:
+change
+of existing code (C), new code (N) or bugfix (B). More detailed
+information
+about the changes may be found in the header comment lines of the
+respective
+routines.
+
+
+ date
+author model
+ version type
+description affected
+routines 06/07/98 SR
+1.0 C Änderung
+von Default-Werten
+(initializing_actions, end_time,
+fcl_factor, use_prior_plot1d_parameters), zusätzliche
+Überprüfung
+von Parametern auf Zulässigkeit (prandtl_layer, psolver, nx,
+ny,
+nz,
+fcl_factor), Höhe der Schnittebenen der Horizontalschnitte
+wird
+auf
+Plots exakt ausgegeben (uv- bzw. w-Gitter). modules,
+check_parameters, plot_2d " SR
+1.0 N Neues Modul
+test_variables wird in (fast) allen
+Programmteilen benutzt
+(USE). Wichtig : dieses Modul steht in der Datei module_test.f90.
+D iese Datei muß in der mrun- und add_library -
+Konfigurationsdatei
+bei der Variablen module_files
+aufgeführt werden. (fast)
+alle
+Neu: module_test 16/07/98 SR
+1.0 N Anpassung
+an die T3E-Rechner in Juelich (cpp -
+Direktiven) advec_s_bc, check_open,
+check_parameters, cpu_zeitmessung,
+init_pegrid,
+local_getenv, local_system, local_tremain, local_tremain_ini, poisfft
+ 24/07/98
+MS 1.0 C
+Anpassung des Druckloesealgorithmusses an
+Vorgehensweise von
+Schmidt, Schumann und Volkert (DFVLR-Mitteilung 84-15, S.
+20-26) poisfft 27/07/98
+MS 1.0 C
+Berechnung von l in maketri geschieht nun
+ausserhalb der k-Schleife,
+da unabhaengig von k, dadurch Rechenzeitersparnis poisfft
+ 05/08/98
+SR 1.0 C
+Entfernung der Sonderbehandlung der Advektionsterme
+(Piascek-Williams)
+bei k=1. Terme werden nun überall gleich berechnet. Evtl.
+leichte
+Erhöhung der Varianzen in Oberflächennähe.
+advec_u_pw, advec_v_pw, advec_w_pw
+ " SR 1.0
+C Mischungsweganpassung (s.
+adjust_mixing_length) erfolgt nur
+noch bei
+k=1. Unrealistische sekundäre Maxima in den Km-Profilen
+oberhalb
+der
+Prandtl-Schicht werden damit vermieden. Leichte Änderungen in
+den
+oberflächennahen Turbulenzgrößen sind die
+Folge. diffusivities " SR
+1.0 B Falsche
+Berechnung der benötigten CPU-Zeit pro Sekunde
+simulierter
+Zeit bei Fortsetzungsläufen korrigiert. Berechnung
+von cross_uxmin(1) und cross_uxmax(1) aus den
+Werten von
+ug und vg entfernt. Lieferte falsche Wertebereiche für Plots
+von
+Vertikalprofilen,
+wenn im ersten Koordinatenkreuz nicht die Windgeschwindigkeiten
+gezeichnet
+wurden.
header,
+check_parameters " SR
+1.0 N Das
+erlaubte Maximum und Minimum der Rif-Zahl ist nun mittels
+der Initialparameter
+rif_max und rif_min einstellbar (Werte waren bisher fest auf -2.0, +1.0
+eingestellt). check_parameters, header,
+init_1d_model, modules, parin,
+prandtl_fluxes,
+read_var_list, write_var_list 23/09/98
+SR 1.0 B
+Initialisierung von Feldern im Fall von initializing_action =
+"set_constant_profiles "
+und "set_1d-model_profiles " korrigiert. 2D-Plotausgabe
+von u* und theta* korrigiert. Hier wurden
+bisher falsche
+Felder herausgeschrieben.
Bei
+SOR-Aufrufen war bisher dp nicht initialisiert.
+Entsprechend geändert.
init_3d_model,
+plot_2d, pres " SR
+1.0 C Ausgabeformate
+für Statistik-Ausgaben auf
+Datei RUN_CONTROL
+um einige Kommastellen erweitert. Lieferung von
+ausführlicheren Informationen bei
+Programmabbruch
+durch Unterschreitung des minimal erlaubten Zeitschritts.
+run_control, timestep "
+SR 1.0 N
+Rechnungen mit geneigter Ebene zur Simulation von
+Kaltluftabflüssen
+sind erlaubt. Gestartet und gesteuert werden sie mit dem
+Intialisierungsparameter alpha_surface .
+Realisiert wird die geneigte Ebene durch entsprechende
+Schrägstellung
+des Schwerkraftvektors. Dadurch erhält auch die u-Komponente
+der
+Windgeschwindigkeit
+einen Anteil der Auftriebskraft. Diese
+Implementierung ist noch nicht abgeschlossen. Die
+Simulation von
+Kaltluftabflüssen erfordert bisher noch Eingriffe "von Hand".
+ buoyancy, check_parameters, header, leap_frog,
+modules,
+parin, prandtl_fluxes,
+read_var_list, write_var_list 15/12/98 SR
+1.0 N Vereinbarung
+einer Cache-Layer zur schnelleren binären
+I/O auf
+T3E-Rechnern. Ermittelung wahrer I/O-Zeiten
+für binäre
+Ein-/Ausgabe auf
+T3E-Rechnern mit TIMEF.
check_open,
+ cpu_zeitmessung, init_3d_model, write_3d_model
+ "
+SR 1.0 B
+Bekanntgabe von run_description_header an alle
+PE's. Diese Programmänderung erfordert auf
+T3E-Rechnern
+zwingend den
+Einsatz der MPI-Version mpt.1.2.0.1. In dieser neuen Version tritt auch
+der alte Fehler in MPI_ALLREDUCE nicht mehr auf, so daß ab
+jetzt
+mpt.1.1.0.1 nicht mehr verwendet werden muß.
+parles 05/02/99
+SR 1.1 C/N
+Implementierung des Upstream-Spline- Verfahrens zur Advektion
+von Impuls
+und skalaren Größen (neue UP's, s. rechts).
+Berechnung von
+Variablen
+für spezielle Advektionsverfahren in eigenständiges
+UP
+ausgelagert
+(init_advec + eigenes Modul advection ).
+Reines
+Euler-/Upstream-Verfahren
+kann gerechnet werden. Schnelle binäre I/O
+(s. 15/12/98) wieder abgeschaltet, da
+Dateien
+nicht wieder einlesbar sind. Druckstörung (p) wird zu Beginn
+auf 0
+gesetzt, damit sie keine Tendenzen im ersten Zeitschritt hervorruft.
+ advec_s_bc, check_open, check_parameters,
+flow_statistics,
+header,
+init_3d_model, init_grid, leap_frog, modules, parin, plot_2d, plot_ts,
+read_var_list, timestep, write_3d_binary, write_var_list Neu:
+
+advec_s_ups, advec_u_ups, advec_v_ups, advec_w_ups, init_advec,
+long_filter,
+spline_x, spline_y, spline_z
24/02/99
+SR 1.1a C/N
+Kleinere Ergänzungen / Änderungen
+für Upstream
+- Spline,
+Diverse Verbesserungen bei Berechnung der Diffusionskoeffizienten
+(exaktere
+Formulierung von Scherungen, Dissipation gemaess Original - Deardorff -
+Ansatz, Mischungswegreduktion nur, wenn Schichtung sowohl oberhalb als
+auch unterhalb des entsprechenden Gitterpunktes stabil ist),
+Wertebegrenzung
+bei Spline - Berechnung zur Verhinderung von "Überschwingern"
+check_parameters, diffusion_e, diffusion_pt, diffusivities,
+header,
+init_advec, long_filter, modules, production_e, spline_x, spline_y,
+spline_z
+" SR 1.1a
+N/B Erweiterung des des Bott - Chlond -
+Schemas auf Advektion der
+TKE,
+Korrektur der Dichteberechnung (war falsch bei Galilei-Transformation)
+advec_s_bc, leap_frog 01/03/99
+MS 1.1b N
+Kleinere Ergänzungen für Upstream -
+Spline: Gradientenkontrolle
+für den nicht-parallelen Teil statistische
+Auswertung über den prozentualen Anteil
+des
+Upstream-Verfahrens
+an der Gesamtadvektion fuer nicht-parallelen Teil
+ modules, spline_x, spline_y, spline_z
+ "
+SR 1.1b N
+Datenkompression für 3D-Plotausgaben check_open, check_parameters, close_files, header,
+modules,
+parin, plot_3d Neu:
+write_compressed
03/03/99
+SR 1.1c B/C
+Schnelle binäre I/O auf T3E-Rechnern funktioniert
+jetzt.
+Beim
+binären Einlesen dürfen Records nicht mit dem Trick "READ
+(..) idum " überlesen werden. Zeitmessungen auf T3E
+erfolgen
+jetzt
+grundsätzlich mit TIMEF. check_open,
+cpu_zeitmessung, init_3d_model, modules,
+write_3d_binary 25/03/99
+SR 1.1d N
+Einbau einer Rayleigh-Dämpfungsschicht sowie
+flexiblere
+Wahl der
+numerischen Begrenzer für das Upstream - Spline - Verfahren.
+check_parameters, header, init_3d_model, leap_frog, modules,
+parin,
+read_var_list, spline_x, spline_y, spline_z, write_var_list
+ "
+SR 1.1d B
+Korrektur des Zeitschrittkriteriums bei z=zp im 1D-Modell
+init_1d_model 25/11/99 SR
+1.1e N Partikelplots
+mit vtk-Graphiksoftware sind auf t3eh
+möglich.
+Ausgabe erfolgt im dvr-Format. Bisher noch nicht nutzbar, da noch
+Einstellmöglichkeiten
+für die Partikelquelle(n) fehlen. Wichtig:
+Die Benutzung
+der
+vtk-Software erfordert die zusätzliche mrun-Option -g .
+Das
+Hauptprogramm parles wird in diesem Fall zum
+Unterprogramm
+und
+von einem c++-Programm aus aufgerufen. header,
+init_3d_model, init_pegrid, leap_frog, modules,
+parin, parles,
+read_var_list, write_var_list Neu:
+
+advec_particles, init_particles, plot_particles
+ "
+SR 1.1e B/C
+TIMEF-Zeitmessungen von Subroutine- auf Function-Aufruf
+umgestellt.
+Laufindexkorrektur in spline_y . Fehler trat bei
+nx /= ny auf. cpu_zeitmessung, spline_y
+ 28/12/99 SR 1.1f
+N Plot von Isooberflächen mit
+vtk-Graphiksoftware sind auf
+t3eh
+möglich. Ausgabe erfolgt im dvr-Format. Bisher noch nicht
+allgemein
+nutzbar, da noch diverse manuelle Eingriffe nötig sind.
+header, leap_frog, modules, parin, plot_particles,
+read_var_list, write_var_list Neu:
+
+plot_isosurface
10/01/00
+SR 1.2 C
+Randbedingungen für w (=0) werden explizit gesetzt,
+und
+zwar nicht
+nur bei k = nzb, nzt+1 sondern auch
+bei k =
+nzt ,
+wo bislang der vom vorigen Zeitschritt durch den Drucklöser
+ermittelte
+Wert stand. Auch jetzt wird der Wert bei k = nzt anschließend
+durch
+den Drucklöser modifiziert. Soweit bis jetzt abzusehen, hat
+diese
+Änderung nur minimale Auswirkungen auf den Prognoseverlauf.
+Evtl.
+gibt es stärkere Auswirkungen bei exzessivem Auftreten von
+Schwerewellen
+am oberen Rand (die dort aber eigentlich sowieso nicht
+hingehören).
+Variablenübergabe an boundary_conds
+erfolgt
+über Modul und nicht mehr per Parameterliste. Bei
+Galilei-Transformation wird jetzt defaultmäßig
+der geostrophische
+Wind als Translationsgeschwindigkeit verwendet (neuer
+Initialisierungsparameter use_ug_for_galilei_tr ).
+Dadurch wird das verstärkte Auftreten von Schwerewellen bei
+höheren
+geostrophischen Windgeschwindigkeiten unterdrückt.
+3D-Feldvariablen (u, v, w, pt, e, km, kh) sowie einige
+2D-Variablen
+(usws, vsws, rif, shf) sind nun als Pointer deklariert, denen nach
+jedem
+Zeitschritt neue Targets zugeordnet werden (für die
+benötigten
+3 Zeitebenen existieren die Targets ..._1 (z.B. u_1), ..._2, ..._3).
+Durch
+die jeweilige Neuzuordnung der Targets entfällt das
+Umspeichern
+der
+Zeitebenen komplett (Zeitersparung: ca. 5% der
+Gesamtrechenzeit).
+Die Umordnung der Zeitebenen wurde ins neue UP swap_timelevel
+ausgelagert. Wichtig: Die
+Übersetzungszeiten haben durch die
+Einführung
+der Pointer t.w. sehr deutlich zugenommen (leap_frog
+benötigt
+jetzt z.B. ca. 60 Sekunden). Außerdem benötigt der
+Compiler
+jetzt wesentlich mehr Speicher. Der "memory"-Parameter in den
+Konfigurationsdateien
+(.mrun.config, .al.config) muss nun mindestens den Wert 60 (MB) (t3eh,
+t3ej2) bzw. 45 (t3eb) und 96 (vpp) haben. Achtung:
+bislang wurde diese Änderung nur für
+das
+reine Leapfrog-Verfahren getestet!
Neue
+Laderoption "-D preset=nan " empfohlen (s.
+Beispiel-Konfigurationsdatei).
+Ebenso empfehlenswert für Debug-Läufe: Compileroption
+"-ei ".
+Diese bewirkt einen Programmabbruch, falls mit nicht initialisierten
+Variablen
+gearbeitet wird (ist aber zeitaufwendig in der Ausführung!).
+ boundary_conds, check_parameters, header,
+init_3d_model,
+leap_frog,
+modules, parin, read_var_list, timestep, write_var_list Neu:
+
+swap_timelevel
10/01/00
+SR 1.2 B
+Der Asselin-Filter wird vor Umordnung der Zeitebenen
+aufgerufen. Dies
+geschah bisher fälschlicherweise erst danach, sodass der
+Zeitfilter
+asymmetrisch arbeitete. Achtung:
+diese Änderung hat Auswirkungen auf den
+Prognoseverlauf.
+Die Testergebnis-Datei wurde entsprechend geändert.
+leap_frog
+14/02/00 MS 1.2 B/C 1D-Modell:
+
+Der Asselin-Filter im 1D-Modell wird nun auch vor der Umordnung der
+Zeitebenen aufgerufen (s.o.). 3D-Modell:
+
+TKE wurde bisher bei scalar_advec=bc-scheme einer
+zeitlichen
+Filterung unterzogen. Dies wird nun unterbunden.
Die
+Divergenz der Impulsflüsse an der Prandtl - Schicht -
+Obergrenze
+wird nun über eine ganze Gitterweite gebildet. Die bisherige
+Methode
+lieferte im Vergleich mit Ergebnissen anderer LES-Modelle zu
+große
+Impulsflüsse.
Bei der
+Berechnung der Diffusion der Temperatur werden die
+Diffusionskoeffizienten
+nun wieder durch Mittelung für die entsprechenden
+Gitterpunkte
+bereitgestllt. Das Maximumkriterium, das im Zuge der Implementierung
+des
+Upstream-Spline Advektionsverfahrens eingebaut wurde, bewirkte ein zu
+rasches
+Anwachsen der Grenzschicht mit der Zeit.
Achtung:
+diese Änderungen haben Auswirkungen auf
+den Prognoseverlauf.
+Die Testergebnis-Datei wurde entsprechend geändert.
+init_1d_model,
+asselin_filter,
+diffusion_u, diffusion_v,
+diffusion_pt 17/02/00
+MS 2.0 N
+Allgemeine Beschreibung der Änderungen:
+
+vollständige Implementierung des wolkenphysikalischen
+Moduls Zur Implementierung der Wolkenphysik waren
+umfangreiche
+Änderungen
+in zahlreichen Programmteilen notwendig (Beschreibung siehe
+unten ). Im einzelnen wurden folgende Unprogramme
+geändert: modules :
+ 1) Bereitstellung neuer 3D-, 2D- und 1D-Felder für
+die Prognose
+des Gesamtwassergehaltes
+2) "cloud_parameters" als neues Modul mit wolkenphysikalischen
+Variablen parin: Initialisierungsparameterliste
+wurde erweitert
+(s.u.) read_var_list,
+write_var_list,
+write_3d_binary: In/Output
+der neuen Initialisierungsparamter und Felder für
+Fortsetzungsläufe check_parameters:
+Initialisierung
+des
+Feuchteprofils und Ausgabe von neuen Vertikalprofilen:
+ vpt : virtuelle
+poteniellen
+Temperatur, lpt :
+potentielle
+Flüssigwassertemperatur, q :
+Gesamtwassergehalt, qv :
+spezifische
+Feuchte, ql :
+Flüssigwassergehalt, w"vpt", w*vpt*, wvpt :
+Auftriebsfluss (subskalig, aufgelöst, gesamt),
+w"q", w*q*, wq :
+Wasserfluss (subs., aufg., ges.), w"qv", w*qv*, wqv :
+Feuchtefluss (subs, aufg., ges.) init_3d_model :
+Initialisierung aller
+Feuchte/Wasserfelder init_1d_model :
+Anpassung an Rechnungen mit Feuchte header :
+Headerausgaben für Feuchtebehandlung und
+Wolkenphysik
+eingefügt, außerdem Formatnummern erweitert um Platz
+für
+weitere Ausgaben zu schaffen leap_frog:
+
+1) alle prognostischen Gleichungen wurden in prognostic_equations
+ausgelagert
+2) Aufrufe der neuen Unterprogramme (UP) compute_vpt,
+calc_liquid_water_content
+3) veraenderter Aufruf von diffusivities b oundary_conds,
+asselin_filter, swap_timelevel,
+flow_statistics: Anpassung
+an Feuchtebehandlung plot2d, plot3d :
+Ausgabemöglichkeiten von q und ql buoyancy :
+Anpassung des Autriebstermes an
+Feuchtebehandlung
+durch neue Übergabeparameter: Temperatur + Nummer des
+entsprechenden
+mittleren Temperaturprofils diffusion_e :
+Anpassung der Mischungswegberechnung an
+Feuchtebehandlung
+durch Variation der Übergabeparameter production_e :
+TKE-Produktion durch Auftriebskräfte an
+Feuchtebehandlung
+angepasst diffusivities :
+siehe diffusion_e prandtl-fluxes :
+Prandtl-Schicht fuer den
+Gesamtwassergehalt
+eingefügt
Zusätzlich
+wurden folgende Unterprogramme NEU
+eingeführt: inti_cloud_physics :
+Initialisierung wolkenphysikalischer
+Parameter prognostic_equations :
+Auslagerung der prognostischen
+Gleichungen
+aus leap_frog, zusätzliche porgnostische Gleichung
+für den
+Gesamtwassergehalt diffusion_s :
+Berechnung der Diffusion skalarer
+Größen
+(Temperatur und Gesamtwassergehalt), ersetzt diffusion_pt
+calc_liquid_water_content : Berechnung des
+Flüssigwassergehalts calc_radiation :
+Parametrisierung langwelliger
+Strahlungsprozesse
+über des Schema der effektiven Emissivität
+calc_precipitation :Parametrisierung von
+Niederschlagsprozessen
+mit Hilfe eines vereinfachten Kesslerschemas impact_of_latent_heat :
+Berücksichtigung der durch
+Niederschlagsprozesse
+zurückbleibenden latenten Waerme innerhalb eines
+Gittervolumens compute_vpt :
+Berechnung der virtuellen potentiellen
+Temperatur
Liste der neuen
+Initialisierungsparameter:
+ Parameter
+Typ Default
+Beschreibung
+ moisture
+L FALSE Ab-/Zuschalten
+des Gesamtwassergerhaltes als neue
+progn. Variable cloud_physics
+L FALSE Ab-/Zuschalten
+des Kondensationsschemas
+radiation L
+FALSE Ab-/Zuschalten
+des Strahlungsschemas precipitation
+L FALSE Ab-/Zuschalten
+der Niderschlagsparametrisierung bc_q_b
+C 'dirichlet' untere
+Randbedingung für q (siehe auch bc_pt_b)
+ bc_q_t C
+'neumann' obere RB für q
+(siehe auch bc_pt_t) q_surface
+R 0.0 Feuchtewert
+an der Erdoberfläche q_surface_initial_change
+R 0.0 vgl.
+pt_surface_initial_change q_vertical_gradient
+R(10) 0.0 vgl.
+pt_vertical_gradient
+q_vertical_gradient_level
+R(10) 10000.0 vgl.
+pt_vertical_gradient_level surface_pressure
+R 1013.25 Luftdruck
+an der Erdoberfläche surface_waterflux
+R 0.0 oberflächennaher
+Wasser/Feuchtefluss
+Fortsetzungsläufe mit Daten, die mit Modellversionen kleiner
+2.0
+erzeugt
+wurden, sind aufgrund der erweiterten Initialisierungsparameterliste
+INKOMPATIBEL
+zu den Einleseroutinen der Version 2.0. Ein Update auf Version 2.0
+sollte
+deshalb nach Abschluss eines kompletten Modelllaufs erfolgen.
+ Achtung: diese
+Änderungen haben Auswirkungen auf
+den Prognoseverlauf.
+Die Testergebnis-Datei wurde entsprechend geändert.
+modules, parin,
+read_var_list,
+check_parameters,
+init_3d_model, init_1d_model, header, leap_frog. buoyancy, diffusion_e,
+production_e, diffusivities, prandtl_fluxes, boundary_conds,
+asselin_filter,
+swap_timelevels, flow_statistics, plot_2d, plot_3d, write_var_list,
+write_3d_binary Neu:
+init_cloud_physics, prognostic_equations, diffusion_s,
+calc_liquid_water_content,
+calc_radiation, calc_precipitation, impact_of_latent_heat, comute_vpt
+ 18/02/00 MS 2.0 B/N Im Zuge der
+Umstellung auf Modellversion 2.0 wurden
+noch kleine
+Änderungen an den Unterprogrammen diffusion_e, production_e
+und
+diffusivities
+vorgenommen. In allen genannten
+Unterprogrammen wurde bisher ein strengeres Kriterium zur Bestimmung
+der Schichtungsverhältnisse verwendet. Ein Modellvergleich
+zeigte
+jedoch, dass dadurch die Diffusion im Bereich der Inversion zu gross
+wird. Eine weitere Ergänzung betrifft die
+Advektionsverfahren:
+Das Bott-Chlond Advektionsverfahren ist nun auch für
+Rechnungen
+mit Feuchte/Wolkenphysik verfügbar.
Achtung:
+diese Änderungen haben Auswirkungen auf
+den Prognoseverlauf.
+Die Testergebnis-Datei wurde entsprechend geändert.
+diffusion_e,
+production_e,
+diffusivities, check_parameters 26/04/00
+SR 2.0a C
+Vollständige Umstellung von vtk-Grafik-Software auf
+dvrp-Software.
+Grafik-Ausgaben im dvr-Format sind mittlerweile begrenzt nutzbar
+(Isooberflächen
+sind darstellbar, siehe neue Laufparameter dt_dvrp,
+threshold ),
+es wird aber in der Anwendung in naher Zukunft noch diverse
+Änderungen
+geben. Partikelausgabe vorerst nicht mehr möglich (Verlagerung
+schon). header, init_particles, init_3d_model,
+leap_frog, modules,
+parin, parles,
+read_var_list, write_var_list Gestrichen:
+
+plot_isosurface, plot_particles Neu:
+
+init_dvrp, plot_dvrp
26/04/00
+SR 2.0a C
+Durch zusätzlichen zyklischen Rand im
+Bott-Chlond-Schema
+sehr
+viele SENDRECV-Aufrufe eingespart.
+Änderung des Namens einer eingelesenen Environment-Variablen
+in check_open
+von remote_addres nach return_addres .
+ Prozessor-Topologie kann durch Benutzer vorgegeben werden.
+Dazu neue
+Initialisierungsparameter npex und npey .
+Durch
+Änderungen
+am Header-Format wurde Testergebnis-Datei geändert.
+advec_s_bc, check_open, header, init_pegrid, modules, parin,
+read_var_list,
+write_var_list 26/04/00
+SR 2.0a N
+Rechnungen mit geneigter Oberfläche erlauben jetzt
+die
+Vorgabe
+eines stabil geschichteten Temperaturprofils mit konstantem Gradienten.
+Hinzuschalten von Feuchte funktioniert für Hangrechnungen noch
+nicht. advec_s_bc, buoyancy, init_3d_model,
+modules,
+prognostic_equations Neu:
+init_slope
13/06/00 MS
+2.0a B Es
+werden nun auch die seitlichen Ränder für ql
+gesetzt.
+Ein Nichtsetzen der Randbedingungen führte zu Fehlern bei der
+Ausgabe
+von pt calc_liquid_water_content
+ 03/07/00 SR 2.0b
+C Für eine Reihe von
+Unterprogrammen, die innerhalb
+von prognostic_equation
+aufgerufen werden und an die Pointer-Variablen übergeben
+werden,
+sind
+jetzt explizite Interfaces vereinbart (neues Modul pointer_interfaces ).
+Auch im Vereinbarungsteil der entsprechenden Unterprogramme sind diese
+Übergabeparameter jetzt aus Konsistenzgründen (und
+weil es
+sonst
+Laufzeitfehler gibt) als Pointer-Variablen deklariert. Mit dieser
+Änderung
+ist der große Speicher- und CPU-Zeit-Bedarf beim
+Übersetzen
+von prognostic_equations wieder auf ein erträgliches
+Maß
+reduziert.
+Im Rahmen dieser Änderungen wurde auch an diffusion_e ein
+Hilfsfeld
+weniger übergeben.
+Aus nicht vollständig gekärten Gründen haben
+sich die
+Zahlen in der Testergebnis-Datei minimal geändert (und zwar
+die
+Spalte
+mit der Gesamtdivergenz nach Aufruf des Drucklösers).
+advec_s_bc, buoyancy, diffusion_e, diffusion_s, diffusion_u,
+diffusion_v,
+diffusion_w, disturb_field, modules, production_e, prognostic_equations
+ 04/07/00 SR 2.0b
+B Diriclet-Randbedingungen für
+Temperatur und
+Flüssigwassergehalt
+werden gesetzt. Dies wäre bereits nach Einführung der
+Pointer
+zwingend notwendig gewesen. Rechnungen mit vorgegebener
+Oberflächentemperatur
+schlugen deshalb bislang fehl. boundary_conds
+ 07/09/00 MS 2.0b
+B Die virtuelle potenielle Temperatur
+wird nun auch für
+k=nzb und
+k=nzt+1 berechnet, um die Randwerte auch für Ausgabezwecke
+bereichtzustellen. compute_vpt
+ 28/12/00 SR 2.1
+C/N PALM erlaubt jetzt den Einsatz
+optionaler Software-Pakete,
+die zwar
+zum Modell gehören, standardmäßig aber
+nicht mit
+übersetzt
+werden, um so unter anderem Kompilationszeit einzusparen. Siehe neues
+Kapitel
+3.7 in der Modelldokumentation. Einsatz der
+dvrp-Software wurde vollständig
+überarbeitet.
+Sie ist nun als Software-Paket optional im Modell einsetzbar. Siehe
+überarbeitetes
+Kapitel 4.5.6 in der Modelldokumentation.
Die
+Prognose der Partikelverlagerung ist ebenfalls in ein
+optionales
+Software-Paket ausgelagert.
advec_particles,
+header, init_3d_model, init_dvrp,
+init_particles,
+init_pegrid, modules, parin, parles, plot_dvrp, prognostic_equations,
+read_var_list,
+write_var_list Neu:
+package_parin
28/12/00
+SR 2.1 B
+MPI_FINALIZE ans Ende des Hauptprogramms geschoben (stand
+vorher vor
+cpu_auswertung, wo noch ein Barrier-Aufruf steht). comm2d war zu Beginn
+undefiniert und wird nun erst einmal gleich MPI_COMM_WORLD gesetzt.
+parles 02/01/01
+SR 2.1a C
+Offene Dateien werden sobald möglich geschlossen.
+Wiedereröffnung
+bestimmter Dateien mit POSITION='APPEND' möglich. In diesem
+Zusammenhang
+wurde das Unterprogramm close_files in close_file umbenannt und hat nun
+1 Argument.
+Anpassung der Diffusionsparametrisierung im 1D-Modell an das 3D-Modell.
+advec_particles, check_cpu_time, check_open, cpu_auswertung,
+init_1d_model,
+init_3d_model, init_particles, modules.f90, parin, parles, plot_2d,
+write_3d_binary Neu:
+close_file
Eliminiert:
+
+close_files
02/01/01
+SR 2.1a B
+Beseitigung kleiner Fehler. check_cpu_time,
+diffusion_e, diffusivities, long_filter,
+production_e 05/01/01 SR
+2.1b N Neues
+Software-Paket zur Berechnung von Spektren im
+Ortsraum check_open, header, init_3d_model,
+leap_frog, modules,
+package_parin,
+parles, read_var_list, write_3d_binary, write_var_list Neu:
+
+calc_spectra, plot_spectra
25/01/01 SR
+2.1c C/N Drucklöser
+kann jetzt die Singleton-FFT benutzen. Modul singleton
+wurde deshalb von calc_spectra.f90 nach modules.f90
+geschoben
+(neuer Initialisierungsparameter fft_method ).
+ Flüsse können jetzt bei k=1
+unabhängig von der
+Verwendung
+einer Prandtl-Schicht vorgegeben werden (neuer
+Initialisierungsparameter use_surface_fluxes ).
+ Modul test_variables wurde aus allen
+Programmteilen entfernt.
+Hauptprogramm wurde von parles nach palm
+umbenannt.
+Modell kann auf DEC-Workstations eingesetzt werden (-D dec ).
+ Zusätzliche Zeitmessungen mit dvrp-Software.
+Schreiben von
+Partikel-Informationen
+ist optional (neuer Parameter write_particle_informations ).
+advec_particles, calc_spectra, check_parameters,
+cpu_zeitmessung, diffusion_s,
+header, init_3d_model, init_dvrp, init_particles, leap_frog, modules,
+package_parin,
+parin, poisfft, read_var_list, swap_timelevel, write_var_list
+Neu:
+palm
Eliminiert:
+parles, module_test
25/01/01 SR
+2.1c B Fehler
+beim öffnen von Unit 23 beseitigt. Modul interface
+fehlte in disturb_field.
+Wertebereich von theta* in Prandtl-Fluxes eingeschränkt, weil
+sonst auf einigen Rechnern overflow droht, wenn u*=0. check_open,
+disturb_field, prandtl_fluxes 30/01/01 SR
+2.1d N/C Prognose
+eines passiven Skalars ist möglich (anstatt
+Feuchte),
+dazu neuer Initialisierungsparameter passive_scalar .
+Falls kein Pfad für ftpcopy existiert, werden in check_open
+die Dateinamen für AVS-Koordinaten- und Datendatei auf
+"unknown"
+gesetzt.
asselin_filter,
+boundary_conds, check_open, check_parameters,
+flow_statistics,
+header, init_1d_model, init_3d_model, modules, parin, plot_2d,
+plot_dvrp,
+prandtl_fluxes, prognostic_equations, read_var_list, swap_timelevel,
+write_3d_binary,
+write_var_list 30/01/01
+SR 2.1d B
+String-Ausgabe für use_surface_fluxes korrigiert.
+Version vom
+25/01/01 brach deswegen bei Fortsetzungsläufen ab.
+xy-Plotausgabe von q und ql korrigiert. plot_2d,
+write_var_list 30/03/01
+SR 2.2 N/C
+Sämtliche 3D-Felder der Zeitebene t+dt wurden
+entfernt.
+Ebenso
+die Arbeitsfelder work und work1. Hilfsfelder wurden soweit
+möglich
+eingespart und werden grundsätzlich lokal allokiert. Dadurch
+konnten
+eine Reihe von Übergabeparametern gestrichen werden (z.B. beim
+Aufruf
+von pres, advec_s_bc, poisfft, production_e, sor sowie
+den
+Spline-Unterprogrammen).
+Der Long-Filter wurde in das Upstream-Spline-Verfahren integriert. Da
+der
+Zeitfilter jetzt direkt in der prognostischen Gleichung angewendet wird
+(bisher geschah dies erst nach Aufruf des Drucklösers), haben
+sich
+die Zahlen in der Testergebnis-Datei geändert. Die mittleren
+Profile
+sind aber unbeeinflusst. Eine weitere kleinere
+Änderung der Testergebnis-Daten
+wird dadurch
+verursacht, dass jetzt der Parameter adjust_mixing_length
+defaultmäßig .FALSE.
+ist und der Mischungsweg grundsätzlich zusätzlich
+auf 0.7
+* zu begrenzt wird. Falls adjust_mixing_length=T ,
+wird jetzt der Mischungsweg in diffusivities
+analog zu diffusion_e
+an allen Gitterpunkten modifiziert. Achtung: Diese
+Änderungen
+können bei anderen Simulationen t.w. erhebliche Auswirkungen
+auf
+die
+oberflächennahen Ergebnisse haben.
Kleinere
+Änderungen: In init_cloud_physics
+wird
+der Wert der Variablen surface_pressure in hPa
+belassen
+(bisher
+Umwandlung in Pa).
+Die Namelist-Namen der Software-Pakete sind t.w.
+geändert.
+Unit 14 (binäre Ausgabe für
+Fortsetzungsläufe) wird
+jetzt im Hauptprogramm geschlossen, damit auf diese Datei noch
+benutzergesteuerte
+Ausgaben erfolgen können.
+Laufparameter werden in keinem Fall mehr auf Unit 14 ausgegeben bzw.
+von Unit 13 gelesen, d.h. sie gelten jetzt tatsächlich nur
+für
+den jeweils aktuellen Lauf.
+Partikeladvektion funktioniert jetzt auch zusammen mit der
+Galilei-Transformation.
Restliche
+deutsche Variablen-, Unterprogramm- und Modulnamen
+wurden
+ins Englische übersetzt. Davon sind fast alle Programmteile
+betroffen
+(nicht in rechter Spalte aufgeführt).
advec_particles,
+advec_s_bc, advec_s_ups, advec_u_ups,
+advec_v_ups,
+advec_w_ups, boundary_conds, calc_spectra, check_parameters,
+diffusion_e,
+init_3d_model, init_cloud_physics, init_pegrid, init_rankine,
+leap_frog,
+modules, package_parin, palm, parin, poisfft, pres, production_e,
+prognostic_equations,
+read_var_list, sor, swap_timelevel, transpose_*, write_3d_binary,
+write_var_list Neu:
+cpu_log, cpu_statistics
Eliminiert:
+
+asselin_filter, cpu_auswertung, cpu_zeitmessung, long_filter
+ 12/07/01 SR 2.2a
+N/C Defaultwert der unteren
+Randbedingung für die TKE ist ab
+sofort bc_e_b
+= 'neumann' .
+Partikelquelle ist über Paketparameter steuerbar.
+Partikeleigenschaften
+sind mittels benutzereigener Software steuerbar. Der dvrp-Ausgabeweg
+ist
+jetzt ebenfalls über Paketparameter steuerbar.
+Allen Modulen (bis auf singleton) wurde eine SAVE-Anweisung
+hinzugefügt,
+damit die durch sie vereinbarten Variablen während der
+Rechnung in
+keinem Fall undefiniert werden können (diese Gefahr besteht
+z.B.
+auf
+SGI-Origin-Maschinen). advec_particles, header,
+init_dvrp, init_particles,
+modules.f90, package_parin,
+plot_dvrp, user_interface 12/07/01
+SR 2.2a B
+Verschiebung der OPEN-Anweisung für Unit 33
+(AVS-FLD-Datei). check_open
+ 20/07/01
+SR 2.3 N
+Einbau des Mehrgitterverfahrens zur Lösung der
+Poisson-Gleichung. check_parameters,
+exchange_horiz, header, init_grid,
+init_pegrid, modules,
+parin, pres, run_control Neu:
+poismg
21/08/01
+SR 2.3a N/C
+Ergänzung der dvrp-Software: Partikel
+können mit
+Schwänzen
+versehen werden. Die Ausgabe der dvrp-Plotdaten durch einen separaten
+PE
+ist möglich (mrun-Option "-p dvrp_graphics+1PE ").
+Der
+Kommunikator MPI_COMM_WORLD
+wurde deshalb durch comm_palm
+ersetzt. Reduzierung des Mischungsweges im
+Wandbereich kann wahlweise
+abgeschaltet
+werden. Für km und kh wird jetzt eine Neumann-Randbedingung am
+unteren
+Rand verwendet. Die TKE-Energieproduktionsberechnung durch Scherung des
+Grundstroms am unteren Rand wurde verbessert.
Generelle
+Verwendung der bodennahen vertikalen
+Impulsflüsse in
+den Diffusionstermen von u und v, immer wenn diese als Randbedingung
+vorgegeben
+sind (gemäß use_surface_fluxes ,
+- bisher wurde
+dies
+nur bei eingeschalteter Prandtl-Schicht gemacht). Schubspannungen
+können
+jetzt als Randbedingungen vorgegeben werden (allerdings unter
+zuhilfenahme
+benutzereigener Software).
Zusätzliche
+Schnittstellen für benutzereigene
+Software in
+allen Tendenztermen, in flow_statistics, und
+für
+Partikel-
+bzw. dvrp-Programmteile (Bestimmung von Partikeleigenschaften,
+Festlegung
+von Farbtabellen).
Achtung: Diese
+Änderungen können bei
+Simulationen mit
+mittlerem Wind durch die Änderungen im bereich des unteren
+Randes
+t.w. erhebliche Auswirkungen auf die oberflächennahen
+Ergebnisse
+haben.
advec_particles, diffusion_e,
+diffusion_u, diffusion_v,
+diffusivities,
+flow_statistics, header, init_dvrp, init_particles, init_pegrid,
+leap_frog,
+modules, package_parin, palm, parin, plot_dvrp, production_e,
+prognostic_equations,
+read_var_list, swap_timelevel, user_interface, write_var_list
+ 21/08/01 SR 2.3a
+B Falsche Positionierung von
+MPI_ALLREDUCE in check_cpu_time
+korrigiert. check_cpu_time
+ 04/09/01
+SR 2.3b N
+Zusätzliche Profilausgaben für
+Energieproduktionsterme möglich.
+Stördruck wird bei der FFT-Methode nicht mehr durch
+Aufsummieren
+der
+Werte zu den einzelnen Zeitschritten ermittelt. check_parameters,
+flow_statistics, modules, pres 04/09/01
+SR 2.3b B
+Austausch der Geisterränder für die
+zeitgefilterten
+Felder
+direkt nach Durchführung der Filterung (war fehlerhaft seit
+Entfernen
+der Zeitebene t+dt (Version 2.2) und führte zu sehr kleinen
+Störungen
+an den seitlichen Rändern der Teilgebiete). Achtung:
+Der Inhalt der Testergebnis-Datei ändert
+sich durch
+diese Fehlerkorrektur.
prognostic_equations
+ 09/11/01 SR 2.3c
+N Farbe entlang der
+Partikelschwänze kann sich
+ändern. Einschalten
+der Partikeladvektion bei Fortsetzungsläufen möglich.
+advec_particles, init_particles, modules, package_parin,
+plot_dvrp
+16/04/02 SR
+2.3d N Vorgabe
+von Randbedingungen für Partikeladvektion
+möglich.
+Partikeldaten können für spätere Analysen
+auf Datei
+geschrieben
+werden (Unit 85). PARTICLE -Datentyp
+enthält
+Informationen
+über Partikelgeschwindigkeitskomponenten und
+Startposition. Skalartransport sowie entsprechende
+Datenausgaben können
+durch
+eigene Parameter gesteuert werden (nicht mehr über die
+Feuchteparameter).
Im Fall von
+pdims(1)=1 (eindimensionales virtuelles
+Prozessornetz in
+y-Richtung) werden die zyklischen Randbedingungen in x-Richtung durch
+direktes
+Umspeichern anstatt durch sendrecv realisiert.
+Ebenso
+werden
+die Transponierungen xz, yz, zx und zy eingespart (es wird
+aber
+weiter
+umsortiert).
Im Fall von
+3D-Plotausgaben Aufruf von ftpcopy-Script durch
+batch_scp-Script
+ersetzt (dient der Ermittelung von Dateizyklusnummern als Information
+für
+die AVS-fld-Datei).
Bei fehlerhafter
+Eröffnung einer CPU_MEASURES-Datei
+werden erneute
+Eröffnungsversuche durchgeführt.
+advec_particles, check_open, check_parameters,
+exchange_horiz, flow_statistics,
+header, init_particles, modules, package_parin, parin, plot_2d,
+plot_3d,
+prognostic_equations, read_var_list, transpose_xz, transpose_yz,
+transpose_zx,
+transpose_zy, write_var_list 02/05/02
+SR 2.3e B
+Wiedereinführung der 3D-Felder für die
+Zeitebene
+t+dt, die
+notwendig ist, damit in den Diffusionstermen bei Leapfrog-Zeitschritten
+mit der korrekten Zeitebene t-dt gearbeitet wird. Seit Version 2.2
+wurde
+fälschlicherweise die Zeitebene t+dt verwendet. Asselin-Filter
+ist
+jetzt wieder eigenständiges Unterprogramm.
+Die Wiedereinführung dieser dritten Zeitebene ist auch
+Voraussetzung
+für die in der nächsten Version geplante skalare
+Optimierung. Fehler bei Berechnung von
+Ausgabezeitpunkten eliminiert (trat
+auf, wenn
+bei Fortsetzungsläufen von Ausgabeabständen 0.0 auf
+von Null
+verschiedene Werte gewechselt werden sollte).
Achtung:
+Der Inhalt der Testergebnis-Datei ändert
+sich durch
+diese Fehlerkorrektur.
init_3d_model,
+leap_frog, modules, prognostic_equations,
+swap_timelevel Neu:
+asselin_filter
02/05/02 SR
+2.3e N/C Kleinere
+Anpassungen an IBM-Regatta-Systeme in
+check_parameters, cpu_log. Modul singleton in
+eigenständige Datei
+überführt.
Global_min_max
+arbeitet mit REAL*4, um Komplikationen auf
+32-bit-Rechnern
+zu vermeiden (Datentyp MPI_2REAL müsste dort sonst auf
+MPI_2DOUBLE_PRECISION
+geändert werden).
+Horizontale Geschwindigkeitskomponenten für Partikeladvektion
+werden exakt zwischen den jeweils benachbarten horizontalen
+Gitterflächen
+interpoliert.
advec_particles,
+check_parameters, cpu_log,
+global_min_max,
+modules Neu:
+singleton
11/06/02
+SR 2.4 N/C
+Optimierung und Anpassungen für einzelne Knoten der
+IBM-Regatta-Systeme. Skalare (Cache) Optimierung:
+Tendenzterme werden
+innerhalb einer
+großen (i,j)-Schleife berechnet, die nun jeweils die gesamte
+prognostische
+Gleichung umfasst. Schleifenindices i und j werden an die
+Tendenzunterprogramme
+als Argumente übergeben. Die Tendenzunterprogramme sind als
+Module
+geschrieben, die mittels Technik der überladenen Funktionen
+auch
+ohne
+diese Indices i und j aufgerufen werden können, und dann wie
+in
+früheren
+Versionen funktionieren (d.h. in ihnen laufen die Schleifen
+über
+alle
+3 Dimensionen). Solche Teile der prognostischen Gleichungen, die
+globale
+Kommunikation beinhalten, sind vor die (i,j)-Schleife gezogen. Falls
+ausschließlich
+mit Piascek-Williams-Advektion gearbeitet wird, werden alle
+prognostischen
+Gleichungen in einer einzigen (i,j)-Schleife gerechnet.
Kommunikationsoptimierung:
+Zusätzliche
+Implementierung einer
+1D-Gebietszerlegung in x-Richtung. Mit dem neuen direkten
+Drucklöser
+(poisfft_hybrid) werden dadurch 4 von 6 notwendigen Transpositionen
+eingespart.
+Die 1D-Zerlegung wird automatisch bei Verwendung dieses neuen
+Lösers
+aktiviert. Austausch von Geisterrändern in y-Richtung wird bei
+dieser
+1D-Zerlegung durch einfache zyklische Randbedingungen ersetzt.
+Kleinere Anpassungen: String-Vergleiche
+erfordern beim
+IBM-Compiler
+in der Regel den Einsatz der TRIM-Funktion, um
+überschüssige
+Blanks am Ende des Strings abzuschneiden (sonst liefert der Vergleich
+.F.).
+Lokal allokierte Felder t.w. in sogenannte automatische Felder
+umgewandelt
+(günstiger, um Gefahr von eventuellen Speicherlecks zu
+vermeiden).
+Einige Feldoperationen wurden wegen schlechter Performance auf der IBM
+entfernt (s. pres).
Achtung: Die
+Übersetzung des Modells erfordert
+aufgrund
+der Vielzahl nunmehr eingesetzter Module die Verwendung des
+make-Mechanismus,
+um die korrekte Reihenfolge bei der Übersetzung der
+Programmteile
+zu gewährleisten. Die Beschreibung dieser
+Abhängigkeiten
+erfolgt
+in der Datei Makefile , die zusammen mit den
+Programmdateien
+abgelegt
+ist und ebenfalls unter RCS-Verwaltung steht.
Im
+User-Interface ist das Unterprogramm user_actions nun
+ebenfalls
+als Modul geschrieben und bedient sich der Methode der
+überladenen
+Funktionen. Existierende benutzereigene Software muss entsprechend
+angepasst
+werden.
advec_s_pw, advec_s_up,
+advec_u_pw, advec_u_up, advec_v_pw,
+advec_v_up,
+advec_w_pw, advec_w_up, buoyancy, calc_precipitation, calc_radiation,
+calc_spectra,
+check_parameters, coriolis, diffusion_e, diffusion_s, diffusion_u,
+diffusion_v,
+diffusion_w, diffusivities, exchange_horiz, exchange_horiz_2d,
+global_min_max,
+header, impact_of_latent_heat, init_pegrid, leap_frog, modules,
+plot_2d,
+plot_3d, plot_spectra, poisfft, pres, production_e,
+prognostic_equations,
+user_interface, Neu:
+fft_for_1d_decomp, Makefile, poisfft_hybrid,
+ 11/06/02 SR 2.4
+B Fehlende Variablenvereinbarung in advec_particles
+ergänzt. advec_particles
+ 12/09/02 SR 2.4a
+N Partikel
+können mit Trägheit versehen
+werden und
+einen Dichteunterschied zum umgebenden Fluid haben. Zur Steuerung dient
+der neue Paketparameter density_ratio .
+advec_particles, header, init_particles,
+modules, package_parin 12/09/02 SR
+2.4a B
+Fehler in Berechnung der Anfangsprofile
+von pt
+und q entfernt
+(obere Feldgrenze von 10 konnte in pt_vertical_gradient_level_ind
+überschritten werden). Fehler führte unter
+Umständen zu
+"segmentation fault" bei Verwendung sehr großer
+Gitterpunktzahlen
+in z-Richtung. Fehler in Berechnung der v-Komponente am
+unteren Rand
+entfernt, die
+für den Scherungsproduktionsterm der TKE verwendet wird
+(Variable
+v_0). Fälschlicherweise wurde zur Berechnung u(k=1) statt
+v(k=1)
+verwendet.
check_parameters,
+modules, production_e 19/12/02 SR
+2.5 N
+Restart times can be set by user with new
+runtime (d3par)
+parameters restart_time and dt_restart .
+Run
+description
+header is written on file CONTINUE_RUN. Output of cpu statistics
+changed
+(PE results are now collected on PE0 in order to calculate mean cpu
+statistics).
+Output of warnings in the job protocol in case of negative measured
+cpu-times.
+Remaining cpu-time is also evaluated on IBM-Regatta. cpu_log, cpu_statistics,
+check_parameters,header, leap_frog,
+local_tremain, local_tremain_ini, modules, palm, new:
+
+check_for_restart
deleted:
+check_cpu_time
C Unit
+14 (BINOUT) must be opened using a special
+process
+id string, because on IBM, the PE rank differs between communicators
+MPI_COMM_WORLD
+and comm_2d. This leads to a mismatch between filename-PE-number and
+PE-number
+written on file. As the consequence, these files could not be read by
+restart-jobs.
+Reading of array hom moved from init_3d_model
+ to read_var_list
+(binary version number incremented to 2.2). Further
+optimization for IBM-Regatta-systems:
+Additional optimization of the hybrid-solver for multinode usage
+(overlapping
+of communication and computation).
Further cache
+optimization by using strides and joining loops (hybrid_solver,
+pres and timestep ). Joining of
+MPI_ALLREDUCE calls in
+timestep.
In case of 1d-decomposition along x
+only a part of the
+integral divisor
+conditions is checked, on IBM hosts a 1d-decomposition along x is the
+default,
+a switch from Poisson-FFT-solver to the hybrid-solver is made in case
+of
+1d-decomposition along x, the hybrid-solver does not force a
+1d-decomposition
+any more.
Array notation changed to do-loop
+constructs due to better
+performance.
Cyclic boundary conditions along y
+used instead of
+sendrecv
+in case of a 1d-decomposition along x . SENDRECV
+replaced by
+nonblocking
+routines ISEND and IRECV in exchange_horiz.f90 .
+Speed optimization by removing MINVAL/MAXVAL calls and by
+handling
+the "abs" case in a different way than the min/max cases (routine global_min_max ).
+ asselin_filter, check_open,
+exchange_horiz,
+global_min_max,
+init_3d_model, init_pegrid, parin, poisfft_hybrid, read_var_list,
+timestep,
+write_3d_binary, write_var_list
+ B Correction
+of mixing length term (l(k)/ll(k)).
+The condition
+kh=3*km in the unstable case is now also exactly met in the wall
+adjustment
+region. Factor 0.7 in wall adjustment part replaced by variable wall_adjustment_factor ,
+which is set to 1.8 in modules.f90 . The factor
+0.7 was the
+possible
+reason for 2-delta-x-waves, which were observed since version 2.1d. Calculation
+of deformation tensor re-designed (production_e ).
+STOP statements replaced by call of new subroutine local_stop,
+ where
+MPI_FINALIZE is called before STOP in case of a parallel environment.
+ISO2D parameter dp set to true for ibm hosts.
tend=p
+added in pres after calling sor method.
+ advec_s_bc, buoyancy,
+check_open,
+check_parameters, close_file,
+coriolis, diffusion_e, diffusivities, fft_for_1d_decomp,
+flow_statistics,
+init_3d_model, init_dvrp, init_grid, init_particles, init_pegrid,
+parin,
+plot_2d, poisfft, pres, read_var_list, user_interface, new:
+
+local_stop, production_e
+03/03/03 SR
+2.5a N
+Particle velocities are also stored in
+array
+particles in
+case of zero density ratio. Steering of variables by dvrp browser
+included. advec_particles,
+init_dvrp, modules,
+ C AVS
+data format changed from float to xdr_float
+(needed
+on linux machines
+due to the little/big endian problem). Updates for new version of dvrp
+software (e.g. using module dvrp is now mandatory). close_file, init_dvrp, leap_frog, plot_dvrp
+
+ B
+Error in particle inertia part removed
+(exp_arg
+must not
+contain the timestep).
+Error in calculation of the vertical flux of resolved scale energy
+(profile 57) removed. Displacement for integers in mpi_particle_type
+reduced
+from 16 to 8 on ibm. advec_particles,
+flow_statistics, init_particles 12/03/03 SR
+2.6 N
+Version optimized for NEC-SX6
+parallel-vector
+machines. There are two main changes. A
+new vectorizable routine prognostic_equations_vec
+is added, where cache optimizations are undone. The tendency
+subroutines
+called by prognostic_equations_vec contain the
+full 3d-loops
+(compared
+with the cache-optimized versions where only loops over k are carried
+out).
+Additionally, a new pressure solver poisfft_hybrid_vec
+is
+added,
+which requires a 1d-domain-decomposition (like poisfft_hybrid). In this
+solver, a very fast FFT from Clive Temperton (ECMWF) is
+optionally
+available by choosing fft_method = 'temperton-algorithm' .
+
Additional changes in flow_statistics
+to allow
+better vectorization.
Small changes in routines diffusivities
+and pres
+which
+caused run time errors on IBM and NEC due to compiler problems.
+Reading of environment variable tasks_per_node
+moved
+from routine poisfft_hybrid
+to routine parin .
Changes
+in makefile: modules and user_interface now
+depend on
+the f90 files, dependency of singleton added, LDFLAGS moved to the end
+of PROG rule, temperton_fft added.
advec_s_pw, advec_s_up, advec_u_pw, advec_u_up,
+advec_v_pw,
+advec_v_up, advec_w_pw, advec_w_up, buoyancy, calc_precipitation,
+calc_radiation,
+check_parameters, coriolis, cpu_log, diffusion_e, diffusion_s,
+diffusion_u,
+diffusion_v, diffusion_w, diffusivities, fft_for_1d_decomp, header,
+impact_of_latent_heat,
+init_pegrid, leap_frog, local_tremain, modules, parin, poisfft,
+poisfft_hybrid,
+pres, production_e, prognostic_equations, user_interface new:
+
+temperton_fft
+ B tend=p
+added in routine pres after
+calling sor
+method. pres
+ 14/03/03 SR 2.6a
+N Additional
+vector optimization for NEC-SX6. Optional system-specific
+random number generator available
+(for equal
+distributed numbers).
Define strings in all
+relevant subroutines changed from
+#if defined( define_string )
to
+ #if
+defined( __define_string )
Caution:
+ The relevant subroutines are NOT listed in
+the right
+column!
asselin_filter,
+check_parameters, diffusion_e,
+diffusivities,
+disturb_field, global_min_max, header, local_tremain, modules, parin,
+poisfft_hybrid,
+pres, read_var_list, write_var_list
+
+ B Error in particle boundary condition removed
+(velocity must
+be inverted in case of reflection) advec_particles
+ 16/04/03
+SR 2.6b
+N Time
+series output of Monin Obukhov length. Temperton fft can now
+be used for all hosts and every domain
+decomposition.
+Abort in case of Temperton fft, if number of gridpoints along x and/or
+y contain illegal factors.
Index values
+for the extrema found in global_min_max are
+limited to
+the range 0..nx, 0..ny (on IBM machines -1 and nx+1/ny+1 occured which
+produced different RUN_CONTROL output compared to other machines).
+Output format of iteration count in routine run_control
+enlarged.
check_parameters,
+fft_for_1d_decomp,
+global_min_max, init_pegrid,
+modules, plot_ts, poisfft, run_control, temperton_fft
+
+ B Additional checks of variables hybrid_solver
+and host
+(hybrid_solver must not be used for a
+2d-domain-decomposition, host
+should be set by setting environment variable localhost ).
+Header output for mixing length limitations revised.
+ check_parameters, header
+ 09/05/03
+SR 2.7
+N Version
+running on Linux Clusters using MPICH
+and Intel
+FORTRAN compiler (ifc) So far, only absolutely
+neccessary changes have been done
+(possible
+optimizations will follow in a later version):
New
+time measurements for Linux (ifc) environment added.
Some
+parameters in MPI calls had to be modified (arrays had to
+be replaced
+by the first element of the regarding array) in order to fulfill f90
+type
+and rank requirements, since on the MUK-cluster a FORTRAN90-version of
+MPI is used. This also required to replace "mpif.h" by using a special
+module (named mpi ). I did not find out
+how character
+strings
+can be send with MPI. Therefore, these strings are transformed to
+integers,
+before they are send, and transformed back to characters on the
+receiving
+PE.
On the MUK-cluster, only PE0 is able to read
+the values of
+environment
+variables. Therefore, these values are communicated via broadcast to
+the
+other PEs.
1d-decomposition is set as the default
+on Linux Clusters.
+Character
+strings have to be transformed to integer
Smaller
+changes:
Batch_scp paths for IBM, NEC and Linux
+added
check_open,
+cpu_log, flow_statistics,
+init_pegrid, local_getenv,
+modules, palm, poisfft_hybrid
+ B Measurements
+on IBM are now using function irtc ,
+which allows correct measurements for jobs running over the 24:00
+timeline. cpu_log,
+local_tremain, local_tremain_ini 01/08/03 SR
+2.7a B
+Check that the number processors is also
+an
+integral divisor
+of the number of gridpoints along y in case of a
+1d-decomposition
+along x. Error concerning the multinode-version of
+poisfft_hybrid
+removed. It
+was caused by the Linux changes of version 2.7 and led to program abort
+due to MPI errors in MPI_ALLTOALL .
No
+abort on t3e-systems if system specific routines are used.
Array
+sums is initialized in init_3d_model before
+the first call of pres . Call of
+init_cloud_physics moved
+before init_particles .
fft_1dd_init, init_3d_model, init_pegrid,
+poisfft_hybrid
+ N
+Interactive steering of dvrp-graphic
+features by
+dvrp-browser
+plugin extended (position of slicers, threshold values of isosurfaces)
+. New dvrp_graphics package parameter slicer_range_limits_dvrp .
+init_dvrp, modules, package_parin,
+plot_dvrp 29/10/03
+SR 2.7b
+N In
+the multigrid method, on a defined level,
+data are gathered
+on PE0 and further calculations are carried out only on this PE. New
+d3par parameter mg_switch_to_pe0_level .
+Particle groups implemented. New data type
+particle_groups_type and data type particle_type modified.
+Version
+numbers are
+output on the particle files. New particles_par parameter
+diameter . Parameter name uniform_psize
+changed to
+dvrp_psize .
+Parameters density_ratio is now an array.
+ advec_particles, check_open,
+exchange_horiz,
+header, init_particles,
+init_pegrid, modules, package_parin, parin, poismg
+
+ C Random number generator from numerical recipes
+is now rewritten
+as a module. In restart runs the seed of this generator is set to the
+last
+values of the previous run in order to keep the sequence of the random
+numbers. New binary version 2.2. Buffer is flushed for file
+RUN_CONTROL immediately after every
+output
+on IBM and Linux cluster.
advec_particles,
+disturb_field, init_3d_model,
+init_particles,
+random_function, random_gauss, run_control, write_3d_binary
+
+ E In routine buoyance, horizontal mean
+temperature
+is now
+taken from array hom instead of array sums (otherwise inconsistence in
+case of using more than one statistical region). Information
+about the time of the last timestep change added
+to the
+restart file.
System call of batch_scp on
+IBM corrected.
buoyancy,
+check_open, read_var_list,
+write_var_list 28/01/04 SR 2.8 N Runge-Kutta schemes (2nd and
+3rd
+order)
+for time integration implemented. The third order scheme is the new
+default.
+It allows the timestep to be 0.9*CFL, which is much larger than for the
+former default leapfrog scheme. The intermediate steps, which
+are
+part of these schemes, are realized by an additional loop within routine
+time_integration (currently
+leap_frog , but this routine will be renamed soon).
+Steering
+variables
+at and
+bt have
+been replaced by array
+sct .
+, which is particularly used in the prognostic equations. Values of
+this
+steering array are calculated within the new routine
+timestep_scheme_steering . When using Runge-Kutta
+schemes, the timestep increment
+is freely
+allowed to adjust after each timestep (the older schemes are using some
+restrictions, see routine
+timestep ).
+Also, routine
+run_control is
+not automatically called in case of timestep changes, when Runge-Kutta
+schemes are switched on.
The old leapfrog scheme
+is still implemented and should
+produce the
+same results as in the previous version(s)!
Depending
+on the user experience, further adjustments to the
+Runge-Kutta
+schemes may be necessary within the next minor versions.
+Attention:
+
+The content of the testresult-file (run control output) has
+significantly
+changed due to the new default timestep scheme!
check_parameters, header,
+init_3d_model,
+init_rankine, leap_frog, modules, prognostic_equations, read_var_list,
+swap_timelevel, timestep, write_var_list new:
+timestep_scheme_steering
+ C Output of particle infos in
+subroutine
+allocate_prt_memory on demand only. Type log (used
+for
+cpu time measurements) changed to
+logpoint due to name conflict with FORTRAN
+intrinsic
+log.
advec_particles,
+cpu_log, E In case of opening unit 80, a
+barrier
+is set only for the first call of
+check_open (from routine
+init_particles ), in order to avoid the possibility of
+hanging
+jobs,
+which may occur if unit 80 is opened within routine
+allocate_prt_memory . check_open
+ 30/01/04
+SR 2.8a N In order to prepare the code
+for
+the simulation
+of flow around buildings (to be realized in one of the next major
+versions),
+the lower k index
+nzb has been replaced by a two-dimensional array
+nzb_2d in many of the three-dimensional loops. So
+far, all
+elements of this array are set to
+nzb . This change should not effect simulation
+results and cpu time
+in any
+way.
advec_s_pw,
+advec_s_up,
+advec_u_pw, advec_u_up,
+advec_v_pw, advec_v_up, advec_w_pw, advec_w_up, asselin_filter,
+buoyancy,
+calc_liquid_water_content, calc_precipitation, calc_radiation,
+coriolis,
+diffusion_e, diffusion_s, diffusion_u, diffusion_v, diffusion_w,
+diffusivities,
+impact_of_latent_heat, init_3d_model, modules, production_e,
+prognostic_equations, C Euler step informations are
+removed in
+the run control output in case of Runge-Kutta schemes. Also, the
+timestep
+increment limitation is removed for the Runge-Kutta schemes. Attention:
+The content of the testresult-file (run control output) has changed
+due to this modification.
run_control, timestep
+
+
+ E Velocity gradients at the
+surface calculated
+in routine production_e are now limited. In case of inhomogeneous
+surface
+heating small diffusivities (km )
+sometimes caused very small timesteps due to this problem. production_e
+ 30/04/04
+ SR
+ 2.8b
+ N
+The number of processors
+along
+the respective directions of the virtual processor grid must not be
+integral divisors of the number of gridpoints along x, y or z any more.
+In case that they are not integral divisors, the subdomains on the
+processors at the upper borders of the virtual grid will contain less
+gridpoints than the other subdomains (which are all of equal size).
+Although this causes a load imbalance, only runs with very small
+numbers of processors will feel a significant decrease of performance.
+In order to be able to carry out the transpositions, array d (and also
+working array tend )
+have the same size on
+all processors. This new feature is switched on by setting the
+inipar-parameter
+grid_matching = 'match' ,
+which is the
+default now.
+Routine poisfft is
+now
+the
+default for solving the Poisson-equation for the case of 2d- as well as
+1d-domain-decompositions and has been changed from a subroutine to a
+module. This routine now includes most of the optimization from the
+(Ketelsen) routine
+poisfft_hybrid and additionally allows 1d-decompositions
+along y. ATTENTION:
+Routine
+poisfft_hybrid might still be
+faster when running PALM on more than one node of the IBM-Regatta,
+although the difference is not very big. The poisfft -code
+for a
+decomposition along y has still a poor performance and needs further
+optimization.
+The spectra-package is now able to use all the available FFT-methods
+(selected by inipar-parameter
+fft_method ).
+Performance of the transpositions needed for calculating the spectra
+has been improved by using new direct transpositions from z to y and
+from y to x instead of two subsequent transpositions.
+Runge-Kutta scheme implemented in the 1d-version (init_1d_model ).
+Diffusion
+quantity arrays are allocated for previous timelevels only in case of
+leapfrog scheme.
+This version is adapted for use on COMPAQ-DECALPHA systems (main
+changes: calling of SHAPE function within subroutine arguments (e.g. singleton )
+causes compiler errors, particle data type modified for better
+alignment, DATA statements from modules removed because they caused
+internal compiler errors). advec_s_ups, advec_u_ups,
+advec_v_ups, advec_w_ups, calc_spectra, check_parameters, fft_xy,
+header, init_1d_model, init_3d_model, init_particles, init_pegrid,
+modules, parin, plot_2d, poisfft, prandtl_fluxes, pres, read_var_list,
+singleton, spline_x, spline_y, spline_z, time_integration, transpose,
+write_3d_binary, write_var_list
+ C FFT routines renamed. Module fft_for_1d_decomp renamed fft_xy .
+Subroutine leap_frog
+ renamed
+time_integration .
+For all transpositions, MPI_ALLTOALL is used instead of MPI_ALLTOALLV.
+The names of many transposition indices have been changed.
+Inipar-parameter
+impulse_advec renamed momentum_advec .
+
+Reading of restart data is moved from init_3d_model to
+new routine read_3d_binary .
+
+All former transpose routines collected into one file.
+check_parameters,
+flow_statistics, header, init_1d_model, init_3d_model, init_advec,
+init_pegrid, palm, parin, poisfft, poisfft_hybrid, production_e,
+prognostic_equations, read_var_list, sline_x, spline_y, write_var_list
+new:
+fft_xy, read_3d_binary, time_integration, transpose
+deleted:
+fft_for_1d_decomp, leap_frog, transpose_xy, transpose_xz, transpose_yx,
+transpose_yz, transpose_zx, transpose_zy
+
+ E Small errors in the
+particle-package removed, which sometimes caused aborts of restart runs
+on IBM.
+Small error in calculating the time series profiles removed (array
+bounds of some arrays needed for profil-output had to be increased).
+
+Function fft (singleton method) replaced by subroutine fftn due to
+problems with 64-bit mode on IBM advec_particles,
+check_parameters, 26/03/05
+SR
+2.9
+N Non-cyclic lateral boundary
+conditions implemented.
+Dirichlet/Neumann conditions at the inflow/outflow can be used either
+along x or along y. Cyclic conditions have to be used along the
+remaining direction. In case of non-cyclic conditions along x (y), the
+upper bound nxl (nyn) of array u (v) is enlarged by one gridpoint on
+the rightmost (northest) processor. These array index informations are
+passed to routine
+exchange_horiz and
+disturb_field by two
+additional arguments. Boundary conditions are set with new
+inipar-parameters
+bc_lr and
+bc_ns . A damping layer is
+needed at the outflow in order to damp reflections (see new parameters km_damp_max and outflow_damping_width )
+and an
+additional disturbance is imposed near the inflow (see new parameters
+inflow_disturbance_begin and inflow_disturbance_end ).
+Non-cyclic conditions require the use of the multigrid-method for
+solving the Poisson equation. Argument range added
+to routine
+boundary_conds (where the
+non-cyclic conditions are set).
+Minor changes:
+Output of parameter
+datform on
+&GLOBAL-Namelist (iso2d). This is set to 'big_endian' on
+IBM- and
+NEC-machines.
+Number of particle groups are additionally calculated in header (formerly
+unknown). advec_u_pw,
+advec_u_up, advec_v_pw, advec_v_up, boundary_conds,
+calc_liquid_water_content, check_parameters, close_file, coriolis,
+diffusion_u, diffusion_v, diffusion_w, diffusivities, disturb_field,
+exchange_horiz, header, init_3d_model, init_pegrid, init_pt_anomaly,
+init_rankine, modules, parin, poismg, pres, prognostic_equations,
+read_var_list, sor, time_integration, timestep, write_var_list
+ C pres is called
+by default only
+at the last Runge-Kutta-substep, which spares a big amount of CPU-time
+(see also new parameter
+call_psolver_at_all_substeps ). No pressure term in the
+momentum
+equations in case of Runge-Kutta-schemes. Attention:
+The content of the testresult-file (run control output) has changed
+due to this modification.
+Program speedup by removing the exchange of ghost points in routines calc_liquid_water_content ,
+diffusivities ,
+.
+Default value for residual limit increased from 1E-6 to 1E-4. Routine prolong in poismg simplified
+(one call of
+exchange_horiz spared). calc_liquid_water_content,
+diffusivities, modules, poismg, pres, time_integration,
+timestep_scheme_steering
+ E Calculation of vertical
+particle
+velocity (with inertia) corrected, exp_arg had a wrong sign.
+(e)**1.5 replaced by e*SQRT(e) in init_1d_model because of wrong
+results on NEC machines (as a side effect, the new calculation is much
+faster).
+Two errors concerning switch to PE0 (multigrid method) removed from init_pegrid .
+
+Two errors in
+plot_2d removed:
+local_2d is allocated with upper bound nzt (former nzt+1 was
+wrong), additional barrier in case that PE0 gathers data from the other
+PEs, this barrier had to be set at the end of the gathering because
+otherwise PE0 sometimes received wrong data on tag 0.
+Use of module indices removed from routine split_1dd in poisfft since
+it caused
+errors in case of nx
+/= ny and
+a 1D-decomposition along y.
+Wrong re-definition of dx2 and dy2 in sor removed.
+ advec_particles,
+init_1d_model,
+init_pegrid, plot_2d, poisfft, sor
+23/04/05
+SR
+2.9a
+C Additional check for
+incompatibilities between non-cyclic lateral boundary conditions and
+other schemes.
+fcl_factor renamed cfl_factor.
+New local array sums_ll declared in flow_statistics instead of
+temporarily using sums_l.
+crmax (maximum number of crosses allowed in a plot of vertical
+profiles) increased from 20 to 100. calc_spectra, check_parameters,
+flow_statistics, header, modules, parin, timestep
+
+
+ E Revised calculation of output
+time counters regarding a possible decrease of the output time interval
+in case of restart runs.
+Error removed in Dirichlet bottom boundary conditions for pt and q in
+case of Runge-Kutta schemes. batch_scp calls
+(needed
+for determining correct filenames for AVS-fld-files) is given the
+remote username as an additional argument.
+Default setting of outflow_damping_width corrected.
+Initial horizontal velocities at the lowest grid levels in the 1d-model
+are set to a very small value in order to avoid wrong results and the
+resulting too small timesteps.
+Implicit counters i renamed i9 in modules due to declaration conflicts
+with i in other subroutines (reported by Portland compiler).
+advec_particles,
+boundary_conds,
+check_open, check_parameters, init_1d_model, modules, time_integration
+ 18/05/05
+SR
+2.10
+N NetCDF support implemented.
+Profiles, time series, spectra, cross-sections, 3d-volume-data and
+particle data can now be output in NetCDF format (file handles
+101-108). This output can be switched on with the new d3par-parameter data_output_format .
+So far, this support is available on IBM systems at HLRN and on the NEC
+system at DKRZ. Output in format suitable for graphic software profil , iso2d and avs is still
+possible.
+Output of cross sections for qv, vpt and lwp (liquid water path).
+ advec_particles,
+check_open,
+check_parameters, close_file, header, modules, parin, plot_1d, plot_2d,
+plot_3d, plot_spectra, plot_ts, read_var_list, write_var_list
+ new:
+netcdf C In calc_spectra , n
+is assigned the
+number of spectra (formerly, the number of spectra was given by n-1)
+
+Abort if poisfft_hybrid
+is called in a non-parallel environment.
+Default values of spectra package parameters pl_spectra and spectra_direction
+changed. calc_spectra,
+check_parameters,
+modules, pres, read_3d_binary, write_3d_binary
+
+ E Missing argument in ffty
+(non-parallel case) added.
+Error in output of particle inertia information removed.
+poisfft, header
+ 05/07/05
+SR
+2.11
+N/C
+New cloud physics code
+implemented, which explicitly simulates single cloud droplets,
+including droplet growth by condensation and collision. Using this code
+requires to set the new inipar-parameter cloud_droplets
+= .TRUE. and to use the particle package (by using the mrun -option -p particles ).
+Coupling between droplets and the thermodynamic quantities (potential
+temperature and specific humidity) is regarded in the new subroutine interaction_droplets_ptq .
+The real number of droplets in a grid cell can steered by the new
+inipar-parameter initial_weighting_factor .
+ This code
+will be further extended and probably changed in the near future, so
+the current status is that of a test version!
+In connection with this new code implementation, several changes has
+been made to the existing code:
+The particle (droplet) size is now given as radius (previously
+diameter). E.g., the name of the respective package parameter diameter has
+changed to radius .
+
+The current weighting_factor and radius are stored as additional
+particle attributes in the type structure particle_type .
+The MPI data type mpi_particle_type ,
+needed for exchanging particles between subdomains, has been changed
+correspondingly. gas_constant is
+renamed r_d ,
+latent_heat
+is renamed r_v ,
+the allowed string length of pl2d
+and pl3d
+is increased from 6 to 10.
+New 3d arrays ql_1 ,
+ql_2 , ql_v and ql_vp , ql is now a
+pointer, new pointer ql_c .
+
+Data format for unit 85 (particle data output) is changed. advec_particles.f90
+check_open.f90, header.f90, init_3d_model.f90, init_cloud_physics.f90,
+init_particles.f90, modules.f90, package_parin.f90, parin.f90,
+plot_2d.f90, plot_3d.f90, read_var_list.f90, time_integration.f90,
+write_var_list.f90 new:
+interaction_droplets_ptq.f90 C Default value of call_psolver_at_all_substeps
+is .TRUE. ,
+because small scale waves occured with .FALSE. modules.f90
+
+ E 2d- and 3d-NetCDF-files are not
+opened if there is no output for them (pl2d = pl3d = ' ' ).
+No opening of units 101 - 108 in case of missing NetCDF support.
+check_open.f90, netcdf.f90
+ 30/06/05
+GS
+2.11a
+C Scalars ug and vg have been
+changed into
+arrays in order to allow the specification of a geostrophic wind that
+depends on height (baroclinicity). The initial profiles of the the
+u- and v-component of the geostrophic wind are initialized by
+specifying the new initialization parameters ug_surface , ug_vertical_gradient ,
+ug_vertical_gradient_level
+and vg_surface ,
+vg_vertical_gradient ,
+vg_vertical_gradient_level ,
+respectively.
+The former initialization parameters ug and vg have been
+removed. boundary_conds,
+check_parameters, coriolis, header, init_1d_model, modules, parin,
+prognostic_equations, read_var_list, spline_z, write_var_list
+ E Error in the calculation of u_0
+and
+v_0 in production_e.f90 removed. Attention:
+The content of the testresult-file (run control output) has changed
+due to this modification. production_e
+ 20/10/05
+SR 2.11b N/C Collision process for droplet
+growth completed. The droplet code is still under
+development and requires further speed optimization!
+ Number of particles really used is additionally output on
+the netcdf particle data file.
+advec_particles, modules,
+netcdf E The
+last PE in a row is not allowed to have more grid points than the other
+PES (only less). Jobs crashed in these cases that the last PE has more
+grid points. Therefore, the number of gridpoints along x (and y) must
+now meet a special condition which is checked in case that grid_matching =
+'match' is
+used.
+Error removed in calculating y axis data for yz cross sections. Error
+in output of netcdf yz-cross-sections removed.
+2*r replaced by r in the exponential term of the particle momentum
+equation.
+Error in output of yz-slice information removed. advec_particles, header,
+init_pegrid, netcdf, plot_2d 06/12/05 SR 2.11c N Output of ql profile is allowed
+in case of using cloud droplets. check_parameters,
+flow_statistics, modules E The horizontally averaged pt
+profile is calculated within
+buoyancy only
+in case of the first respective intermediate timestep. This is done in
+order to spare communication time and to produce identical model
+results with jobs which are calling flow_statistics at
+different time intervals.
+Error in netcdf variable declaration for statistic_regions /=
+0 removed.
+buoyancy, netcdf
+ 23/02/06 SR 3.0 N Version for simulating flows over
+topography (buildings, mountains, etc.) Besides
+the implementation of topography, this version contains several other
+improvements. The most important ones are listed here:The
+cloud droplet code has been optimized (it now runs about 100 times
+faster than before). Output of time-averaged 2d/3d
+data (sections / volume data) is possible. Output
+of 2d-section data averaged along the direction normal to this section
+can be done. The user-interface has been extended
+in order to allow 2d-/3d-output of user-defined quantities. The
+kind of topography to be used is controlled by the new initialization
+parameter topography .
+Allowed values are 'flat' ,
+'single_building' ,
+and 'read_from_file' .
+The user can define his own special topography setting within the new
+user-interface routine user_init_grid .
+For the single building case, the building (rectangular) size
+and position can be controlled with parameters building_height ,
+building_length_x ,
+building_length_y ,
+building_wall_left ,
+and building_wall_south .
+
+The topography code is already optimized (vectorized) for use on the
+NEC-SX6. Output of time-averaged 2d-/3d-data can be
+enabled by appending the string '_av'
+to the respective output quantities given with the new
+runtime-parameter data_output
+(see further below for the (name)changes in the parameters for data
+output). Example: if a time-average of the vertical cross-section of
+potential temperature is required, the user has to set data_output = 'pt_xy_av' .
+In case of NetCDF-output, the time-averaged data is output to
+additional files (seperate from the non-averaged output). The length of
+the averaging interval and the temporal distance of the single
+instantaneous sections (volumes) entering into this averaging is
+controlled by the new runtime-parameters averaging_interval and
+dt_averaging_input .
+ An average normal to the direction of a
+cross-section can be output by setting the respective cross section
+index to -1
+(example: section_xz
+= -1 ). New
+user-interface routines allowing the output of user-defined quantities
+are user_check_data_output ,
+user_define_netcdf_grid ,
+user_data_output_2d ,
+user_data_output_3d ,
+and user_3d_data_averaging .
+These quantities can be calculated using the new CASE -Entry 'after integration'
+in the user-interface routine user_actions . Optimization
+of the cloud droplet code is mainly done by re-sorting all particles
+after every timestep in a way that now all particles which belong to
+the same grid-box (k,j,i) are stored consecutively (wthout any strides)
+in memory.
+Code adaptation for the IBM at the department of atmospheric sciences,
+Yonsei university (ibmy). Affected subroutines: fft_xy , netcdf , Further new features: Use
+of particle tails now requires setting of the new package-parameter use_particle_tails .
+The new parameter skip_particles_for_tail allows only every skip_particle_for_tail 'th
+parameter having a tail. Initialization-parameter e_min can be
+used to set a lower limit for the subgrid-scale TKE (i.e. to guarantee
+a lower limit for the flow's Reynolds-number). A
+conservation of the volume flow (through the complete xz- and
+yz-sections of the total domain) can be enforced by the new
+initialization-parameter conserve_volume_flow . Data
+output can be skipped for a given time interval from simulation start
+(t=0) using new runtime-parameters skip_time_dopr ,
+skip_time_dosp ,
+skip_time_do2d_xy ,
+skip_time_do2d_xz ,
+skip_time_do2d_yz ,
+and skip_time_do3d .
+ By default, NetCDF output is now using 64-bit
+offset format
+(large file support) on most machines. The user can switch to the
+32-bit offset format with the new runtime-parameter netcdf_64bit .
+Units 111:113 and 116 are opened for NetCDF output of
+time-averaged 2d-3d data. Data
+logging routines are added (see file data_log.f90), which can be used
+for debugging purposes. Output is done on unit 20 (local file
+name/directory name DATA_LOG). New routine exchange_horiz_2d_int
+for ghostpoint exchange of 2d-integer arrays. Routine exchange_horiz_2d
+is extended for non-cyclic boundary conditions in the non-parallel case.
+Two different methods for calculating the mixing length and
+the dissipation can be used in the 1d-model. These are steered by the
+new initializing-parameters dissipation_1d
+and mixing_length_1d .
+
+advec_particles,
+advec_s_pw,
+advec_s_up, advec_u_pw, advec_u_up, advec_v_pw, advec_v_up, advec_w_pw,
+advec_w_up, boundary_conds, buoyancy, check_open, check_parameters,
+close_file, coriolis, diffusion_e, diffusion_s, diffusion_u,
+diffusion_v, diffusion_w, diffusivities, disturb_field,
+disturb_heatflux, exchange_horiz_2d, exchange_horiz, flow_statistics,
+header, init_1d_model, init_3d_model, init_grid, init_particles,
+init_pegrid, modules, netcdf, package_parin, parin, poisfft,
+prandtl_fluxes, pres, production_e, prognostic_equations,
+read_3d_binary, read_var_list, run_control, time_integration,
+user_interface, write_3d_binary, write_var_list new:
+average_3d_data, data_log, sum_up_3d_data renamed: plot_dvrp
+-> data_output_dvrp
+plot_spectra -> data_output_spectra
+plot_ts -> data_output_tseries
+plot_1d -> data_output_profiles plot_2d ->
+data_output_2d
+plot_3d -> data_output_3d
+ C In
+parallel mode, all PEs are opening the same copy of the
+NAMELIST-parameter file PARIN ,
+i.e. from now on, the file attribute "npe " must be
+removed from the corresponding file connection statements in the mrun configuration
+file (.mrun.config). A
+large number of parameter names and local filenames have been changed
+(see list below). Most of them are parameters concerning data
+output (do). The former denotations "plot" and "pl" have been changed
+to "data_output" and "do", respectively. In addition to these changes,
+the names of many internal PALM parameters and variables have also
+changed. Restart runs now require setting of the
+initialization-parameter initializing_actions
+= 'read_restart_data' .
+
+Concerning particles, the parameters psl , psr , pdx ,
+etc., which are controlling the position of the particle source and the
+number of particles within this source, are now 1d-arrays. This allows
+to define different particle sources for different particle groups.
+
+The number of particle groups has to be set by the user (no automatic
+calculation from the value of parameter density_ratio
+any more) .
+Variable idum
+in type particle_type
+has been renamed tail_id . Output
+for units 15 and 17 flushed in init_1d_model . List
+of changed parameter names:Old name New name Comments average_period_pl1d averaging_interval_pr
+average_period_pr1d --- averaging of printed profiles
+is not possible any more average_period_sp averaging_interval_sp
+dt_average dt_averaging_input_pr
+dt_pl1d dt_dopr
+dt_plsp dt_dosp
+dt_plts dt_dots dt_pr1d dt_dopr_listing
+dt_pl2d_xy dt_do2d_xy
+dt_pl2d_xz dt_do2d_xz
+dt_pl2d_yz dt_do2d_yz
+ebene_xy section_xy
+ebene_xz section_xz
+ebene_yz section_yz
+nz_plot3d nz_do3d
+plts data_output_ts
+pl1d data_output_pr
+pl2d data_output old parameters pl2d and pl3d
+are joined to new parameter data_output pl3d data_output
+pl2d_at_begin do2d_at_begin
+pl3d_at_begin do3d_at_begin
+pl3d_compress do3d_compress
+pl3d_precision do3d_comp_prec
+pl_spectra data_output_sp read_fields_from_prior_run read_restart_data
+write_plot2d_on_each_pe data_output_2d_on_each_pe
+z_max_pl1d z_max_do1d
+z_max_pl2d z_max_do2d
+
advec_particles,
+advec_s_bc, check_parameters, check_open, close_file,
+data_output_dvrp, data_output_profiles, data_output_tseries,
+data_output_2d, data_output_3d, flow_statistics, header, init_1d_model,
+init_3d_model, init_dvrp, init_particles, init_pegrid, init_slope,
+modules, netcdf, package_parin, palm, parin, print_1d, read_var_list,
+run_control, time_integration, timestep, write_compressed,
+write_var_list
+ E Error in
+the particle release (defaults of psl , psr , psn , pss ) at the PE
+boundary has been fixed.
+Error removed getting the variable ids for _ext for
+profiles and time series. NetCDF calls in data_output_tseries
+only if NetCDF output is switched on. Output of the
+initial geostrophic wind profile corrected. Maximum
+possibel timestep for Runge-Kutta-schemes reduced, error concerning
+initialization of l_black
+removed (both in init_1d_model ).
+ advec_particles,
+data_output_tseries, header, init_particles, init_1d_model, netcdf
+ 26/04/06 SR 3.0a N OpenMP parallelization for
+the cache-optimized PALM code. OpenMP
+directives have been added where necessary. Still further tuning will
+be necessary to get optimum performance. Other parts of the code than
+the cache-optimized code still need to be (OpenMP-) parallelized. So
+far, threads are activated by setting the mrun -options -T <number_of_threads>
+and -O ,
+i.e. when the Option -O
+is given, the -T
+argument is interpreted as the number of threads to be used. When -O is given,
+the number of MPI tasks per node is automatically set to 1 . Beside
+the additional compiler directives, the main code change required by
+the OpenMP parallelization is that global sums are now calculated by
+first calculating local sums on each thread. As the next step, local
+sums are calculated from these thread sums for each MPI task before the
+global sum is computed via MPI_ALLREDUCE. For storing the
+thread
+sums, arrays sums_l and sums_l_l now have three dimensions where the
+number of elements of the third dimension is equal to the number of
+OpenMP threads. buoyancy,
+cpu_statistics, diffusivities, flow_statistics, header, init_pegrid,
+init_3d_model, modules, prandtl_fluxes, pres, production_e ML C Provisional
+correction for Piacsek & Williams advection scheme: keep u and
+v
+zero one layer below the topography (in case of set_1d-model_profiles). init_3d_model SR/ML E In flow_statistics.f90
+nzb_s_inner(j,i) replaced by nzb in determination of z_i. Errors
+removed in the computation of the diabatic mixing length (init_1d_model.f90 ). Error
+removed in extend mode when checking whether the selected cross
+sections match those in the already existing NetCDF file (netcdf.f90 ). flow_statistics,
+init_1d_model, netcdf 02/06/06 SR 3.0b N This version is adapted to the Sun Fire X4600
+system at TIT (to be used by setting the mrun option -h lctit ). cpu_log, init_1d_model,
+local_tremain, locaö_tremain_ini, run_control C NetCDF 2d-
+and 3d-datasets now contain the exact coordinates of the variables
+along x and y with respect to the positions where they are defined on
+the staggered grid. NetCDF datasets of cross
+sections (e.g. DATA_2D_XY_NETCDF )
+are only opened if the respective cross sections are really requested
+by the settings of parameter data_output . check_parameters,
+data_output_2d, data_output_3d, modules, netcdf, user_interface E p is assigned to to_be_resorted
+instead of w data_output_2d 04/08/06 SR 3.1 N Subgrid
+scale velocities can (optionally) be included for calculating the
+particle advection, using the method of Weil et al. (2004, JAS, 61,
+2877-2887). This method is switched on by the new particle package
+parameter use_sgs_for_particles .
+This also forces the Euler/upstream method to be used for time
+advancement of the TKE (see new parameter use_upstream_for_tke ).
+The minimum timestep during the sub-timesteps is controlled by
+parameter dt_min_part .
+The data type particle_type
+has additional new attributes e_m ,
+dt_sum ,
+and speed_x/y/z_sgs . Other
+new particle features: output of particle quantities as timeseries in
+NetCDF format (on local file DATA_1D_PTS_NETCDF ).
+The output time interval is controlled by parameter dt_dopts .
+Particle advection can be switched off after some time using parameter end_time_prel .
+More than one particle per point can be started with parameter particles_per_point . Additional
+parameter in function random_gauss
+which limits the range of the created random numbers to five times the
+standard deviation (=1). Seeds iran
+and iran_part
+are stored for restart runs. advec_particles,
+check_open, check_parameters, close_file, diffusion_e,
+disturb_heatflux, header, init_3d_model, init_particles, modules,
+netcdf, package_parin, parin, prognostic_equations, random_gauss,
+read_3d_binary, read_var_list, time_integration, write_3d_binary,
+write_var_listnew: data_output_ptseries C Call of subroutine header is moved
+after call of subroutine init_3d_model .
+Generation of run_description_header
+is moved from routines palm
+and header
+to check_parameters .
+Determination of the number of particle groups is moved from header to init_particles .izuf renamed iran . check_parameters,
+disturb_field, disturb_heatflux, header, init_particles, modules, palm E Variables
+do2d_unit and do3d_unit now defined as 2d-arrays. Before, in some
+cases, the units of variables in the 2d- and 3d-NetCDF-files have been
+wrong. In routine poisfft default
+setting of the thread number tn in case of not using OpenMP. Error
+removed in the non-parallel part of routine flow_statistics
+(number of arguments of array sums_l ). Error
+removed which appeared if the user had decreased the value of dt_dopr within
+a job chain and if simulataneous time averaging of profiles was
+switched on. check_parameters,
+data_output_profiles, flow_statistics, modules, netcdf, poisfft 22/08/06 SR 3.1a N In case of more than one
+particle group, seperate output of timeseries for each of the groups. New
+initial parameter dz_max ,
+which limits the vertical gridspacing in case of a vertically stretched
+grid. data_output_ptseries,
+header, init_grid, modules, netcdf, parin, read_var_list, write_var_list C Disturbances are imposed only
+for the last Runge-Kutta-substep. Attention:
+The content of the testresult-file (run control output) has changed
+due to this modification. Output of xz and yz cross
+sections now up to gridpoint nzt+1. Default settings
+of particle start positions changed. check_open, close_file,
+data_output_2d, init_particles, netcdf, time_integration E Initialisation of all tendency
+arrays (t.._m) needed for the Runge-Kutta schemes. Bugfix
+in index array initialization for line- or point-like topography
+structures. Bugfix: yv coordinates are now used for
+yz cross sections, where neccessary. init_3d_model, init_grid, netcdf 12/02/07 SR 3.1b N Attention: This
+is the last revision before switching to the subversion revison control
+system! Informative output to the job protocoll in
+case of restarts.check_for_restart C Values of environment variables
+are now read from local file ENVPAR
+instead of getting them by a system call. For
+interpolation in advec_particles ,
+allways level k is used. advec_particles,
+local_tremain_ini, parin E Several bugfixes in advec_particles :
+new particles are released only if end_time_prel
+> simulated_time , transfer
+of particles when x < -0.5*dx (0.0 before), etc., index i,j used
+instead of cartesian (x,y) coordinate to check for transfer because
+this failed under very rare conditions, calculation of number of
+particles with same radius as the current particle (cloud droplet code). Allocation
+of tail_mask
+and new_tail_id
+in case of restart-runs. "__" added in a cpp-directive. (both init_particles ) advec_particles, init_particles 02/03/07 SR 3.1c N A heatflux can be prescribed at
+the top with new inipar parameters top_heatflux
+and use_top_fluxes .
+New 2d-arrays qswst ,
+qswst_m ,
+tswst
+and tswst_m
+are used to store this flux. Use of fluxes are controlled with new
+index variable nzt_diff .
+A Neumann boundary condition for temperature can be applied under these
+conditions. Additionally, a Dirichlet condition for
+temperature can be used at the top.Attention:
+The content of the testresult-file (run control output) has changed
+due to this modification. check_parameters,
+diffusion_s, flow_statistics, header, init_grid, init_3d_model,
+modules, parin, production_e, prognostic_equations, read_var_list,
+read_3d_binary, swap_timelevel, write_var_list, write_3d_binary C Prognostic equations for all
+scalars are now solved up to gridpoint nzt (formerly nzt-1).
+Boundary conditions for scalars at top adjusted respectively (now
+applied only at nzt+1). The
+default top boundary condition for temperature has been renamed to 'initial_gradient' . Calls
+of dvrp_output_local,
+which were commented out for a long time, are now activated for all
+streams. advec_s_pw,
+boundary_conds, calc_precipitation, check_parameters, diffusion_e,
+diffusion_s, impact_of_latent_heat, init_dvrp, init_pt_anomaly,
+modules, production_e, prognostic_equations, spline_z E Bugfix: 3d-array p is not a
+pointer any more. Bugfix in init_particles:
+MPI_REAL
+argument in MPI_ALLREDUCE
+replaced by MPI_INTEGER
+(caused error on NEC only). Bugfix: ddzw now
+dimensioned 1:nzt"+1". diffusion_e, diffusion_s,
+diffusion_u, diffusion_v, diffusion_w, init_particles, modules 29/03/07 SR 3.2 N The code, including scripts, utility programs and documentation is now under full control of subversion . This revision includes a quite large number of new features, changes and bugfixes. Particle reflection from vertical walls implemented. The particle SGS model is also adjusted to these vertical walls. Wall functions for vertical walls now include diabatic conditions. New subroutines wall_fluxes , wall_fluxes_e . New 4D-array rif_wall . Calculation/output of precipitation amount, precipitation rate and z0 (by setting "pra* ", "prr* ", "z0* " with data_output ). The time interval on which the precipitation amount is defined is set by new d3par-parameter precipitation_amount_interval . New inipar-parameter loop_optimization to control the loop optimization method. New
+inipar-parameter pt_reference . If given, this value is used as the
+reference that is used in the buoyancy terms (otherwise, the instantaneous
+horizontally averaged temperature is used). New d3par-parameter netcdf_64bit_3d
+to switch on and especially to switch off 64bit offset for 3D
+files only (because still some pd-software is unable to handle 64bit
+offset). New d3par-parameter dt_max to set the maximum value allowed for the timestep. New user interfaces user_advec_particles and user_init_3d_model . The new initializing action "by_user " calls user_init_3d_model and allows the initial setting of all 3d arrays under complete user control. Samples added to the user interface which show how to add user-define time series quantities. Topography height informations are stored on arrays zu_s_inner and zw_w_inner and output to the 2d/3d NetCDF files. Unit 9 is generally opened for output of debug informations (file DEBUG_<pe#> ). Makefile advec_particles,
+average_3d_data, buoyancy, calc_precipitation, check_open,
+check_parameters, data_output_2d, diffusion_e, diffusion_u,
+diffusion_v, diffusion_w, diffusivities, header, impact_of_latent_heat,
+init_particles, init_3d_model, modules, netcdf, parin, production_e,
+read_var_list, read_3d_binary, sum_up_3d_data, user_interface,
+write_var_list, write_3d_binarynew: wall_fluxes C General revision of non-cyclic horizontal boundary conditions: Radiation boundary conditions are now used instead of Neumann conditions at the outflow (calculation needs velocity values for t-dt , which are stored on new arrays u_m_l , u_m_r , etc.). The calculation of a mean outflow is not needed any more. Volume flow control is added for the outflow boundary (currently only for the north boundary!! ). Additional gridpoints along x and y (uxrp , vynp ) are not needed any more and removed from the code. Routine "boundary_conds " now operates on timelevel t+dt and is not split in two parts (main , uvw_outflow ) any more. Neumann boundary conditions are used at inflow/outflow in case of non-cyclic boundary conditions for all 2d-arrays that are handled by exchange_horiz_2d .Attention: the
+non-cyclic boundary conditions of this revision still contain some bugs
+which will be removed within the next revisions! The Bott-Chlond-scheme can now be used in the vectorization-optimized part (NEC, etc.). Equations are solved up to gridpoint nzt . The
+FFT-method for solving the Poisson-equation is now working with Neumann
+boundary conditions both at the bottom and the top. This requires
+adjustments of the tridiagonal coefficients and subtracting the
+horizontally averaged mean from the vertical velocity field. Particles-package is now part of the default code ("-p particles " is not needed as an mrun -option any more). New attribute age_m in particle_type . Move call of user_actions ( 'after_integration ' ) below the increments of times and counters. user_actions is now called for each statistic region and has as an argument the number of the respective region (sr ). d3par-parameter data_output_ts is removed. Timeseries output for profil -software removed. Timeseries are now switched on by setting dt_dots . Timeseries data is collected in flow_statistics . Initial velocities at nzb+1
+are regarded for volume flow control in case they have been set zero
+before (to avoid small timesteps); see new internal parameters u/v_nzb_p1_for_vfc .q is not allowed any more to become negative (prognostic_equations ).poisfft_init is only called if the fft-solver is switched on (init_pegrid ). d3par-parameter moisture renamed to humidity . Subversion global revision number is read from mrun and added to the run description header and to the run control (_rc ) file.__vtk directives removed from main program. The uitility routine interpret_config now reads PALM environment variables from NAMELIST instead using the system call GETENV . advec_s_bc, advec_u_pw,
+advec_u_up, advec_v_pw, advec_v_up, asselin_filter, boundary_conds, check_parameters,
+coriolis, data_output_dvrp, data_output_ptseries, data_output_ts,
+data_output_2d, data_output_3d, diffusion_u, diffusion_v,
+disturb_field, exchange_horiz, exchange_horiz_2d, flow_statistics, header, init_grid,
+init_particles, init_pegrid, init_rankine, init_pt_anomaly,
+init_1d_model, init_3d_model, modules, palm, package_parin, parin,
+poisfft, poismg, prandtl_fluxes, pres, production_e,
+prognostic_equations, read_var_list, read_3d_binary, sor,
+swap_timelevel, time_integration, write_var_list, write_3d_binary E Bugfix: preset of tendencies te_em , te_um , and te_vm (init_1d_model ). Bugfix in sample for reading user defined data from restart file (user_init ). Bugfix in setting diffusivities for cases with the outflow damping layer extending over more than one subdomain (init_3d_model ). Check for possible negative humidities in the initial humidity profile. In Makefile , default suffixes are removed from the suffix list to avoid calling of m2c in cases of existing .mod files (problem on Linux systems). Makefile check_parameters, init_1d_model, init_3d_model, user_interface 19/04/07 SR 3.2a C All system relevant compile and link options (e.g. cpp-directives,
+library paths, etc.) as well as the host identifier (local_host) are
+now specified in the configuration file. This generally allows to install
+PALM on any kind of Linux-, IBM-AIX-, or NEC-SX-system by adding
+appropriate
+settings to the configuration file. A description is added to chapter
+5.0 of the online documentation. Scripts are also running under the public domain ksh. Filetransfer by ftp removed (options -f removed from mrun and mbuild ). Call of (system-)FLUSH routine moved to new routine local_flush .return_addres and return_username are read from ENVPAR-NAMELIST-file instead of using local_getenv . Preprocessor strings for different linux clusters changed to "lc ", some preprocessor directives renamed (new: __intel_openmp_bug which is used for the bug in tridia_1dd and the OpenMP directives). Preprocessor directives for old systems have been removed. advec_particles,
+check_open, cpu_log, cpu_statistics, data_output_dvrp, flow_statistics,
+header, init_dvrp, init_particles, init_1d_model, init_dvrp,
+init_pegrid, local_getenv, local_system, local_tremain,
+local_tremain_ini, modules, palm, parin, run_controlnew: local_flushchanged scripts: mbuild, mrun, .mrun.config.default 30/05/07 SR 3.2b N Calculation and output of user-defined profiles: New userpar-parameter data_output_pr_user . In the user-interface, routine user_check_data_output_pr has been added and user_statistics has been extended. check_parameters, flow_statistics, modules, parin, read_var_list, user_interface, write_var_list C In pres.f90 , division through dt_3d
+replaced by multiplication of the inverse. For performance
+optimisation, this is done in the loop calculating the divergence
+instead of using a seperate loop. Variables var_hom and var_sum are both renamed pr_palm . data_output_profiles, flow_statistics, init_3d_model, modules, parin, pres, read_var_list, run_control, time_integration E Bugfix: work_fft*_vec removed from some PRIVATE-declarations (poisfft ). Bugfix: field_chr renamed field_char (user_interface ). Bugfix: output of use_upstream_for_tke (header ). header, poisfft, user_interface 21/06/07 SR 3.3 N This version allows runs for the ocean. These runs can be switched on with the new inipar-parameter ocean . Setting this switch has several effects:An additional prognostic equation for salinity is solved. Potential temperature in buoyancy and stability-related terms is replaced by potential density. Potential
+density is calculated from the equation of state for seawater after
+each timestep, using the algorithm proposed by Jackett et al. (2006, J.
+Atmos. Oceanic Technol., 23 , 1709-1728). So far, only the initial hydrostatic pressure is entered into this equation. z=0 (sea surface) is assumed at the model top (vertical grid index k=nzt on the w-grid), with negative values of z indicating the depth. Initial profiles are constructed (e.g. from pt_vertical_gradient / pt_vertical_gradient_level ) starting from the sea surface, using surface values given by pt_surface , sa_surface , ug_surface , and vg_surface . Zero salinity flux is used as default boundary condition at the bottom of the sea. If switched on, random perturbations are by default imposed to the upper model domain from zu(nzt*2/3) to zu(nzt-3). Relevant new inipar-parameters to be exclusively used for steering ocean runs are bc_sa_t , bottom_salinityflux , sa_surface , sa_vertical_gradient , sa_vertical_gradient_level , and top_salinityflux . Salinity (sa ) and potential density (rho ) are included as new 2d/3d output quantities. Vertical profiles of salinity (sa ), salinity fluxes (w"sa" , w*sa* , wsa ), and potential density (rho ) can also be output. advec_s_bc, average_3d_data, boundary_conds, buoyancy, check_parameters, data_output_2d, data_output_3d, diffusion_e, diffusivities, flow_statistics, header, init_grid, init_3d_model, modules, netcdf, parin, production_e, prognostic_equations, read_3d_binary, read_var_list, sum_up_3d_data, swap_timelevel, time_integration, user_interface, write_var_list, write_3d_binarynew: eqn_state_seawater, init_ocean C Inipar-parameter use_pt_reference renamed use_reference. Internal variable hydro_press renamed hyp , routine calc_mean_pt_profile renamed calc_mean_profile . The format of the RUN_CONTROL file has been adjusted for ocean runs. Defaults of .._vertical_gradient_levels changed from -1.0 to -9999999.9 . advec_particles, buoyancy, calc_liquid_water_content, check_parameters, diffusion_e, diffusivities, header, init_cloud_physics, modules, production_e, prognostic_equations, run_control E Bugfix: height above topography instead of height above level k=0 is used for calculating the mixing length (diffusion_e and diffusivities ). Bugfix: error in boundary condition for TKE removed (advec_s_bc ). advec_s_bc, diffusion_e, diffusivities 05/10/07 SR 3.4 N This version allows runs for a coupled atmosphere-ocean LES. Coupling frequency is controlled by new d3par-parameter dt_coupling , the coupling mode ('atmosphere_to_ocean ' or 'ocean_to_atmosphere ') for the respective processes is read from environment variable coupling_mode , which is set by the mpiexec-command in mrun . Communication between the two models is handled by the intercommunicator comm_inter . Local files opened by the ocean model get the additional suffic "_O ".
+Saturation at k=nzb is assumed for the atmosphere coupled to ocean.
+Usage of the coupled model is described in the new section 3.8. A momentum flux can be set as top boundary condition using the new inipar parameters top_momentumflux_u|v . Non-cyclic boundary conditions can be used along all horizontal directions. Quantities w*p* and w"e can be output as vertical profiles. Initial profiles are reset to constant profiles in case that initializing_actions /= 'set_constant_profiles '. (init_rankine) Optionally calculate km and kh from initial TKE e_init.
+ boundary_conds,
+check_open, check_parameters, diffusion_u, diffusion_v,
+flow_statistics, header, init_pegrid, init_rankine, init_3d_model,
+local_stop, modules, palm, parin, prandtl_fluxes, pres,
+prognostic_equations, read_var_list, read_3d_binary, swap_timelevel,
+timestep, time_integration, write_var_list, write_3d_binarynew: surface_coupler C Remaining variables iran changed to iran_part (advec_particles, init_particles). In case that the presure solver is not called for every Runge-Kutta substep (call_psolver_at_all_substeps = .F. ),
+it is called after the first substep instead of the last. In that case,
+random perturbations are also added to the velocity field after the
+first substep. Initialization of km , kh = 0.00001 for ocean = .T. (for ocean = .F. it remains 0.01). Allow data_output_pr = 'q ', 'wq ', 'w"q" ', 'w*q* ' for humidity = .T. (instead of cloud_physics = .T. ). advec_particles, check_for_restart, check_parameters, init_particles, init_3d_model, time_integration E Bugs from code parts for non-cyclic boundary conditions are removed: loops for u and v are starting from index nxlu , nysv ,
+respectively. The radiation boundary condition is used for every
+Runge-Kutta substep. Velocity phase speeds for the radiation boundary
+conditions are calculated for the first Runge-Kutta substep only and
+reused for the further substeps. New arrays c_u , c_v , and c_w
+are defined for this purpose. Several index errors are removed from the
+radiation boundary condition code parts. Upper bounds for calculating u_0 and v_0 (in production_e) are nxr+1 and nyn+1 because otherwise these values are not available in case of non-cyclic boundary conditions. +dots_num_palm in module user, +module netcdf_control in user_init (both in user_interface) Bugfix: wrong sign removed from the buoyancy production term in the case use_reference = .T. (production_e) Bugfix: Error message concerning output of particle concentration (pc) modified (check_parameters). Bugfix: Rayleigh damping for ocean fixed. advec_u_pw,
+advec_u_up, advec_v_pw, advec_v_up, boundary_conds, buoyancy,
+check_parameters, coriolis, diffusion_u, diffusion_v, header,
+init_pegrid, init_3d_model, modules, poismg, production_e,
+prognostic_equations, user_interface 29/11/07 SR 3.4a N Pressure boundary conditions for vertical walls added to the multigrid solver. They are applied using new wall flag arrays (wall_flags_.. ) which are defined for each grid level. New argument gls added to routine user_init_grid (user_interface ). Plant canopy model of Watanabe (2004,BLM 112,307-341) added. It can be switched on by the new inipar parameter plant_canopy . The inipar parameter canopy_mode can
+be used to prescribe a plant canopy type. The default case is a
+homogeneous plant canopy. Heterogeneous distributions of the leaf area
+density and the canopy drag coefficient can be defined in the new
+routine user_init_plant_canopy (user_interface ). The inipar parameters lad_surface , lad_vertical_gradient and lad_vertical_gradient_level can be used to prescribe the vertical profile of leaf area density. The inipar parameter drag_coefficient determines the canopy drag coefficient. Finally, the inipar parameter pch_index determines the index of the upper boundary of the plant canopy. Allow new case bc_uv_t = 'dirichlet_0' for channel flow. For unknown variables (CASE DEFAULT) call new subroutine user_data_output_dvrp . Frequence of sorting particles can be controlled with new particles_par parameter dt_sort_particles . Sorting is moved from the SGS timestep loop in advec_particles after the end of this loop. advec_particles,
+check_parameters, data_output_dvrp, header, init_3d_model, init_grid,
+init_particles, init_pegrid, modules, package_parin,
+parin, read_var_list, user_interface, write_var_listnew: plant_canopy_model C Redefine initial nzb_local as the actual total size of topography (later the extent of topography in nzb_local is reduced by 1dx at the E topography walls and by 1dy at the N topography walls to form the basis for nzb_s_inner ); for consistency redefine 'single_building' case. Vertical profiles now based on nzb_s_inner ; they are divided by ngp_2dh_s_inner (scalars, procucts of scalars) and ngp_2dh (staggered velocity components and their products, procucts of scalars and velocity components), respectively. Allow two instead of one digit to specify isosurface and slicer variables. Status of 3D-volume NetCDF data file only depends on switch netcdf_64bit_3d (check_open).prognostic_equations include the respective wall_*flux in the parameter list of calls of diffusion_s . Same as before, only the values of wall_heatflux(0:4) can be assigned. At present, wall_humidityflux , wall_qflux , wall_salinityflux , and wall_scalarflux are kept zero. diffusion_s uses the respective wall_*flux instead of wall_heatflux .
+This update serves two purposes: - it avoids errors in calculations
+with humidity/scalar/salinity and prescribed non-zero wall heatflux, -
+it prepares PALM for a possible assignment of wall fluxes of
+humidity/scalar/salinity in a future releases. buoyancy,
+check_open, data_output_dvrp, diffusion_s, diffusivities,
+flow_statistics, header, init_3d_model, init_dvrp, init_grid, modules,
+prognostic_equations E Bugfix: summation of sums_l_l (diffusivities ). Several bugfixes in the ocean part: Initial density rho is calculated (init_ocean ). Error in initializing u_init and v_init removed (check_parameters ). Calculation of density flux now starts from nzb+1 (production_e ). Bugfix: pleft /pright changed to pnorth /psouth in sendrecv of particle tail numbers along y, small bugfixes in the SGS part (advec_particles ). Bugfix: model_string needed a default value (combine_plot_fields ). Bugfix: wavenumber calculation for even nx in routines maketri (poisfft ). Bugfix: assignment of fluxes at walls. Bugfix: absolute value of f must be used when calculating the Blackadar mixing length (init_1d_model ). advec_particles,
+check_parameters, combine_plot_fields, diffusion_s, diffusivities,
+init_ocean, init_1d_model, poisfft, production_e
+
+
Attention:
+If make is not used
+for
+compiling,
+all routines have to be re-compiled after every
+change
+to modules.f90!
+
+
+ 2.0 How
+to change the model source
+code
+Änderungen, Erweiterungen oder Fehlerkorrekturen am Modellcode
+(gemeint
+sind alle Modellteile, die nicht zur benutzereigenen Software
+gehören)
+erfordern vom jeweiligen Benutzer Gruppenzugehörigkeit zur
+Gruppe
+"palm" .
+Zu dieser Gruppe gehören alle Benutzer, die aktiv an der
+Modellentwicklung
+mitwirken (im weiteren "Modellarbeitsgruppe" genannt).
+Die einzelnen Quelltextdateien des Modells werden mit RCS
+(Revision
+Control System) verwaltet. Grundlegende Kenntnisse über dieses
+System
+werden im weiteren vorausgesetzt.
+
Änderungen am Modellcode erfordern die
+Durchführung
+bestimmter
+Aktionen in einer festgelegten Reihenfolge, die nun beschrieben werden
+sollen.
+
Konzeptplanung. Diskussion
+der geplanten Änderungen in der
+Modellarbeitsgruppe. Auschecken der
+benötigten Quelltextdateien,
+Durchführung der
+Änderungen und Test des Modells. Die Modul-Datei modules.f90
+sollte nur dann ausgecheckt werden, wenn dort aufgeführte
+Variablen
+verändert werden. Neu geschaffene Variablen sollten
+während
+der
+Testphase in ein ebenfalls temporär neu zu schaffendes Modul
+geschrieben
+werden, das von den jeweiligen Programmteilen benutzt werden muss
+(Einfügen
+entsprechender USE-Anweisungen). Die in den einzelnen Dateien
+durchgeführten
+Arbeiten müssen in den Kopfzeilen (unter "Aktuelle
+Aenderungen")
+der
+Dateien vermerkt werden. Dies tut man am besten noch bevor
+man
+die
+eigentlichen Änderungen durchführt (sonst droht das
+Vergessen...). Zum Abschluß der Tests
+sollte mit dem Modell eine
+Kontrollrechnung
+durchgeführt und die Ergebnisse mit denen des sogenannten
+Standardlaufes
+verglichen werden. Diese Rechnung ist mit der Konfigurationsdatei
+und der Parameterdatei
+durchzuführen, die auch zum Testen der Modellinstallation
+verwendet
+werden (s. Kapitel
+5.0 der
+Anwenderdokumentation).
+Die Ergebnisdatei mit dem lokalen Namen RUN_CONTROL
+ist dann mit der Beispiel-Ergebnisdatei
+zu vergleichen (Hinweis: Kopien der Konfigurationsdatei, Parameterdatei
+und Beispiel-Ergebnisdatei erhält man durch anklicken der
+entsprechenden
+Links mit der linken Maustaste bei gleichzeitig gedrückter
+<SHIFT>-Taste).
+Werden Abweichungen zwischen den beiden Ergebnisdateien festgestellt,
+so
+ist unbedingt eine Diskussion in der Modellarbeitsgruppe notwendig.
+Nach Durchführung der Tests müssen bei
+Bedarf die
+vorläufig
+im temporären Modul eingetragenen Variablen in die
+eigentlichen
+Module
+des Modells übertragen werden. Dazu ist die Modul-Datei modules.f90
+auszuchecken. Nach Eintrag der Variablen sollte das Modell noch einmal
+testweise übersetzt werden, um Sytaxfehler
+auszuschließen
+(evtl.
+auch noch einmal einen Probelauf starten). Die Verwendung des
+temporären
+Moduls ist aus allen entsprechenden Programmteilen zu entfernen.
+Vergabe einer neuen Versionsnummer (Variable version
+im
+Modul steuer ),
+Bsp.: 2.3c. Kleinere Änderungen werden durch
+angehängten
+kleinen
+Buchstaben kenntlich gemacht, größere
+Änderungen durch
+die Zahl hinter dem Punkt. Eine Inkrementierung der Zahl vor dem Punkt
+geschieht nur bei ganz grundsätzlichen Revisionen des Modells,
+die
+weite Teile des Modellcodes betreffen. Nun
+können die ausgecheckten Dateien wieder eingecheckt
+werden.
+Vor
+dem Einchecken sind in den Dateien die Vermerke unter "Aktuelle
+Aenderungen"
+zu entfernen und beim check-in - Kommando als Log-Text anzugeben. Sie
+erscheinen
+dann in der jeweiligen Datei unter "Fruehere Aenderungen" zusammen mit
+der vom RCS-System vergebenen Versionsnummer (dafür sorgt die
+$Log:
+... $ - Zeile, die in jeder Quelltextdatei steht). Eine
+Zusammenfassung der durchgeführten Arbeiten ist im Kapitel
+1.0 einzutragen. Die
+Modellarbeitsgruppe ist über den Abschluß der
+durchgeführten
+Arbeiten zu informieren.
+
+ 3.0 Description
+of selected parts of the
+model source code
+This chapter is still under construction (Feb. 04).
+Dieser Abschnitt verweist auf vorhandene Beschreibungen der
+genauen
+Funktionsweise einzelner, spezieller Modellteile. Dazu gehört
+z.B.
+die Beschreibung bestimmter numerischer Verfahren (auch ihr
+theoretischer
+Hintergrund), die Erklärung besonderer Prinzipien bei der
+Parallelisierung
+oder Erläuterungen zur Vorgehensweise bei der Lösung
+bestimmter
+Aufgaben (z.B. der Berechnung horizontal gemittelter
+Größen).
+ Die Beschreibungen liegen in jeweils getrennten Dokumenten,
+in der
+Regel als TeX- und/oder Postscript-Datei vor und sind über die
+folgenden
+Links zugänglich.
+
+
upstream-spline
+advection scheme ( .ps
+) cloud
+physics module ( .pdf
+) Datenkompression
+mit dem Verfahren
+der Bitverschiebung
+ Runge-Kutta
+time integration scheme ( .pdf
+)
+
+
+
+
+
+
+
+
+
+
Index: /palm/tags/release-3.4a/INSTALL/example_p3d
===================================================================
--- /palm/tags/release-3.4a/INSTALL/example_p3d (revision 141)
+++ /palm/tags/release-3.4a/INSTALL/example_p3d (revision 141)
@@ -0,0 +1,39 @@
+ &inipar nx = 39, ny = 39, nz = 40,
+ dx = 50.0, dy = 50.0, dz = 50.0,
+ dz_stretch_level = 1200.0,
+
+ fft_method = 'temperton-algorithm',
+
+ initializing_actions = 'set_constant_profiles',
+ ug_surface = 0.0, vg_surface = 0.0,
+ pt_vertical_gradient = 0.0, 1.0,
+ pt_vertical_gradient_level = 0.0, 800.0,
+
+
+ surface_heatflux = 0.1, bc_pt_b = 'neumann', /
+
+
+ &d3par end_time = 3600.0,
+
+ create_disturbances = .T.,
+ dt_disturb = 150.0, disturbance_energy_limit = 0.01,
+
+ dt_run_control = 0.0,
+
+ data_output = 'w_xy', 'w_xz', 'w_xz_av', 'pt_xy', 'pt_xz',
+
+ dt_data_output = 900.0,
+ dt_data_output_av = 1800.0,
+ averaging_interval = 900.0,
+ dt_averaging_input = 10.0,
+
+ section_xy = 2, 10, section_xz = 20,
+
+ data_output_2d_on_each_pe = .F.,
+
+ dt_dopr = 900.0,
+ averaging_interval_pr = 600.0, dt_averaging_input_pr = 10.0,
+ data_output_pr = '#pt', 'w"pt"', 'w*pt*', 'wpt', 'w*2', 'pt*2',
+ z_max_do1d = 1500.0, /
+
+
Index: /palm/tags/release-3.4a/INSTALL/example_rc
===================================================================
--- /palm/tags/release-3.4a/INSTALL/example_rc (revision 141)
+++ /palm/tags/release-3.4a/INSTALL/example_rc (revision 141)
@@ -0,0 +1,482 @@
+
+ ************************* ------------------------------------------
+ * PALM 3.4 Rev: 110 * atmosphere - 3D - run without 1D - prerun
+ ************************* ------------------------------------------
+
+ Date: 05-10-07 Run: example
+ Time: 07:44:33 Run-No.: 00
+ Run on host: ibmh
+ Number of PEs: 8 Processor grid (x,y): ( 8, 1) forced
+ A 1d-decomposition along x is forced
+ because the job is running on an SMP-cluster
+ ------------------------------------------------------------------------------
+
+ Numerical Schemes:
+ -----------------
+
+ --> Solve perturbation pressure via FFT using temperton-algorithm routines
+ perturbation pressure is calculated at every Runge-Kutta step
+ --> Momentum advection via Piascek-Williams-Scheme (Form C3) or Upstream
+ --> Scalar advection via Piascek-Williams-Scheme (Form C3) or Upstream
+ --> Loop optimization method: cache
+ --> Time differencing scheme: runge-kutta-3
+ ------------------------------------------------------------------------------
+
+
+ Run time and time step information:
+ ----------------------------------
+
+ Timestep: variable maximum value: 20.000 s CFL-factor: 0.90
+ Start time: 0.000 s
+ End time: 3600.000 s
+
+
+ Computational grid and domain size:
+ ----------------------------------
+
+ Grid length: dx = 50.000 m dy = 50.000 m dz = 50.000 m
+ Domain size: x = 2000.000 m y = 2000.000 m z(u) = 2862.511 m
+
+ dz constant up to 1200.000 m (k= 25), then stretched by factor: 1.080
+ maximum dz not to be exceeded is dz_max = ********** m
+
+ Number of gridpoints (x,y,z): (0: 39, 0: 39, 0: 41)
+ Subdomain size (x,y,z): ( 5, 40, 42)
+
+ Subdomains have equal size
+
+
+ Topography informations:
+ -----------------------
+
+ Topography: flat
+
+
+ Boundary conditions:
+ -------------------
+
+ p uv pt
+
+ B. bound.: p(0) = p(1) | uv(0) = -uv(1) | pt(0) = pt(1)
+ T. bound.: p(nzt+1) = 0 | uv(nzt+1) = ug(nzt+1), vg(nzt+1) | pt(nzt+1) = pt(nzt) + dpt/dz_
+
+ e
+
+ B. bound.: e(0) = e(1)
+ T. bound.: e(nzt+1) = e(nzt) = e(nzt-1)
+
+ Bottom surface fluxes are used in diffusion terms at k=1
+ Predefined constant heatflux: 0.100000 K m/s
+
+
+ Prandtl-Layer between bottom surface and first computational u,v-level:
+
+ zp = 25.00 m z0 = 0.1000 m kappa = 0.40
+ Rif value range: -5.00 <= rif <= 1.00
+
+
+ Lateral boundaries:
+ left/right: cyclic
+ north/south: cyclic
+
+
+ List output:
+ -----------
+
+ 1D-Profiles:
+ Output every ******** s
+ Time averaged over 600.00 s
+ Averaging input every 10.00 s
+
+
+ Data output:
+ -----------
+
+ Time averaged over 600.00 s
+ Averaging input every 10.00 s
+
+ 1D-Profiles:
+ Output format: netcdf
+
+
+ Profile: pt, w"pt", w*pt*, wpt, w*2, pt*2,
+ Output every 900.00 s
+ Time averaged over 600.00 s
+ Averaging input every 10.00 s
+
+ 2D-Arrays:
+ Output format: netcdf
+
+
+ XY-cross-section Arrays: w, pt,
+ Output every 900.00 s
+ Cross sections at k = /2/10/
+ scalar-coordinates: /75.0/475.0/ m
+
+
+ XZ-cross-section Arrays: w, pt,
+ Output every 900.00 s
+ Cross sections at j = /20/
+ scalar-coordinates: /1000.0/ m
+
+
+ 2D-Arrays(time-averaged):
+ Output format: netcdf
+
+
+ XZ-cross-section Arrays: w,
+ Output every 1800.00 s
+ Time averaged over 900.00 s
+ Averaging input every 10.00 s
+ Cross sections at j = /20/
+ scalar-coordinates: /1000.0/ m
+
+
+ Time series:
+ Output format: netcdf
+
+ Output every 0.00 s
+
+ ------------------------------------------------------------------------------
+
+
+ Physical quantities:
+ -------------------
+
+ Angular velocity : omega = 0.729E-04 rad/s
+ Geograph. latitude : phi = 55.0 degr
+ Coriolis parameter : f = 0.000119 1/s
+ f* = 0.000084 1/s
+
+ Gravity : g = 9.8 m/s**2
+
+ Characteristic levels of the geo. wind component ug:
+
+ Height: 0.0 0.0 m
+ ug: 0.00 0.00 m/s
+ Gradient: ------ 0.00 1/100s
+ Gridpoint: 0 0
+
+ Characteristic levels of the geo. wind component vg:
+
+ Height: 0.0 0.0 m
+ vg: 0.00 0.00 m/s
+ Gradient: ------ 0.00 1/100s
+ Gridpoint: 0 0
+
+ Characteristic levels of the initial temperature profile:
+
+ Height: 0.0 0.0 800.0 m
+ Temperature: 300.00 300.00 300.00 K
+ Gradient: ------ 0.00 1.00 K/100m
+ Gridpoint: 0 0 16
+
+
+ LES / Turbulence quantities:
+ ---------------------------
+
+ Mixing length is limited to 1.80 * z
+
+
+ Actions during the simulation:
+ -----------------------------
+
+ Disturbance impulse (u,v) every : 150.00 s
+ Disturbance amplitude : 0.25 m/s
+ Lower disturbance level : 125.00 m (GP 3)
+ Upper disturbance level : 625.00 m (GP 13)
+ Disturbances cease as soon as the disturbance energy exceeds 0.010 m**2/s**2
+ Random number generator used : numerical-recipes
+
+
+
+ *** no user-defined variables found
+
+ ------------------------------------------------------------------------------
+
+
+
+Run-control output:
+------------------
+
+RUN ITER. HH:MM:SS.SS DT(E) UMAX VMAX WMAX U* W* THETA* Z_I ENERG. DISTENERG DIVOLD DIVNEW UMAX(KJI) VMAX(KJI) WMAX(KJI) ADVECX ADVECY MGCYC
+-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+ 0 0 00:00:00.00 20.0000A -0.2192D -0.2169D -0.1214 0.000 1.38 0.000 800. 0.106E-02 0.106E-02 0.000E+00 0.000E+00 11 32 5 5 37 29 4 26 0 0.000 0.000 0
+ 0 1 00:00:20.00 20.0000A -0.2192 -0.2169 -0.1214 0.001 0.79 ****** 150. 0.106E-02 0.106E-02 0.437E-05 0.287E-15 11 32 5 5 37 29 4 26 0 0.000 0.000 0
+ 0 2 00:00:40.00 20.0000D -0.2170 -0.2168 -0.1216 0.001 0.79 ****** 150. 0.106E-02 0.106E-02 0.439E-05 0.295E-15 11 32 5 5 37 29 4 26 0 0.000 0.000 0
+ 0 3 00:01:00.00 20.0000D -0.2146 -0.2174 -0.1218 0.001 0.79 ****** 150. 0.106E-02 0.106E-02 0.442E-05 0.301E-15 11 32 5 4 5 2 4 26 0 0.000 0.000 0
+ 0 4 00:01:20.00 20.0000D -0.2119 -0.2192 -0.1220 0.001 1.29 ****** 650. 0.106E-02 0.106E-02 0.444E-05 0.307E-15 11 32 5 4 5 2 4 26 0 0.000 0.000 0
+ 0 5 00:01:40.00 20.0000D -0.2090 -0.2207 -0.1221 0.001 1.05 ****** 350. 0.106E-02 0.105E-02 0.445E-05 0.312E-15 11 32 5 4 5 2 4 26 0 0.000 0.000 0
+ 0 6 00:02:00.00 20.0000D -0.2059 -0.2220 -0.1222 0.001 1.05 ****** 350. 0.106E-02 0.105E-02 0.446E-05 0.316E-15 11 32 5 4 5 2 4 26 0 0.000 0.000 0
+ 0 7 00:02:20.00 20.0000D -0.2026 -0.2230 -0.1223 0.001 1.05 ****** 350. 0.106E-02 0.105E-02 0.445E-05 0.320E-15 11 32 5 4 5 2 4 26 0 0.000 0.000 0
+ 0 8 00:02:40.00 20.0000D -0.2048D -0.2236D -0.1223 0.002 1.05 ****** 350. 0.211E-02 0.210E-02 0.502E-03 0.735E-13 6 0 13 4 5 2 4 26 0 0.000 0.000 0
+ 0 9 00:03:00.00 20.0000D 0.3655 -0.2781 -0.1545 0.002 1.05 ****** 350. 0.210E-02 0.210E-02 0.645E-05 0.629E-15 4 35 4 5 3 15 5 10 39 0.000 0.000 0
+ 0 10 00:03:20.00 20.0000D 0.3644 -0.2782 -0.1534 0.002 1.05 ****** 350. 0.210E-02 0.209E-02 0.643E-05 0.635E-15 4 35 4 7 14 12 5 10 39 0.000 0.000 0
+ 0 11 00:03:40.00 20.0000D 0.3618 -0.2787 -0.1522 0.002 1.05 ****** 350. 0.210E-02 0.209E-02 0.641E-05 0.644E-15 4 35 4 7 14 12 5 10 39 0.000 0.000 0
+ 0 12 00:04:00.00 20.0000D 0.3577 -0.2783 -0.1508 0.002 1.05 ****** 350. 0.209E-02 0.209E-02 0.640E-05 0.655E-15 4 35 4 7 14 12 5 10 39 0.000 0.000 0
+ 0 13 00:04:20.00 20.0000D 0.3521 -0.2784 -0.1492 0.002 1.05 ****** 350. 0.209E-02 0.208E-02 0.639E-05 0.666E-15 4 35 4 7 13 38 5 10 39 0.000 0.000 0
+ 0 14 00:04:40.00 20.0000D 0.3451 -0.2830 -0.1475 0.002 1.05 ****** 350. 0.208E-02 0.208E-02 0.639E-05 0.679E-15 4 35 4 7 13 38 5 10 39 0.000 0.000 0
+ 0 15 00:05:00.00 20.0000D 0.3369D -0.2870D -0.1492 0.002 1.09 ****** 400. 0.315E-02 0.314E-02 0.500E-03 0.720E-13 4 35 4 7 13 38 5 14 27 0.000 0.000 0
+ 0 16 00:05:20.00 20.0000D 0.4067 -0.3928 -0.2200 0.003 1.09 ****** 400. 0.314E-02 0.313E-02 0.834E-05 0.984E-15 11 16 39 7 13 12 8 21 26 0.000 0.000 0
+ 0 17 00:05:40.00 20.0000D 0.4077 -0.3940 -0.2210 0.003 1.09 ****** 400. 0.313E-02 0.313E-02 0.837E-05 0.100E-14 11 16 39 7 13 12 8 21 26 0.000 0.000 0
+ 0 18 00:06:00.00 20.0000D 0.4066 -0.3929 -0.2218 0.003 1.09 ****** 400. 0.313E-02 0.312E-02 0.843E-05 0.102E-14 11 16 39 7 13 12 8 21 26 0.000 0.000 0
+ 0 19 00:06:20.00 20.0000D 0.4033 -0.3896 -0.2223 0.003 1.09 ****** 400. 0.313E-02 0.312E-02 0.854E-05 0.105E-14 11 16 39 7 13 12 8 21 26 0.000 0.000 0
+ 0 20 00:06:40.00 20.0000D 0.3979 -0.3842 -0.2226 0.004 1.09 ****** 400. 0.313E-02 0.312E-02 0.870E-05 0.108E-14 11 16 39 7 13 12 8 21 26 0.000 0.000 0
+ 0 21 00:07:00.00 20.0000D 0.3905 -0.3783 -0.2225 0.004 1.09 ****** 400. 0.314E-02 0.313E-02 0.891E-05 0.112E-14 11 16 39 8 34 19 8 21 26 0.000 0.000 0
+ 0 22 00:07:20.00 20.0000D -0.3882 -0.3787 -0.2221 0.005 1.28 ****** 650. 0.315E-02 0.315E-02 0.919E-05 0.116E-14 8 2 33 8 34 19 8 21 26 0.000 0.000 0
+ 0 23 00:07:40.00 20.0000D -0.3895D -0.3795D 0.2353 0.005 1.28 ****** 650. 0.427E-02 0.426E-02 0.510E-03 0.750E-13 8 2 33 7 14 26 2 15 28 0.000 0.000 0
+ 0 24 00:08:00.00 20.0000D -0.4530 0.4560 0.2930 0.006 1.28 ****** 650. 0.431E-02 0.429E-02 0.120E-04 0.156E-14 5 15 27 10 34 34 2 15 28 0.000 0.000 0
+ 0 25 00:08:20.00 20.0000D -0.4651 0.4519 0.3245 0.007 1.28 ****** 650. 0.437E-02 0.435E-02 0.125E-04 0.164E-14 5 15 27 10 34 34 2 15 28 0.000 0.000 0
+ 0 26 00:08:40.00 20.0000D -0.4754 0.4441 0.3621 0.008 1.28 ****** 650. 0.445E-02 0.444E-02 0.132E-04 0.173E-14 5 15 27 10 34 34 2 15 28 0.000 0.000 0
+ 0 27 00:09:00.00 20.0000D -0.4838 0.4329 0.4063 0.009 1.28 ****** 650. 0.458E-02 0.457E-02 0.140E-04 0.184E-14 5 15 27 10 34 34 2 15 28 0.000 0.000 0
+ 0 28 00:09:20.00 20.0000D -0.4902 -0.4216 0.4578 0.010 1.28 ****** 650. 0.476E-02 0.475E-02 0.151E-04 0.198E-14 5 15 27 9 21 22 2 15 28 0.000 0.000 0
+ 0 29 00:09:40.00 20.0000D -0.4950 -0.4329 0.5173 0.012 1.28 ****** 650. 0.502E-02 0.501E-02 0.163E-04 0.215E-14 5 15 27 9 21 22 2 15 28 0.000 0.000 0
+ 0 30 00:10:00.00 20.0000D -0.4983D -0.4412D 0.5854 0.014 1.28 ****** 650. 0.641E-02 0.639E-02 0.507E-03 0.730E-13 5 15 27 9 21 22 2 15 28 0.000 0.000 0
+ 0 31 00:10:20.00 20.0000D -0.4993 0.4599 -0.6462 0.016 1.28 -9.856 650. 0.690E-02 0.687E-02 0.215E-04 0.285E-14 6 12 30 9 19 25 1 29 23 0.000 0.000 0
+ 0 32 00:10:40.00 20.0000D -0.4953 0.4539 -0.7422 0.018 1.28 -8.537 650. 0.756E-02 0.754E-02 0.237E-04 0.315E-14 5 15 27 9 20 25 1 29 23 0.000 0.000 0
+ 0 33 00:11:00.00 20.0000D -0.4984 0.4588 -0.8473 0.021 1.28 -7.415 650. 0.848E-02 0.846E-02 0.265E-04 0.353E-14 6 11 30 9 20 25 1 29 23 0.000 0.000 0
+ 0 34 00:11:20.00 20.0000D -0.5439 0.5026 -0.9603 0.024 1.28 -6.452 650. 0.972E-02 0.970E-02 0.298E-04 0.398E-14 1 15 30 1 19 22 1 29 23 0.000 0.000 0
+ 0 35 00:11:40.00 20.0000D -0.6113 0.5752 1.1044 0.028 1.28 -5.663 650. 0.114E-01 0.114E-01 0.338E-04 0.452E-14 1 15 30 1 19 22 3 15 28 0.000 0.000 0
+ 0 36 00:12:00.00 20.0000D -0.6810 0.6539 1.2707 0.032 1.28 -5.139 650. 0.136E-01 0.136E-01 0.386E-04 0.517E-14 1 15 30 1 19 22 3 15 28 0.000 0.000 0
+ 0 37 00:12:20.00 20.0000A -0.7664 0.7360 1.4378 0.036 1.28 -4.420 650. 0.165E-01 0.165E-01 0.443E-04 0.596E-14 1 16 29 1 19 22 3 15 28 0.000 0.000 0
+ 0 38 00:12:40.00 20.0000A -0.8769 0.8160 1.6035 0.041 1.28 -3.848 650. 0.203E-01 0.203E-01 0.512E-04 0.690E-14 1 16 29 1 19 22 3 20 36 0.000 0.000 0
+ 0 39 00:13:00.00 20.0000A -0.9901 0.9084 1.8194 0.046 1.28 -3.441 650. 0.251E-01 0.250E-01 0.593E-04 0.801E-14 1 16 29 1 29 28 4 14 27 0.000 0.000 0
+ 0 40 00:13:20.00 20.0000A -1.0994 1.0182 2.1169 0.051 1.28 -3.077 650. 0.311E-01 0.311E-01 0.690E-04 0.931E-14 1 16 29 1 29 28 4 20 36 0.000 0.000 0
+ 0 41 00:13:39.30 19.3000A -1.1974 1.1241 2.3261 0.056 1.28 -2.719 650. 0.382E-01 0.381E-01 0.771E-04 0.104E-13 1 16 29 1 29 28 4 20 36 0.000 0.000 0
+ 0 42 00:13:56.40 17.1000A -1.2745 1.2164 2.6255 0.061 1.28 -2.551 650. 0.456E-01 0.456E-01 0.777E-04 0.105E-13 1 16 29 1 29 28 5 20 36 0.000 0.000 0
+ 0 43 00:14:12.40 16.0000A -1.3241 1.2858 2.8102 0.065 1.28 -2.340 650. 0.536E-01 0.536E-01 0.815E-04 0.111E-13 1 16 29 1 29 28 6 19 36 0.000 0.000 0
+ 0 44 00:14:27.00 14.6000A -1.3522 1.3367 3.0857 0.068 1.28 -2.255 650. 0.618E-01 0.618E-01 0.821E-04 0.112E-13 1 16 29 1 29 28 6 20 36 0.000 0.000 0
+ 0 45 00:14:40.60 13.6000A -1.3619 1.3696 3.3043 0.071 1.28 -2.074 650. 0.702E-01 0.702E-01 0.835E-04 0.114E-13 1 16 29 1 29 28 7 19 36 0.000 0.000 0
+ 0 46 00:14:53.60 13.0000A 1.4325 1.3882 3.4638 0.073 1.29 -2.007 650. 0.788E-01 0.788E-01 0.865E-04 0.119E-13 1 31 18 1 29 28 7 20 36 0.000 0.000 0
+ 0 47 00:15:05.70 12.1000A 1.5161 1.3958 3.7293 0.075 1.29 -2.032 650. 0.874E-01 0.874E-01 0.866E-04 0.119E-13 1 31 18 1 29 28 8 19 36 0.000 0.000 0
+ 0 48 00:15:17.40 11.7000A 1.5815 -1.4015 3.8470 0.077 1.38 -1.953 800. 0.961E-01 0.961E-01 0.894E-04 0.123E-13 1 31 18 1 9 25 8 20 36 0.000 0.000 0
+ 0 49 00:15:28.40 11.0000A 1.6308 -1.4504 4.0884 0.078 1.38 -1.899 800. 0.105E+00 0.105E+00 0.893E-04 0.123E-13 1 31 18 1 9 25 9 19 36 0.000 0.000 0
+ 0 50 00:15:39.40 11.0000A 1.6631 -1.4840 4.0981 0.079 1.38 -1.888 800. 0.113E+00 0.113E+00 0.944E-04 0.130E-13 1 31 18 1 9 25 10 19 36 0.000 0.000 0
+ 0 51 00:15:49.60 10.2000A 1.6810 1.5468 4.3988 0.080 1.38 -1.858 800. 0.122E+00 0.122E+00 0.920E-04 0.127E-13 1 31 18 7 2 7 10 19 36 0.000 0.000 0
+ 0 52 00:15:59.80 10.2000A 1.6847 1.5305 4.3919 0.080 1.38 -1.844 800. 0.131E+00 0.130E+00 0.966E-04 0.133E-13 1 31 18 7 2 7 11 19 36 0.000 0.000 0
+ 0 53 00:16:09.48 9.6800A 1.6878 1.5439 4.6501 0.081 1.38 -1.835 800. 0.139E+00 0.139E+00 0.955E-04 0.131E-13 1 30 18 1 27 0 11 19 36 0.000 0.000 0
+ 0 54 00:16:19.25 9.7700A 1.6962 1.6596 4.6047 0.081 1.38 -1.853 800. 0.147E+00 0.147E+00 0.100E-03 0.138E-13 1 30 18 8 2 7 12 19 36 0.000 0.000 0
+ 0 55 00:16:28.46 9.2100A 1.7048 1.6956 4.8878 0.081 1.38 -2.005 800. 0.155E+00 0.155E+00 0.981E-04 0.135E-13 1 29 18 8 2 7 11 15 27 0.000 0.000 0
+ 0 56 00:16:37.78 9.3200A 1.7400 1.5901 4.8274 0.082 1.38 -1.850 800. 0.163E+00 0.163E+00 0.103E-03 0.142E-13 1 29 18 1 5 2 13 19 36 0.000 0.000 0
+ 0 57 00:16:46.73 8.9500A 1.7670 1.5937 5.0281 0.082 1.38 -1.830 800. 0.171E+00 0.171E+00 0.102E-03 0.140E-13 1 29 18 1 5 2 12 15 27 0.000 0.000 0
+ 0 58 00:16:55.71 8.9800A 1.7843 1.6305 5.0093 0.082 1.38 -1.812 800. 0.179E+00 0.179E+00 0.105E-03 0.145E-13 1 29 18 9 2 7 14 19 36 0.000 0.000 0
+ 0 59 00:17:04.42 8.7100A 1.7943 1.6153 5.1679 0.082 1.41 -1.858 850. 0.186E+00 0.186E+00 0.105E-03 0.145E-13 1 29 18 11 16 1 13 15 27 0.000 0.000 0
+ 0 60 00:17:13.15 8.7300A 1.7951 1.5585 5.1540 0.082 1.41 -1.806 850. 0.193E+00 0.193E+00 0.108E-03 0.148E-13 1 29 18 1 5 2 15 19 36 0.000 0.000 0
+ 0 61 00:17:21.69 8.5400A 1.7875 1.7492 5.2705 0.082 1.41 -1.824 850. 0.200E+00 0.200E+00 0.108E-03 0.149E-13 1 29 18 12 16 1 14 15 27 0.000 0.000 0
+ 0 62 00:17:30.33 8.6400A 1.7726 1.6729 5.2097 0.083 1.41 -1.868 850. 0.207E+00 0.207E+00 0.111E-03 0.153E-13 1 29 18 12 16 1 16 19 36 0.000 0.000 0
+ 0 63 00:17:38.54 8.2100A 1.7512 1.7136 5.4791 0.083 1.41 -1.812 850. 0.213E+00 0.213E+00 0.108E-03 0.149E-13 1 29 18 13 16 1 14 14 28 0.000 0.000 0
+ 0 64 00:17:47.28 8.7400A 1.7261 1.8291 5.1478 0.083 1.41 -1.822 850. 0.219E+00 0.219E+00 0.117E-03 0.161E-13 1 29 18 13 16 1 14 14 28 0.000 0.000 0
+ 0 65 00:17:55.25 7.9700A 1.7271 1.5714 5.6455 0.083 1.41 -1.793 850. 0.225E+00 0.225E+00 0.108E-03 0.149E-13 1 29 19 1 6 2 15 14 28 0.000 0.000 0
+ 0 66 00:18:03.50 8.2500A 1.7483 1.8631 5.4546 0.083 1.41 -1.776 850. 0.231E+00 0.231E+00 0.114E-03 0.156E-13 1 29 19 14 16 1 15 14 28 0.000 0.000 0
+ 0 67 00:18:11.46 7.9600A 1.7639 1.7088 5.6559 0.083 1.41 -1.768 850. 0.236E+00 0.236E+00 0.112E-03 0.153E-13 1 29 19 14 16 1 16 14 28 0.000 0.000 0
+ 0 68 00:18:19.33 7.8700A 1.7739 1.7265 5.7156 0.084 1.41 -1.778 850. 0.240E+00 0.240E+00 0.112E-03 0.153E-13 1 37 16 15 16 1 16 14 28 0.000 0.000 0
+ 0 69 00:18:27.50 8.1700A -1.8506 1.8104 5.5085 0.084 1.41 -1.984 850. 0.245E+00 0.245E+00 0.118E-03 0.161E-13 5 11 13 15 16 1 11 35 25 0.000 0.000 0
+ 0 70 00:18:35.38 7.8800A -1.9665 1.6657 5.7142 0.084 1.43 -1.805 900. 0.249E+00 0.249E+00 0.115E-03 0.156E-13 5 11 13 9 10 14 17 14 28 0.000 0.000 0
+ 0 71 00:18:43.38 8.0000A -2.0243 1.7641 5.6245 0.084 1.43 -1.762 900. 0.253E+00 0.253E+00 0.119E-03 0.160E-13 5 11 13 15 17 1 12 35 25 0.000 0.000 0
+ 0 72 00:18:51.52 8.1400A -2.0270 -1.6138 5.5283 0.084 1.43 -1.756 900. 0.257E+00 0.257E+00 0.122E-03 0.164E-13 5 11 13 9 4 1 12 35 25 0.000 0.000 0
+ 0 73 00:18:59.44 7.9200A -1.9748 1.7937 5.6800 0.085 1.43 -1.765 900. 0.261E+00 0.260E+00 0.120E-03 0.161E-13 5 11 13 10 10 14 13 35 25 0.000 0.000 0
+ 0 74 00:19:07.41 7.9700A -1.8731 1.8470 5.6477 0.085 1.43 -1.771 900. 0.264E+00 0.264E+00 0.122E-03 0.164E-13 5 11 13 10 10 14 13 35 25 0.000 0.000 0
+ 0 75 00:19:15.34 7.9300A -1.8088 1.7554 5.6772 0.085 1.43 -1.751 900. 0.266E+00 0.266E+00 0.123E-03 0.164E-13 6 19 34 10 10 14 14 35 25 0.000 0.000 0
+ 0 76 00:19:23.21 7.8700A -1.8408 -1.7349 5.7174 0.086 1.43 -1.758 900. 0.269E+00 0.269E+00 0.123E-03 0.164E-13 14 36 38 12 4 39 14 35 25 0.000 0.000 0
+ 0 77 00:19:31.21 8.0000A -1.9588 1.8210 5.6231 0.086 1.41 -1.760 850. 0.271E+00 0.271E+00 0.126E-03 0.168E-13 6 11 13 11 10 14 15 35 25 0.000 0.000 0
+ 0 78 00:19:39.05 7.8400A -2.0921 1.7637 5.7409 0.086 1.41 -1.733 850. 0.273E+00 0.273E+00 0.125E-03 0.165E-13 6 11 13 11 10 14 15 35 25 0.000 0.000 0
+ 0 79 00:19:47.29 8.2400A -2.1688 -1.7744 5.4629 0.086 1.41 -1.722 850. 0.275E+00 0.275E+00 0.132E-03 0.175E-13 6 11 13 13 4 39 16 35 25 0.000 0.000 0
+ 0 80 00:19:55.22 7.9300A -2.1889 -1.7066 5.6748 0.087 1.41 -1.714 850. 0.277E+00 0.276E+00 0.128E-03 0.169E-13 6 11 13 14 0 7 16 35 25 0.000 0.000 0
+ 0 81 00:20:04.01 8.7900A -2.1498 -1.6970 5.1191 0.087 1.41 -1.722 850. 0.278E+00 0.278E+00 0.143E-03 0.188E-13 6 11 13 14 0 7 17 35 25 0.000 0.000 0
+ 0 82 00:20:12.31 8.3000A -2.0439 -1.6572 5.4206 0.087 1.41 -1.690 850. 0.279E+00 0.279E+00 0.136E-03 0.179E-13 6 11 13 1 8 26 17 35 25 0.000 0.000 0
+ 0 83 00:20:21.44 9.1300A -2.1149 -1.6451 4.9296 0.088 1.41 -1.675 850. 0.280E+00 0.280E+00 0.150E-03 0.197E-13 18 15 27 1 8 26 17 35 25 0.000 0.000 0
+ 0 84 00:20:30.62 9.1800A -2.1695 1.6594 4.9006 0.088 1.41 -1.688 850. 0.281E+00 0.281E+00 0.151E-03 0.199E-13 18 15 27 3 8 16 18 35 25 0.000 0.000 0
+ 0 85 00:20:40.56 9.9400A -2.0500 1.6815 4.5251 0.089 1.41 -1.633 850. 0.281E+00 0.281E+00 0.164E-03 0.216E-13 18 15 27 10 22 25 18 35 25 0.000 0.000 0
+ 0 86 00:20:50.13 9.5700A -1.9408 -1.6689 4.7042 0.089 1.41 -1.596 850. 0.282E+00 0.281E+00 0.159E-03 0.209E-13 7 11 13 16 8 23 16 38 15 0.000 0.000 0
+ 0 87 00:21:00.43 10.3000A -2.0142 -1.7997 4.3758 0.090 1.41 -1.587 850. 0.282E+00 0.282E+00 0.172E-03 0.226E-13 7 11 13 15 39 7 16 38 15 0.000 0.000 0
+ 0 88 00:21:09.99 9.5600A -2.0167 -1.8320 4.7087 0.090 1.41 -1.596 850. 0.282E+00 0.282E+00 0.161E-03 0.212E-13 7 11 13 15 39 7 15 8 22 0.000 0.000 0
+ 0 89 00:21:19.94 9.9500A -1.9510 -1.7678 4.5214 0.091 1.41 -1.719 850. 0.282E+00 0.282E+00 0.168E-03 0.222E-13 7 11 13 1 22 28 15 8 22 0.000 0.000 0
+ 0 90 00:21:29.84 9.9000A -1.8253 -1.8361 4.5445 0.092 1.41 -1.603 850. 0.282E+00 0.282E+00 0.168E-03 0.222E-13 7 11 13 1 22 28 14 35 16 0.000 0.000 0
+ 0 91 00:21:39.78 9.9400A -1.8430 -1.8900 4.5279 0.092 1.38 -1.600 800. 0.282E+00 0.282E+00 0.170E-03 0.225E-13 1 19 35 1 22 28 16 8 22 0.000 0.000 0
+ 0 92 00:21:49.65 9.8700A -1.8498 -1.9272 4.5601 0.093 1.38 -1.612 800. 0.282E+00 0.282E+00 0.169E-03 0.224E-13 1 19 35 1 22 28 15 35 16 0.000 0.000 0
+ 0 93 00:22:00.25 10.6000A -1.8201 -1.9456 4.2321 0.094 1.38 -1.607 800. 0.282E+00 0.282E+00 0.182E-03 0.242E-13 1 19 35 1 22 28 15 35 16 0.000 0.000 0
+ 0 94 00:22:10.85 10.6000A -1.7954 -1.9438 4.2395 0.094 1.38 -1.565 800. 0.282E+00 0.282E+00 0.183E-03 0.243E-13 14 5 33 1 22 28 16 35 16 0.000 0.000 0
+ 0 95 00:22:21.65 10.8000A -1.8093 1.9326 4.1777 0.095 1.38 -1.519 800. 0.282E+00 0.282E+00 0.187E-03 0.249E-13 1 19 34 1 10 16 14 23 12 0.000 0.000 0
+ 0 96 00:22:32.65 11.0000A -1.7911 1.8969 4.0858 0.096 1.38 -1.570 800. 0.282E+00 0.281E+00 0.191E-03 0.255E-13 1 19 34 1 10 16 14 23 12 0.000 0.000 0
+ 0 97 00:22:43.85 11.2000A 1.7603 -1.8590 4.0137 0.097 1.38 -1.432 800. 0.281E+00 0.281E+00 0.195E-03 0.261E-13 3 38 17 1 22 27 13 23 6 0.000 0.000 0
+ 0 98 00:22:54.95 11.1000A 1.7363 -1.9231 4.0593 0.098 1.38 -1.406 800. 0.281E+00 0.281E+00 0.194E-03 0.259E-13 3 38 17 1 22 27 14 23 6 0.000 0.000 0
+ 0 99 00:23:05.15 10.2000A 1.7280 -1.9681 4.4107 0.099 1.38 -1.447 800. 0.280E+00 0.280E+00 0.179E-03 0.239E-13 3 38 18 1 22 27 14 23 6 0.000 0.000 0
+ 0 100 00:23:16.05 10.9000A 1.8183 -1.9898 4.1417 0.100 1.38 -1.390 800. 0.280E+00 0.280E+00 0.192E-03 0.256E-13 3 38 18 1 22 27 14 23 6 0.000 0.000 0
+ 0 101 00:23:26.15 10.1000A 1.8483 -1.9896 4.4515 0.101 1.38 -1.368 800. 0.279E+00 0.279E+00 0.178E-03 0.238E-13 3 38 18 1 22 27 15 23 6 0.000 0.000 0
+ 0 102 00:23:36.35 10.2000A 1.8176 -1.9679 4.4276 0.101 1.38 -1.356 800. 0.278E+00 0.278E+00 0.180E-03 0.241E-13 3 38 18 1 22 27 15 23 6 0.000 0.000 0
+ 0 103 00:23:47.85 11.5000A 1.7381 1.9490 3.9019 0.102 1.35 -1.324 750. 0.277E+00 0.277E+00 0.202E-03 0.271E-13 3 38 18 2 7 15 16 23 6 0.000 0.000 0
+ 0 104 00:23:58.75 10.9000A -1.6589 2.0091 4.1429 0.103 1.35 -1.318 750. 0.277E+00 0.276E+00 0.192E-03 0.257E-13 1 27 23 1 7 14 16 23 6 0.000 0.000 0
+ 0 105 00:24:10.55 11.8000A 1.7071 2.0640 3.8135 0.104 1.35 -1.323 750. 0.275E+00 0.275E+00 0.207E-03 0.277E-13 1 15 27 1 7 14 16 23 6 0.000 0.000 0
+ 0 106 00:24:22.05 11.5000A 1.7476 2.0964 3.9100 0.105 1.35 -1.334 750. 0.274E+00 0.274E+00 0.202E-03 0.269E-13 1 15 27 1 7 14 15 36 27 0.000 0.000 0
+ 0 107 00:24:33.45 11.4000A 1.7641 2.1010 3.9387 0.105 1.35 -1.329 750. 0.273E+00 0.273E+00 0.200E-03 0.267E-13 1 15 27 1 7 14 15 36 27 0.000 0.000 0
+ 0 108 00:24:45.55 12.1000A 1.7574 2.0835 3.7283 0.106 1.35 -1.315 750. 0.272E+00 0.271E+00 0.212E-03 0.282E-13 1 15 27 1 7 14 9 12 1 0.000 0.000 0
+ 0 109 00:24:57.15 11.6000A 1.7389 -2.1091 3.8696 0.107 1.35 -1.311 750. 0.270E+00 0.270E+00 0.203E-03 0.270E-13 3 36 19 1 22 29 16 36 27 0.000 0.000 0
+ 0 110 00:25:08.45 11.3000A 1.7672 -2.2221 3.9936 0.107 1.35 -1.295 750. 0.269E+00 0.269E+00 0.198E-03 0.262E-13 3 36 19 1 22 29 10 12 1 0.000 0.000 0
+ 0 111 00:25:19.95 11.5000A -1.7773 -2.3191 3.9018 0.108 1.35 -1.322 750. 0.267E+00 0.267E+00 0.201E-03 0.267E-13 1 37 20 1 22 29 10 12 1 0.000 0.000 0
+ 0 112 00:25:31.45 11.5000A -1.7930 -2.3896 3.9135 0.108 1.35 -1.301 750. 0.266E+00 0.266E+00 0.201E-03 0.266E-13 1 37 20 1 22 29 11 12 1 0.000 0.000 0
+ 0 113 00:25:42.55 11.1000A -1.7866 -2.4196 4.0363 0.109 1.35 -1.344 750. 0.264E+00 0.264E+00 0.194E-03 0.256E-13 1 37 20 1 22 29 11 12 1 0.000 0.000 0
+ 0 114 00:25:55.05 12.5000A 1.7963 -2.4040 3.6053 0.109 1.35 -1.324 750. 0.263E+00 0.262E+00 0.218E-03 0.287E-13 2 33 15 1 22 29 11 12 1 0.000 0.000 0
+ 0 115 00:26:06.45 11.4000A -1.8333 -2.3929 3.9399 0.110 1.38 -1.300 800. 0.261E+00 0.261E+00 0.199E-03 0.262E-13 1 12 21 1 21 29 11 32 24 0.000 0.000 0
+ 0 116 00:26:17.95 11.5000A -1.8698 -2.4627 3.9033 0.110 1.38 -1.316 800. 0.260E+00 0.259E+00 0.200E-03 0.264E-13 1 12 21 1 21 29 11 32 24 0.000 0.000 0
+ 0 117 00:26:30.35 12.4000A -1.8927 -2.4874 3.6369 0.111 1.38 -1.309 800. 0.258E+00 0.258E+00 0.215E-03 0.283E-13 1 12 21 1 21 29 11 31 25 0.000 0.000 0
+ 0 118 00:26:42.15 11.8000A -1.8986 -2.4592 3.8114 0.111 1.32 -1.289 700. 0.257E+00 0.256E+00 0.204E-03 0.269E-13 1 12 21 1 21 29 12 32 24 0.000 0.000 0
+ 0 119 00:26:53.75 11.6000A -1.8863 -2.3871 3.8812 0.112 1.38 -1.266 800. 0.255E+00 0.255E+00 0.200E-03 0.264E-13 1 12 21 1 21 29 12 32 24 0.000 0.000 0
+ 0 120 00:27:06.05 12.3000A -1.8581 2.3788 3.6552 0.112 1.38 -1.261 800. 0.254E+00 0.253E+00 0.212E-03 0.279E-13 1 12 21 1 9 14 6 17 31 0.000 0.000 0
+ 0 121 00:27:17.75 11.7000A 1.8904 2.3906 3.8390 0.113 1.38 -1.271 800. 0.252E+00 0.252E+00 0.202E-03 0.265E-13 1 18 21 1 9 14 7 17 31 0.000 0.000 0
+ 0 122 00:27:29.15 11.4000A 1.9592 2.3621 3.9512 0.113 1.38 -1.324 800. 0.251E+00 0.250E+00 0.197E-03 0.258E-13 1 18 21 1 9 14 7 17 31 0.000 0.000 0
+ 0 123 00:27:40.85 11.7000A 1.9816 2.3757 3.8623 0.113 1.38 -1.271 800. 0.249E+00 0.249E+00 0.201E-03 0.264E-13 1 18 21 1 10 14 8 17 31 0.000 0.000 0
+ 0 124 00:27:51.65 10.8000A 1.9569 2.4083 4.1477 0.114 1.38 -1.261 800. 0.248E+00 0.248E+00 0.186E-03 0.244E-13 1 18 21 1 10 14 8 17 31 0.000 0.000 0
+ 0 125 00:28:03.35 11.7000A 1.8962 2.4093 3.8427 0.114 1.38 -1.251 800. 0.246E+00 0.246E+00 0.201E-03 0.263E-13 1 18 21 1 10 14 8 17 31 0.000 0.000 0
+ 0 126 00:28:14.55 11.2000A 2.0100 2.3683 4.0348 0.115 1.35 -1.277 750. 0.245E+00 0.244E+00 0.192E-03 0.251E-13 1 17 21 1 10 14 9 17 31 0.000 0.000 0
+ 0 127 00:28:26.45 11.9000A 2.0906 2.2885 3.7964 0.115 1.35 -1.246 750. 0.243E+00 0.243E+00 0.202E-03 0.266E-13 1 17 21 1 10 14 9 17 31 0.000 0.000 0
+ 0 128 00:28:38.55 12.1000A 2.0912 2.1695 3.7179 0.115 1.35 -1.228 750. 0.241E+00 0.241E+00 0.205E-03 0.270E-13 1 17 21 1 10 14 10 17 31 0.000 0.000 0
+ 0 129 00:28:51.25 12.7000A 2.0014 2.2106 3.5318 0.115 1.35 -1.221 750. 0.239E+00 0.239E+00 0.214E-03 0.282E-13 1 17 21 1 12 13 10 17 31 0.000 0.000 0
+ 0 130 00:29:04.95 13.7000A 1.9390 2.2557 3.2948 0.116 1.38 -1.212 800. 0.237E+00 0.237E+00 0.229E-03 0.302E-13 1 20 22 1 12 13 15 31 24 0.000 0.000 0
+ 0 131 00:29:18.55 13.6000A 1.9902 2.2448 3.3144 0.116 1.41 -1.192 850. 0.235E+00 0.235E+00 0.226E-03 0.298E-13 1 20 22 1 12 13 15 31 24 0.000 0.000 0
+ 0 132 00:29:33.05 14.5000A 2.0400 2.1833 3.1107 0.116 1.35 -1.200 750. 0.232E+00 0.232E+00 0.239E-03 0.315E-13 1 20 22 1 12 13 12 22 13 0.000 0.000 0
+ 0 133 00:29:47.05 14.0000A 2.0818 2.2418 3.2104 0.115 1.35 -1.279 750. 0.230E+00 0.230E+00 0.230E-03 0.303E-13 1 20 22 1 8 16 16 31 24 0.000 0.000 0
+ 0 134 00:30:01.75 14.7000A 2.1591 2.3083 3.0512 0.115 1.35 -1.240 750. 0.228E+00 0.227E+00 0.239E-03 0.315E-13 1 19 22 1 8 16 4 13 17 0.000 0.000 0
+ 0 135 00:30:16.45 14.7000A 2.2191 2.2636 3.0590 0.115 1.35 -1.210 750. 0.225E+00 0.225E+00 0.238E-03 0.312E-13 1 19 22 1 8 16 13 22 13 0.000 0.000 0
+ 0 136 00:30:31.25 14.8000A 2.2333 2.1717 3.0444 0.115 1.35 -1.222 750. 0.223E+00 0.223E+00 0.237E-03 0.312E-13 1 19 22 1 9 16 5 13 17 0.000 0.000 0
+ 0 137 00:30:44.75 13.5000A 2.2022 2.1157 3.3321 0.114 1.41 -1.211 850. 0.221E+00 0.221E+00 0.215E-03 0.282E-13 1 19 22 1 9 16 10 12 34 0.000 0.000 0
+ 0 138 00:30:57.95 13.2000A 2.1843 2.1377 3.4048 0.114 1.41 -1.209 850. 0.219E+00 0.219E+00 0.209E-03 0.273E-13 1 19 23 1 14 12 10 12 34 0.000 0.000 0
+ 0 139 00:31:11.35 13.4000A 2.2430 2.2057 3.3692 0.113 1.41 -1.234 850. 0.217E+00 0.217E+00 0.210E-03 0.274E-13 1 19 23 1 14 12 11 12 34 0.000 0.000 0
+ 0 140 00:31:24.65 13.3000A 2.2595 2.2050 3.3818 0.113 1.38 -1.262 800. 0.216E+00 0.215E+00 0.207E-03 0.269E-13 1 19 23 1 14 12 11 12 34 0.000 0.000 0
+ 0 141 00:31:38.15 13.5000A 2.2351 2.1414 3.3251 0.112 1.38 -1.359 800. 0.214E+00 0.213E+00 0.207E-03 0.270E-13 1 19 23 1 14 12 12 11 19 0.000 0.000 0
+ 0 142 00:31:51.75 13.6000A 2.1849 2.0937 3.3170 0.111 1.38 -1.246 800. 0.212E+00 0.212E+00 0.206E-03 0.268E-13 1 19 23 2 13 13 12 11 19 0.000 0.000 0
+ 0 143 00:32:05.85 14.1000A 2.1665 2.0911 3.1984 0.110 1.38 -1.277 800. 0.211E+00 0.210E+00 0.212E-03 0.274E-13 1 19 24 1 12 12 13 11 19 0.000 0.000 0
+ 0 144 00:32:19.35 13.5000A 2.2330 2.1961 3.3346 0.109 1.38 -1.268 800. 0.209E+00 0.209E+00 0.201E-03 0.259E-13 1 19 24 2 14 13 13 11 19 0.000 0.000 0
+ 0 145 00:32:33.05 13.7000A 2.2358 2.2598 3.2746 0.109 1.38 -1.293 800. 0.208E+00 0.207E+00 0.202E-03 0.260E-13 1 19 24 2 14 13 14 12 21 0.000 0.000 0
+ 0 146 00:32:47.05 14.0000A 2.1896 2.3099 3.2130 0.108 1.38 -1.292 800. 0.207E+00 0.206E+00 0.205E-03 0.263E-13 1 19 24 1 13 12 14 11 19 0.000 0.000 0
+ 0 147 00:33:01.35 14.3000A 2.1024 2.3477 3.1369 0.107 1.38 -1.310 800. 0.205E+00 0.205E+00 0.208E-03 0.267E-13 1 19 24 1 13 12 15 12 21 0.000 0.000 0
+ 0 148 00:33:16.25 14.9000A 1.9940 2.3109 3.0124 0.106 1.38 -1.321 800. 0.204E+00 0.204E+00 0.215E-03 0.276E-13 1 19 24 1 13 12 15 11 19 0.000 0.000 0
+ 0 149 00:33:30.85 14.6000A 2.0083 2.2570 3.0910 0.105 1.38 -1.327 800. 0.204E+00 0.203E+00 0.209E-03 0.268E-13 1 17 24 1 13 13 16 12 21 0.000 0.000 0
+ 0 150 00:33:46.25 15.4000A 2.0296 2.2387 2.9235 0.105 1.38 -1.371 800. 0.203E+00 0.202E+00 0.219E-03 0.281E-13 1 17 24 1 13 13 5 29 18 0.000 0.000 0
+ 0 151 00:34:00.95 14.7000A 1.9808 2.2175 3.0615 0.104 1.38 -1.383 800. 0.202E+00 0.202E+00 0.208E-03 0.267E-13 1 17 24 1 14 13 6 29 18 0.000 0.000 0
+ 0 152 00:34:15.15 14.2000A -1.9396 2.3781 3.1723 0.104 1.38 -1.361 800. 0.202E+00 0.201E+00 0.200E-03 0.257E-13 1 39 5 1 14 13 8 28 17 0.000 0.000 0
+ 0 153 00:34:28.55 13.4000A 2.0675 2.4704 3.3549 0.103 1.38 -1.363 800. 0.202E+00 0.201E+00 0.189E-03 0.242E-13 1 17 25 1 14 13 9 28 17 0.000 0.000 0
+ 0 154 00:34:41.35 12.8000A -2.1421 2.4901 3.5091 0.103 1.38 -1.394 800. 0.202E+00 0.201E+00 0.180E-03 0.230E-13 1 39 4 1 14 13 9 28 17 0.000 0.000 0
+ 0 155 00:34:53.85 12.5000A -2.1948 2.4409 3.5981 0.102 1.38 -1.476 800. 0.202E+00 0.201E+00 0.176E-03 0.225E-13 1 39 4 1 14 13 10 28 17 0.000 0.000 0
+ 0 156 00:35:06.25 12.4000A -2.2082 2.3277 3.6269 0.102 1.38 -1.437 800. 0.202E+00 0.201E+00 0.174E-03 0.222E-13 1 39 4 1 14 13 10 28 17 0.000 0.000 0
+ 0 157 00:35:18.45 12.2000A -2.1825 2.3456 3.6988 0.102 1.38 -1.430 800. 0.202E+00 0.201E+00 0.172E-03 0.218E-13 1 39 4 1 15 13 11 28 17 0.000 0.000 0
+ 0 158 00:35:30.25 11.8000A -2.1227 2.4465 3.8015 0.101 1.38 -1.429 800. 0.202E+00 0.202E+00 0.166E-03 0.211E-13 1 39 4 1 15 13 12 28 17 0.000 0.000 0
+ 0 159 00:35:42.05 11.8000A -2.0764 2.4870 3.8084 0.101 1.38 -1.436 800. 0.203E+00 0.202E+00 0.166E-03 0.211E-13 1 39 3 1 15 13 13 28 17 0.000 0.000 0
+ 0 160 00:35:53.35 11.3000A -2.1034 2.4705 3.9746 0.101 1.38 -1.445 800. 0.203E+00 0.202E+00 0.159E-03 0.201E-13 1 39 3 1 15 13 13 28 17 0.000 0.000 0
+ 0 161 00:36:04.85 11.5000A -2.0989 2.4038 3.9139 0.101 1.38 -1.433 800. 0.203E+00 0.203E+00 0.162E-03 0.205E-13 1 39 3 1 15 13 14 28 17 0.000 0.000 0
+ 0 162 00:36:16.15 11.3000A -2.0703 2.2906 3.9650 0.100 1.38 -1.390 800. 0.204E+00 0.203E+00 0.159E-03 0.201E-13 1 38 3 1 15 13 14 28 17 0.000 0.000 0
+ 0 163 00:36:27.75 11.6000A -2.0480 2.1660 3.8904 0.100 1.38 -1.357 800. 0.205E+00 0.204E+00 0.163E-03 0.206E-13 1 38 3 2 16 13 15 28 17 0.000 0.000 0
+ 0 164 00:36:39.35 11.6000A -2.1133 2.1887 3.8849 0.100 1.38 -1.347 800. 0.205E+00 0.204E+00 0.164E-03 0.207E-13 1 36 1 2 16 13 15 28 17 0.000 0.000 0
+ 0 165 00:36:51.55 12.2000A -2.1418 2.1803 3.6824 0.100 1.38 -1.337 800. 0.206E+00 0.205E+00 0.172E-03 0.217E-13 1 36 1 2 16 13 15 29 17 0.000 0.000 0
+ 0 166 00:37:04.25 12.7000A -2.1389 2.1311 3.5539 0.100 1.41 -1.324 850. 0.207E+00 0.206E+00 0.179E-03 0.227E-13 1 36 0 2 16 13 14 27 16 0.000 0.000 0
+ 0 167 00:37:16.25 12.0000A -2.2340 -2.1121 3.7401 0.100 1.41 -1.331 850. 0.207E+00 0.207E+00 0.170E-03 0.215E-13 1 36 0 1 33 14 16 29 17 0.000 0.000 0
+ 0 168 00:37:28.45 12.2000A -2.2833 -2.1292 3.6824 0.100 1.41 -1.384 850. 0.208E+00 0.208E+00 0.173E-03 0.218E-13 1 36 0 1 33 14 15 27 16 0.000 0.000 0
+ 0 169 00:37:40.55 12.1000A -2.2947 -2.1121 3.7140 0.100 1.41 -1.353 850. 0.209E+00 0.208E+00 0.171E-03 0.216E-13 1 36 0 1 33 14 16 27 16 0.000 0.000 0
+ 0 170 00:37:52.85 12.3000A -2.2741 -2.0710 3.6688 0.100 1.41 -1.364 850. 0.210E+00 0.209E+00 0.174E-03 0.220E-13 1 36 0 1 33 14 16 27 16 0.000 0.000 0
+ 0 171 00:38:05.65 12.8000A -2.2272 -2.0980 3.5117 0.100 1.43 -1.378 900. 0.211E+00 0.210E+00 0.181E-03 0.229E-13 1 36 0 1 32 16 17 27 16 0.000 0.000 0
+ 0 172 00:38:18.75 13.1000A -2.1531 -2.1396 3.4286 0.100 1.43 -1.432 900. 0.212E+00 0.211E+00 0.186E-03 0.235E-13 1 36 0 1 32 17 17 27 16 0.000 0.000 0
+ 0 173 00:38:31.35 12.6000A -2.1886 -2.1599 3.5630 0.100 1.43 -1.399 900. 0.213E+00 0.212E+00 0.179E-03 0.226E-13 1 35 39 1 32 15 16 29 18 0.000 0.000 0
+ 0 174 00:38:44.55 13.2000A -2.2034 -2.2233 3.4144 0.101 1.43 -1.360 900. 0.214E+00 0.213E+00 0.188E-03 0.237E-13 1 35 39 1 32 15 16 29 18 0.000 0.000 0
+ 0 175 00:38:58.35 13.8000A -2.1963 -2.2318 3.2641 0.101 1.43 -1.355 900. 0.215E+00 0.214E+00 0.197E-03 0.248E-13 1 35 38 1 32 15 17 29 18 0.000 0.000 0
+ 0 176 00:39:11.65 13.3000A -2.2648 -2.1778 3.3896 0.101 1.43 -1.382 900. 0.217E+00 0.216E+00 0.190E-03 0.240E-13 1 35 37 1 32 15 17 29 18 0.000 0.000 0
+ 0 177 00:39:24.75 13.1000A -2.3021 -2.1965 3.4373 0.101 1.41 -1.350 850. 0.218E+00 0.217E+00 0.188E-03 0.238E-13 1 35 37 1 31 17 9 24 19 0.000 0.000 0
+ 0 178 00:39:38.35 13.6000A -2.2284 -2.2747 3.3046 0.101 1.41 -1.355 850. 0.220E+00 0.219E+00 0.196E-03 0.247E-13 1 35 37 1 31 15 11 4 0 0.000 0.000 0
+ 0 179 00:39:51.15 12.8000A -2.0787 -2.3151 3.5256 0.102 1.41 -1.352 850. 0.221E+00 0.220E+00 0.186E-03 0.234E-13 1 35 37 1 31 15 10 24 19 0.000 0.000 0
+ 0 180 00:40:04.85 13.7000A -2.1455 -2.2906 3.2776 0.102 1.41 -1.378 850. 0.223E+00 0.222E+00 0.199E-03 0.251E-13 2 35 37 1 31 15 8 4 1 0.000 0.000 0
+ 0 181 00:40:17.85 13.0000A -2.1908 -2.2108 3.4580 0.102 1.41 -1.446 850. 0.225E+00 0.224E+00 0.190E-03 0.240E-13 2 35 37 1 31 15 11 24 19 0.000 0.000 0
+ 0 182 00:40:31.55 13.7000A -2.1518 -2.2091 3.2922 0.102 1.41 -1.524 850. 0.227E+00 0.226E+00 0.201E-03 0.253E-13 2 35 37 1 30 17 9 25 19 0.000 0.000 0
+ 0 183 00:40:44.95 13.4000A -2.0486 -2.1944 3.3582 0.102 1.41 -1.488 850. 0.228E+00 0.227E+00 0.197E-03 0.250E-13 2 35 37 1 30 17 9 25 19 0.000 0.000 0
+ 0 184 00:40:58.45 13.5000A -2.1237 -2.1819 3.3254 0.102 1.41 -1.514 850. 0.230E+00 0.229E+00 0.200E-03 0.253E-13 1 33 39 1 30 16 10 25 19 0.000 0.000 0
+ 0 185 00:41:11.85 13.4000A -2.3131 -2.1145 3.3668 0.102 1.41 -1.464 850. 0.232E+00 0.231E+00 0.199E-03 0.253E-13 1 33 39 1 30 16 10 25 19 0.000 0.000 0
+ 0 186 00:41:25.25 13.4000A -2.3425 -2.1211 3.3569 0.102 1.41 -1.447 850. 0.234E+00 0.233E+00 0.200E-03 0.255E-13 1 33 39 1 29 16 6 19 12 0.000 0.000 0
+ 0 187 00:41:38.65 13.4000A -2.2166 -2.1463 3.3697 0.102 1.41 -1.448 850. 0.237E+00 0.236E+00 0.202E-03 0.257E-13 1 33 39 1 29 16 10 24 19 0.000 0.000 0
+ 0 188 00:41:51.95 13.3000A -2.2932 -2.1146 3.3771 0.102 1.41 -1.747 850. 0.239E+00 0.238E+00 0.201E-03 0.257E-13 1 33 38 1 29 16 12 23 19 0.000 0.000 0
+ 0 189 00:42:05.05 13.1000A -2.2620 -2.0345 3.4445 0.102 1.41 -1.442 850. 0.241E+00 0.240E+00 0.199E-03 0.255E-13 1 33 38 1 29 16 12 23 19 0.000 0.000 0
+ 0 190 00:42:17.35 12.3000A -2.1635 -2.0145 3.6599 0.102 1.41 -1.421 850. 0.243E+00 0.242E+00 0.188E-03 0.242E-13 1 33 37 1 28 16 13 23 19 0.000 0.000 0
+ 0 191 00:42:30.25 12.9000A -2.2627 -2.0551 3.4893 0.102 1.41 -1.415 850. 0.245E+00 0.244E+00 0.198E-03 0.255E-13 1 33 37 1 28 16 13 23 19 0.000 0.000 0
+ 0 192 00:42:42.75 12.5000A -2.2475 -2.0437 3.5914 0.102 1.41 -1.393 850. 0.247E+00 0.246E+00 0.193E-03 0.250E-13 1 33 37 1 28 16 14 23 19 0.000 0.000 0
+ 0 193 00:42:54.65 11.9000A -2.1510 -1.9858 3.7727 0.102 1.41 -1.389 850. 0.249E+00 0.248E+00 0.185E-03 0.240E-13 1 33 37 1 28 16 13 22 19 0.000 0.000 0
+ 0 194 00:43:06.85 12.2000A -2.1072 -1.9327 3.6867 0.102 1.41 -1.377 850. 0.251E+00 0.251E+00 0.191E-03 0.247E-13 3 33 37 1 27 17 9 25 21 0.000 0.000 0
+ 0 195 00:43:18.25 11.4000A -2.2110 -1.9839 3.9372 0.103 1.41 -1.381 850. 0.253E+00 0.252E+00 0.179E-03 0.232E-13 3 33 36 1 27 16 14 22 19 0.000 0.000 0
+ 0 196 00:43:30.35 12.1000A -2.3085 -1.9925 3.7169 0.103 1.41 -1.389 850. 0.255E+00 0.254E+00 0.191E-03 0.248E-13 3 33 36 1 27 16 10 25 21 0.000 0.000 0
+ 0 197 00:43:42.45 12.1000A -2.2490 -1.9568 3.7300 0.103 1.41 -1.488 850. 0.257E+00 0.256E+00 0.192E-03 0.249E-13 3 33 36 1 27 16 15 22 19 0.000 0.000 0
+ 0 198 00:43:55.05 12.6000A -2.1129 -2.1141 3.5698 0.103 1.41 -1.407 850. 0.259E+00 0.258E+00 0.201E-03 0.260E-13 4 33 36 16 24 19 13 24 21 0.000 0.000 0
+ 0 199 00:44:07.45 12.4000A -2.1621 -2.1360 3.6177 0.103 1.41 -1.389 850. 0.261E+00 0.260E+00 0.198E-03 0.257E-13 4 33 35 16 24 19 13 24 21 0.000 0.000 0
+ 0 200 00:44:20.05 12.6000A -2.1546 -2.0910 3.5651 0.103 1.41 -1.546 850. 0.262E+00 0.262E+00 0.202E-03 0.262E-13 4 33 35 16 23 19 14 24 21 0.000 0.000 0
+ 0 201 00:44:32.35 12.3000A -2.1403 -2.1132 3.6536 0.103 1.41 -1.387 850. 0.264E+00 0.263E+00 0.198E-03 0.257E-13 6 33 35 16 23 19 14 24 21 0.000 0.000 0
+ 0 202 00:44:45.05 12.7000A 2.1499 -2.0291 3.5545 0.103 1.41 -1.383 850. 0.266E+00 0.265E+00 0.206E-03 0.266E-13 17 26 27 17 23 19 13 26 20 0.000 0.000 0
+ 0 203 00:44:57.35 12.3000A -2.3283 -2.2776 3.6453 0.103 1.41 -1.376 850. 0.268E+00 0.267E+00 0.200E-03 0.259E-13 7 33 35 17 23 19 13 29 18 0.000 0.000 0
+ 0 204 00:45:09.95 12.6000A -2.2436 -2.2474 3.5840 0.103 1.41 -1.389 850. 0.269E+00 0.269E+00 0.206E-03 0.267E-13 7 33 34 17 23 19 14 29 18 0.000 0.000 0
+ 0 205 00:45:21.95 12.0000A -2.4079 2.1885 3.7346 0.103 1.41 -1.347 850. 0.271E+00 0.270E+00 0.197E-03 0.255E-13 7 33 34 2 33 8 14 29 18 0.000 0.000 0
+ 0 206 00:45:34.65 12.7000A -2.2052 -2.0276 3.5531 0.103 1.41 -1.347 850. 0.273E+00 0.272E+00 0.209E-03 0.271E-13 8 33 34 18 19 17 14 29 18 0.000 0.000 0
+ 0 207 00:45:47.85 13.2000A -2.2890 -1.9557 3.4207 0.103 1.41 -1.335 850. 0.274E+00 0.274E+00 0.218E-03 0.282E-13 8 33 34 18 19 17 15 29 18 0.000 0.000 0
+ 0 208 00:46:00.95 13.1000A -2.4871 -1.9230 3.4310 0.103 1.41 -1.346 850. 0.276E+00 0.275E+00 0.218E-03 0.281E-13 8 33 33 17 21 19 6 12 21 0.000 0.000 0
+ 0 209 00:46:14.55 13.6000A -2.4420 -1.9949 3.3004 0.103 1.41 -1.331 850. 0.278E+00 0.277E+00 0.227E-03 0.293E-13 8 33 33 19 19 17 11 13 19 0.000 0.000 0
+ 0 210 00:46:27.25 12.7000A -2.3831 -2.0990 3.5476 0.103 1.41 -1.325 850. 0.279E+00 0.278E+00 0.214E-03 0.276E-13 9 33 33 19 19 17 11 22 13 0.000 0.000 0
+ 0 211 00:46:40.15 12.9000A -2.2837 -2.0889 3.4969 0.103 1.41 -1.353 850. 0.281E+00 0.280E+00 0.218E-03 0.283E-13 9 33 33 19 19 17 10 33 32 0.000 0.000 0
+ 0 212 00:46:52.75 12.6000A -2.1846 -1.9886 3.5727 0.103 1.41 -1.326 850. 0.282E+00 0.281E+00 0.214E-03 0.278E-13 9 33 32 19 19 17 12 22 13 0.000 0.000 0
+ 0 213 00:47:04.65 11.9000A -2.1743 1.9090 3.7804 0.103 1.41 -1.334 850. 0.283E+00 0.283E+00 0.204E-03 0.264E-13 9 33 32 16 13 2 12 22 13 0.000 0.000 0
+ 0 214 00:47:17.05 12.4000A -2.2333 1.9174 3.6276 0.103 1.41 -1.350 850. 0.285E+00 0.284E+00 0.213E-03 0.277E-13 10 33 32 16 13 2 12 22 13 0.000 0.000 0
+ 0 215 00:47:29.25 12.2000A -2.2272 -1.9391 3.6992 0.103 1.41 -1.362 850. 0.286E+00 0.285E+00 0.210E-03 0.273E-13 10 33 32 18 17 15 9 13 21 0.000 0.000 0
+ 0 216 00:47:41.25 12.0000A -2.2859 1.8975 3.7647 0.103 1.41 -1.350 850. 0.287E+00 0.286E+00 0.207E-03 0.269E-13 11 33 32 8 17 21 9 13 21 0.000 0.000 0
+ 0 217 00:47:53.65 12.4000A -2.2967 1.8824 3.6182 0.103 1.41 -1.374 850. 0.288E+00 0.287E+00 0.214E-03 0.279E-13 11 33 32 13 37 32 10 13 21 0.000 0.000 0
+ 0 218 00:48:04.85 11.2000A -2.3389 -1.8994 4.0037 0.103 1.41 -1.387 850. 0.289E+00 0.288E+00 0.195E-03 0.253E-13 12 14 20 18 16 15 8 32 34 0.000 0.000 0
+ 0 219 00:48:16.35 11.5000A -2.3017 -1.8955 3.9243 0.103 1.41 -1.346 850. 0.290E+00 0.289E+00 0.200E-03 0.259E-13 12 33 32 18 16 15 8 32 34 0.000 0.000 0
+ 0 220 00:48:27.95 11.6000A -2.2801 -1.8107 3.8921 0.103 1.41 -1.346 850. 0.291E+00 0.290E+00 0.202E-03 0.262E-13 12 33 32 18 16 15 9 32 34 0.000 0.000 0
+ 0 221 00:48:38.95 11.0000A -2.3353 1.8971 4.0946 0.103 1.41 -1.448 850. 0.292E+00 0.291E+00 0.192E-03 0.249E-13 12 14 19 19 34 18 9 32 34 0.000 0.000 0
+ 0 222 00:48:50.35 11.4000A -2.3480 1.9730 3.9428 0.103 1.41 -1.364 850. 0.293E+00 0.292E+00 0.199E-03 0.258E-13 13 33 32 19 34 18 10 36 36 0.000 0.000 0
+ 0 223 00:49:01.15 10.8000A -2.4248 1.9834 4.1749 0.103 1.41 -1.370 850. 0.294E+00 0.292E+00 0.190E-03 0.245E-13 13 33 32 19 34 18 11 36 36 0.000 0.000 0
+ 0 224 00:49:11.95 10.8000A -2.3497 2.0124 4.1524 0.102 1.41 -1.364 850. 0.294E+00 0.293E+00 0.190E-03 0.245E-13 13 33 31 9 11 24 11 36 36 0.000 0.000 0
+ 0 225 00:49:22.55 10.6000A -2.2984 1.9886 4.2486 0.102 1.41 -1.354 850. 0.295E+00 0.294E+00 0.187E-03 0.241E-13 13 33 31 9 11 24 12 36 36 0.000 0.000 0
+ 0 226 00:49:33.25 10.7000A -2.1881 -1.9134 4.1931 0.102 1.41 -1.366 850. 0.295E+00 0.294E+00 0.189E-03 0.243E-13 13 33 30 17 12 16 12 36 36 0.000 0.000 0
+ 0 227 00:49:43.95 10.7000A -2.1459 -1.8974 4.1883 0.102 1.41 -1.415 850. 0.296E+00 0.294E+00 0.189E-03 0.243E-13 13 33 30 17 12 16 13 36 36 0.000 0.000 0
+ 0 228 00:49:55.25 11.3000A -2.1716 1.9677 3.9908 0.102 1.41 -1.485 850. 0.296E+00 0.295E+00 0.199E-03 0.256E-13 13 33 33 10 11 24 13 36 36 0.000 0.000 0
+ 0 229 00:50:05.95 10.7000A -2.0255 1.9272 4.2063 0.102 1.41 -1.460 850. 0.296E+00 0.295E+00 0.189E-03 0.242E-13 13 33 33 10 11 24 14 36 36 0.000 0.000 0
+ 0 230 00:50:17.25 11.3000A -2.1013 2.0264 3.9819 0.101 1.41 -1.422 850. 0.296E+00 0.295E+00 0.199E-03 0.255E-13 14 34 33 12 25 11 14 36 36 0.000 0.000 0
+ 0 231 00:50:28.45 11.2000A -2.2268 2.0277 4.0155 0.101 1.41 -1.397 850. 0.297E+00 0.295E+00 0.197E-03 0.253E-13 14 33 33 12 25 11 13 34 36 0.000 0.000 0
+ 0 232 00:50:39.95 11.5000A -2.1561 1.9510 3.9187 0.101 1.41 -1.401 850. 0.297E+00 0.295E+00 0.202E-03 0.259E-13 14 33 33 13 25 11 14 36 35 0.000 0.000 0
+ 0 233 00:50:51.25 11.3000A 2.0123 2.0613 3.9748 0.101 1.41 -1.356 850. 0.297E+00 0.295E+00 0.198E-03 0.254E-13 1 10 23 13 25 11 9 10 35 0.000 0.000 0
+ 0 234 00:51:02.65 11.4000A 1.9909 1.9421 3.9506 0.100 1.41 -1.348 850. 0.297E+00 0.295E+00 0.199E-03 0.255E-13 1 10 23 13 25 11 15 34 36 0.000 0.000 0
+ 0 235 00:51:13.75 11.1000A 2.0510 1.8487 4.0423 0.100 1.41 -1.358 850. 0.297E+00 0.295E+00 0.194E-03 0.248E-13 1 12 24 13 26 11 10 10 35 0.000 0.000 0
+ 0 236 00:51:25.55 11.8000A 2.0598 1.8076 3.8212 0.100 1.43 -1.355 900. 0.297E+00 0.295E+00 0.206E-03 0.263E-13 1 12 24 13 26 11 10 10 35 0.000 0.000 0
+ 0 237 00:51:36.85 11.3000A -2.1549 -1.9421 3.9902 0.100 1.43 -1.364 900. 0.296E+00 0.295E+00 0.197E-03 0.252E-13 19 27 23 13 13 15 11 10 35 0.000 0.000 0
+ 0 238 00:51:48.65 11.8000A -2.3317 -1.9758 3.8232 0.099 1.43 -1.375 900. 0.296E+00 0.295E+00 0.205E-03 0.263E-13 19 27 23 13 13 15 11 10 35 0.000 0.000 0
+ 0 239 00:52:00.55 11.9000A -2.3765 1.8428 3.7772 0.099 1.43 -1.393 900. 0.296E+00 0.295E+00 0.207E-03 0.266E-13 19 27 23 19 29 15 15 35 35 0.000 0.000 0
+ 0 240 00:52:12.75 12.2000A -2.2713 1.8206 3.6794 0.099 1.43 -1.437 900. 0.296E+00 0.294E+00 0.212E-03 0.272E-13 19 27 23 6 10 23 15 35 35 0.000 0.000 0
+ 0 241 00:52:24.95 12.2000A 2.2123 1.8394 3.6844 0.099 1.43 -1.442 900. 0.295E+00 0.294E+00 0.212E-03 0.272E-13 1 12 25 6 10 23 16 35 35 0.000 0.000 0
+ 0 242 00:52:37.05 12.1000A -2.2668 1.8654 3.7059 0.099 1.43 -1.438 900. 0.295E+00 0.294E+00 0.210E-03 0.271E-13 19 27 22 7 10 23 16 35 35 0.000 0.000 0
+ 0 243 00:52:49.65 12.6000A -2.2589 1.9678 3.5851 0.099 1.43 -1.476 900. 0.294E+00 0.293E+00 0.218E-03 0.282E-13 19 27 22 7 10 23 10 17 15 0.000 0.000 0
+ 0 244 00:53:02.05 12.4000A -2.0980 1.9365 3.6415 0.099 1.41 -1.429 850. 0.294E+00 0.293E+00 0.215E-03 0.278E-13 19 27 22 7 10 23 11 18 17 0.000 0.000 0
+ 0 245 00:53:14.35 12.3000A 2.0541 1.9614 3.6444 0.099 1.41 -1.435 850. 0.293E+00 0.292E+00 0.213E-03 0.276E-13 1 12 26 7 11 23 11 19 15 0.000 0.000 0
+ 0 246 00:53:26.55 12.2000A -1.9838 1.9415 3.6825 0.099 1.41 -1.442 850. 0.293E+00 0.292E+00 0.212E-03 0.274E-13 18 25 8 7 11 23 12 19 15 0.000 0.000 0
+ 0 247 00:53:38.55 12.0000A 1.9982 1.8132 3.7485 0.099 1.41 -1.438 850. 0.292E+00 0.291E+00 0.209E-03 0.270E-13 2 34 37 7 11 23 12 19 15 0.000 0.000 0
+ 0 248 00:53:50.55 12.0000A 1.9976 -1.7695 3.7382 0.099 1.41 -1.427 850. 0.292E+00 0.290E+00 0.209E-03 0.271E-13 2 34 37 12 25 25 12 19 15 0.000 0.000 0
+ 0 249 00:54:02.65 12.1000A 1.9531 -1.8877 3.7181 0.099 1.41 -1.414 850. 0.291E+00 0.290E+00 0.212E-03 0.273E-13 2 34 37 12 25 25 14 19 15 0.000 0.000 0
+ 0 250 00:54:15.05 12.4000A 1.9897 -1.8085 3.6162 0.099 1.41 -1.430 850. 0.290E+00 0.289E+00 0.217E-03 0.280E-13 2 12 25 17 9 14 14 19 15 0.000 0.000 0
+ 0 251 00:54:27.55 12.5000A 2.0719 -1.8378 3.5940 0.099 1.41 -1.468 850. 0.289E+00 0.288E+00 0.218E-03 0.282E-13 2 12 25 18 15 14 13 18 15 0.000 0.000 0
+ 0 252 00:54:39.95 12.4000A 2.0900 -1.8826 3.6288 0.099 1.41 -1.485 850. 0.288E+00 0.287E+00 0.216E-03 0.280E-13 2 12 25 18 15 14 13 18 15 0.000 0.000 0
+ 0 253 00:54:52.45 12.5000A -2.1700 1.8954 3.6132 0.099 1.43 -1.456 900. 0.287E+00 0.286E+00 0.218E-03 0.282E-13 19 37 32 6 6 25 14 18 15 0.000 0.000 0
+ 0 254 00:55:04.75 12.3000A -2.2313 1.9010 3.6714 0.099 1.43 -1.490 900. 0.286E+00 0.285E+00 0.215E-03 0.278E-13 19 37 32 6 6 25 14 17 15 0.000 0.000 0
+ 0 255 00:55:17.25 12.5000A -2.1618 -1.9215 3.5906 0.099 1.43 -1.466 900. 0.285E+00 0.284E+00 0.218E-03 0.282E-13 19 37 32 18 15 12 15 17 15 0.000 0.000 0
+ 0 256 00:55:29.75 12.5000A -2.1188 -2.0635 3.6038 0.099 1.43 -1.395 900. 0.284E+00 0.282E+00 0.218E-03 0.282E-13 19 37 31 18 15 12 15 17 15 0.000 0.000 0
+ 0 257 00:55:42.25 12.5000A 2.1225 -2.0613 3.6075 0.099 1.43 -1.380 900. 0.282E+00 0.281E+00 0.218E-03 0.282E-13 1 15 26 18 15 12 16 17 15 0.000 0.000 0
+ 0 258 00:55:54.75 12.5000A 2.2212 -2.0370 3.5998 0.099 1.43 -1.413 900. 0.281E+00 0.279E+00 0.218E-03 0.281E-13 1 15 26 18 14 12 16 17 15 0.000 0.000 0
+ 0 259 00:56:07.75 13.0000A 2.2177 -2.1735 3.4537 0.099 1.43 -1.389 900. 0.279E+00 0.278E+00 0.226E-03 0.292E-13 1 15 26 18 14 12 9 31 39 0.000 0.000 0
+ 0 260 00:56:20.75 13.0000A 2.1323 -2.1258 3.4580 0.099 1.43 -1.378 900. 0.278E+00 0.276E+00 0.225E-03 0.291E-13 1 15 26 18 14 12 10 31 39 0.000 0.000 0
+ 0 261 00:56:33.35 12.6000A 1.9967 2.0399 3.5714 0.099 1.43 -1.369 900. 0.276E+00 0.275E+00 0.218E-03 0.282E-13 1 15 26 1 13 24 10 31 39 0.000 0.000 0
+ 0 262 00:56:45.75 12.4000A -2.0360 2.0467 3.6366 0.099 1.43 -1.369 900. 0.275E+00 0.274E+00 0.215E-03 0.277E-13 6 34 37 1 13 24 11 31 39 0.000 0.000 0
+ 0 263 00:56:58.15 12.4000A -1.9791 1.9729 3.6331 0.098 1.43 -1.377 900. 0.274E+00 0.272E+00 0.214E-03 0.277E-13 19 37 29 1 13 24 11 31 39 0.000 0.000 0
+ 0 264 00:57:10.65 12.5000A -2.0077 -1.9707 3.6083 0.098 1.43 -1.394 900. 0.272E+00 0.271E+00 0.216E-03 0.278E-13 17 19 17 18 4 34 12 31 39 0.000 0.000 0
+ 0 265 00:57:23.55 12.9000A -2.0128 -1.9940 3.5009 0.098 1.43 -1.406 900. 0.271E+00 0.269E+00 0.223E-03 0.286E-13 17 19 17 6 11 29 13 31 39 0.000 0.000 0
+ 0 266 00:57:35.55 12.0000A -1.9421 -2.1178 3.7511 0.098 1.43 -1.421 900. 0.270E+00 0.268E+00 0.208E-03 0.266E-13 17 19 17 6 11 29 13 31 39 0.000 0.000 0
+ 0 267 00:57:47.85 12.3000A -1.8740 -2.1095 3.6684 0.098 1.43 -1.452 900. 0.269E+00 0.267E+00 0.213E-03 0.272E-13 5 11 35 6 11 29 13 31 39 0.000 0.000 0
+ 0 268 00:58:00.45 12.6000A -1.8624 2.0602 3.5713 0.097 1.43 -1.428 900. 0.268E+00 0.266E+00 0.218E-03 0.278E-13 5 11 35 2 13 25 10 18 19 0.000 0.000 0
+ 0 269 00:58:12.35 11.9000A -1.8333 -2.1000 3.7701 0.097 1.43 -1.435 900. 0.267E+00 0.265E+00 0.206E-03 0.262E-13 16 20 17 7 11 29 11 18 19 0.000 0.000 0
+ 0 270 00:58:24.25 11.9000A -1.8415 -2.0953 3.7739 0.097 1.43 -1.457 900. 0.266E+00 0.264E+00 0.206E-03 0.262E-13 16 20 17 5 11 30 11 18 19 0.000 0.000 0
+ 0 271 00:58:36.05 11.8000A -1.8307 -2.1794 3.8107 0.097 1.40 -1.487 850. 0.265E+00 0.264E+00 0.204E-03 0.260E-13 7 11 34 5 11 30 12 18 19 0.000 0.000 0
+ 0 272 00:58:48.05 12.0000A -1.8313 -2.2191 3.7376 0.097 1.40 -1.527 850. 0.265E+00 0.263E+00 0.208E-03 0.264E-13 5 10 35 5 11 30 12 18 19 0.000 0.000 0
+ 0 273 00:58:59.75 11.7000A -1.9459 -2.2205 3.8314 0.097 1.40 -1.574 850. 0.264E+00 0.262E+00 0.203E-03 0.258E-13 16 21 17 5 11 30 14 34 39 0.000 0.000 0
+ 0 274 00:59:11.85 12.1000A -2.0447 -2.2284 3.7215 0.097 1.40 -1.552 850. 0.264E+00 0.262E+00 0.210E-03 0.267E-13 16 21 17 5 10 30 14 34 39 0.000 0.000 0
+ 0 275 00:59:24.15 12.3000A -2.0819 -2.2455 3.6602 0.096 1.40 -1.548 850. 0.263E+00 0.261E+00 0.214E-03 0.272E-13 16 21 17 5 10 30 10 8 35 0.000 0.000 0
+ 0 276 00:59:36.45 12.3000A -2.0530 -2.2175 3.6709 0.096 1.43 -1.553 900. 0.263E+00 0.261E+00 0.214E-03 0.272E-13 16 21 17 5 10 30 13 18 20 0.000 0.000 0
+ 0 277 00:59:48.65 12.2000A -2.0658 2.1702 3.6915 0.096 1.43 -1.547 900. 0.262E+00 0.261E+00 0.213E-03 0.270E-13 16 21 16 1 9 28 13 18 20 0.000 0.000 0
+ 0 278 01:00:00.05 11.4000A -2.0744 2.2581 3.9420 0.096 1.43 -1.572 900. 0.262E+00 0.260E+00 0.199E-03 0.252E-13 16 21 16 1 9 28 14 18 20 0.000 0.000 0
Index: /palm/tags/release-3.4a/SCRIPTS/.mrun.config.default
===================================================================
--- /palm/tags/release-3.4a/SCRIPTS/.mrun.config.default (revision 141)
+++ /palm/tags/release-3.4a/SCRIPTS/.mrun.config.default (revision 141)
@@ -0,0 +1,262 @@
+#column 1 column 2 column 3
+#name of variable value of variable (~ must not be used) scope
+#----------------------------------------------------------------------------
+%mainprog palm.f90
+%base_directory $HOME/palm/current_version
+%base_data ~/palm/current_version/JOBS
+%source_path $base_directory/trunk/SOURCE
+%add_source_path $base_directory/USER_CODE/$fname
+%depository_path $base_directory/MAKE_DEPOSITORY
+%use_makefile true
+#
+# Enter your own host below by adding another line containing in the second
+# column your hostname (as provided by the unix command "hostname") and in the
+# third column the host identifier. Depending on your system, the first
+# characters of the host identifier should be "lc" (Linux cluster), "ibm"
+# (IBM-AIX), or "nec" (NEC-SX), respectively.
+%host_identifier bora lcmuk
+%host_identifier cs* nech
+%host_identifier hreg*-en0 ibmh
+%host_identifier hanni*-en0 ibmh
+%host_identifier breg*-en0 ibmb
+%host_identifier berni*-en0 ibmb
+%host_identifier tgg* lctit
+#
+#%remote_username lcmuk parallel
+%tmp_user_catalog /tmp lcmuk parallel
+%compiler_name mpif90 lcmuk parallel
+%compiler_name_ser ifort lcmuk parallel
+%cpp_options -DMPI_REAL=MPI_DOUBLE_PRECISION:-DMPI_2REAL=MPI_2DOUBLE_PRECISION:-D__netcdf:-D__netcdf_64bit:-D__intel_openmp_bug lcmuk parallel
+%netcdf_inc -I:/muksoft/packages/netcdf/linux/include lcmuk parallel
+%netcdf_lib -L/muksoft/packages/netcdf/linux/lib:-lnetcdf lcmuk parallel
+%fopts -axW:-cpp:-openmp:-r8:-nbs:-convert:little_endian lcmuk parallel
+%lopts -axW:-cpp:-openmp:-r8:-nbs:-Vaxlib lcmuk parallel
+#%hostfile $base_directory/.hostfile lcmuk parallel
+#
+#%remote_username lcmuk
+%tmp_user_catalog /tmp lcmuk
+%compiler_name ifort lcmuk
+%fopts -axW:-cpp:-r8:-nbs:-convert:little:endian lcmuk
+%lopts -axW:-cpp:-r8:-nbs:-Vaxlib lcmuk
+#
+#%remote_username lcmuk trace
+%tmp_user_catalog /tmp lcmuk trace
+%compiler_name ifort lcmuk trace
+%fopts -axW:-cpp:-g:-CB:-inline_debug_info:-r8:-nbs:-convert:little:endian lcmuk trace
+%lopts -axW:-cpp:-g:-CB:-inline_debug_info:-r8:-nbs:-Vaxlib lcmuk trace
+#
+#%remote_username lctit parallel
+#%tmp_user_catalog /work/ lctit parallel
+#%tmp_data_catalog /work//palm_restart_data lctit parallel
+%cpp_options -Mpreprocess:-DMPI_REAL=MPI_DOUBLE_PRECISION:-DMPI_2REAL=MPI_2DOUBLE_PRECISION:-D__netcdf lctit parallel
+%netcdf_inc -I:/home2/usr5/mkanda/netcdf-3.6.2/include lctit parallel
+%netcdf_lib -L/home2/usr5/mkanda/netcdf-3.6.2/lib:-lnetcdf lctit parallel
+%compiler_name_ser pgf95 lctit parallel
+%compiler_name mpif90 lctit parallel
+%fopts -r8:-fast:-fastsse lctit parallel
+%lopts -r8:-fast:-fastsse lctit parallel
+#
+#%remote_username ibmh parallel
+%compiler_name mpxlf95_r ibmh parallel
+%compiler_name_ser xlf95 ibmh parallel
+%cpp_options -qsuffix=cpp=f90:-WF,-DMPI_REAL=MPI_DOUBLE_PRECISION,-D__netcdf=__netcdf,-D__netcdf_64bit=__netcdf_64bit ibmh parallel
+%dvrp_inc -I/home/h/nikevita/lib_stable/optimize ibmh parallel
+%dvrp_lib -L/home/h/nikevita/lib_stable/optimize:-lDVRP2:-lftp ibmh parallel
+%netcdf_inc -I:/aws/dataformats/netcdf-3.6.0-p1/64-32/include-64 ibmh parallel
+%netcdf_lib -L/aws/dataformats/netcdf-3.6.0-p1/64-32/lib:-lnetcdf ibmh parallel
+%fopts -O3:-g:-qfloat=nomaf:-qrealsize=8:-Q:-q64:-qmaxmem=-1:-qtune=pwr4:-qarch=pwr4:-qnosave:-qnoescape ibmh parallel
+%lopts -O3:-g:-qfloat=nomaf:-qrealsize=8:-Q:-q64:-qmaxmem=-1:-qtune=pwr4:-qarch=pwr4:-qnosave:-qnoescape:-lesslsmp ibmh parallel
+%memory 1630 ibmh parallel
+%cpumax 1000 ibmh parallel
+%numprocs 4 ibmh parallel
+#%tmp_data_catalog /fastfs/work//palm_restart_data ibmh parallel
+#%email_notification ibmh parallel
+#
+#%remote_username ibmh parallel debug
+%compiler_name mpxlf95_r ibmh parallel debug
+%compiler_name_ser xlf95 ibmh parallel debug
+%cpp_options -qsuffix=cpp=f90:-WF,-DMPI_REAL=MPI_DOUBLE_PRECISION,-D__netcdf=__netcdf,-D__netcdf_64bit=__netcdf_64bit ibmh parallel debug
+%netcdf_inc -I:/aws/dataformats/netcdf-3.6.0-p1/64-32/include-64 ibmh parallel debug
+%netcdf_lib -L/aws/dataformats/netcdf-3.6.0-p1/64-32/lib:-lnetcdf ibmh parallel debug
+%fopts -qnoopt:-g:-C:-qinitauto=FFFFFFFF:-qrealsize=8:-Q:-q64:-qmaxmem=-1:-qnosave:-qnoescape:-qflttrap=overflow::zerodivide::invalid::enable:-qsigtrap ibmh parallel debug
+%lopts -qnoopt:-g:-C:-qinitauto=FFFFFFFF:-qrealsize=8:-Q:-q64:-qmaxmem=-1:-qnosave:-qnoescape:-qflttrap=overflow::zerodivide::invalid::enable:-qsigtrap:-lesslsmp ibmh parallel debug
+%memory 1000 ibmh parallel debug
+%cpumax 1000 ibmh parallel debug
+%numprocs 4 ibmh parallel debug
+#%tmp_data_catalog /fastfs/work//palm_restart_data ibmh parallel debug
+#
+#%remote_username ibmb parallel
+%compiler_name mpxlf95_r ibmb parallel
+%compiler_name_ser xlf95 ibmb parallel
+%cpp_options -qsuffix=cpp=f90:-WF,-DMPI_REAL=MPI_DOUBLE_PRECISION,-D__netcdf=__netcdf,-D__netcdf_64bit=__netcdf_64bit ibmb parallel
+%netcdf_inc -I:/aws/dataformats/netcdf-3.6.0-p1/64-32/include-64 ibmb parallel
+%netcdf_lib -L/aws/dataformats/netcdf-3.6.0-p1/64-32/lib:-lnetcdf ibmb parallel
+%fopts -O3:-g:-qfloat=nomaf:-qrealsize=8:-Q:-q64:-qmaxmem=-1:-qtune=pwr4:-qarch=pwr4:-qnosave:-qnoescape ibmb parallel
+%lopts -O3:-g:-qfloat=nomaf:-qrealsize=8:-Q:-q64:-qmaxmem=-1:-qtune=pwr4:-qarch=pwr4:-qnosave:-qnoescape:-lesslsmp ibmb parallel
+%memory 1630 ibmb parallel
+%cpumax 1000 ibmb parallel
+%numprocs 4 ibmb parallel
+#%tmp_data_catalog /fastfs/work//palm_restart_data ibmb parallel
+#
+#%remote_username nech parallel
+%compiler_name sxmpif90 nech parallel
+%compiler_name_ser sxf90 nech parallel
+%cpp_options -Ep:-DMPI_REAL=MPI_REAL8:-DMPI_2REAL=MPI_2REAL8:-DSCFFT=DZFFT:-DCSFFT=ZDFFT:-D__netcdf:-D__netcdf_64bit nech parallel
+%netcdf_inc -I:/pool/SX-6/netcdf/netcdf-3.6.0-p1/include nech parallel
+%netcdf_lib -L/pool/SX-6/netcdf/netcdf-3.6.0-p1/lib:-lnetcdf nech parallel
+%fopts -C:hopt:-Wf:\'-init:stack=nan:-init:heap=nan:-A:idbl4:-pvctl:fullmsg\':-ftrace:-P:stack:-pi:auto:-pi:line=1000 nech parallel
+%lopts -C:hopt:-Wf:\'-init:stack=nan:-init:heap=nan:-A:idbl4\':-ftrace:-P:stack:-pi:auto:-pi:line=1000:-L/SX/opt/MathKeisan/MK1_6/lib/:-l:fft nech parallel
+%memory 4000 nech parallel
+%cpumax 1000 nech parallel
+%numprocs 4 nech parallel
+%tmp_data_catalog $WRKSHR/palm_restart_data nech parallel
+#%email_notification nech parallel
+#
+#%remote_username neck parallel
+%compiler_name sxmpif90 neck parallel
+%compiler_name_ser sxf90 neck parallel
+%cpp_options -Ep:-DMPI_REAL=MPI_REAL8:-DMPI_2REAL=MPI_2REAL8:-DSCFFT=DZFFT:-DCSFFT=ZDFFT:-D__netcdf:-D__netcdf_64bit neck parallel
+%netcdf_inc -I:/home/DSRC/NC/tatuyama/pub/netcdf-3.6.0-p1/include neck parallel
+%netcdf_lib -L/home/DSRC/NC/tatuyama/pub/netcdf-3.6.0-p1/lib:-lnetcdf neck parallel
+%dvrp_inc -I/home/DSRC/NC/tatuyama/pub/dvrp neck parallel
+%dvrp_lib -L/home/DSRC/NC/tatuyama/pub/dvrp:-lDVRP2:-lftp neck parallel
+%fopts -C:hopt:-Wf:\'-init:stack=nan:-init:heap=nan:-A:idbl4:-pvctl:fullmsg\':-ftrace:-P:stack:-pi:auto:-pi:line=1000 neck parallel
+%lopts -C:hopt:-Wf:\'-init:stack=nan:-init:heap=nan:-A:idbl4\':-ftrace:-P:stack:-pi:auto:-pi:line=1000:-L/SX/opt/MathKeisan/MK1_6/lib/:-l:fft neck parallel
+%memory 4000 neck parallel
+%cpumax 1000 neck parallel
+%numprocs 4 neck parallel
+#%tmp_user_catalog neck parallel
+#%tmp_data_catalog /palm_restart_data neck parallel
+#
+%source_path $base_directory/SOURCE ibmy parallel
+%compiler_name mpxlf95_r ibmy parallel
+%compiler_name_ser xlf95 ibmy parallel
+%fopts -O3:-g:-qrealsize=8:-Q:-q64:-qmaxmem=-1:-qtune=pwr4:-qarch=pwr4:-qnosave:-qnoescape ibmy parallel
+%lopts -O3:-g:-qrealsize=8:-Q:-q64:-qmaxmem=-1:-qtune=pwr4:-qarch=pwr4:-qnosave:-qnoescape ibmy parallel
+%memory 1000 ibmy parallel
+%cpumax 1000 ibmy parallel
+%numprocs 4 ibmy parallel
+%remote_username raasch ibmy parallel
+%tmp_data_catalog /usr1/users/raasch/work ibmy parallel
+%tmp_user_catalog /usr1/users/raasch/work ibmy parallel
+%email_notification raasch@muk.uni-hannover.de ibmy parallel
+#
+%compiler_name mpxlf95_r ibmy parallel trace
+%compiler_name_ser xlf95 ibmy parallel trace
+%cpp_options -Ep:-DMPI_REAL=MPI_REAL8:-DMPI_2REAL=MPI_2REAL8:-DSCFFT=DZFFT:-DCSFFT=ZDFFT:-D__netcdf:-D__netcdf_64bit nech parallel
+%fopts -qnoopt:-g:-C:-qinitauto=FFFFFFFF:-qrealsize=8:-Q:-q64:-qmaxmem=-1:-qnosave:-qnoescape:-qflttrap=overflow::zerodivide::invalid::enable:-qsigtrap ibmy parallel trace
+%lopts -qnoopt:-g:-C:-qinitauto=FFFFFFFF:-qrealsize=8:-Q:-q64:-qmaxmem=-1:-qnosave:-qnoescape:-qflttrap=overflow::zerodivide::invalid::enable:-qsigtrap ibmy parallel trace
+%memory 1000 ibmy parallel trace
+%cpumax 1000 ibmy parallel trace
+%numprocs 4 ibmy parallel trace
+%remote_username raasch ibmy parallel trace
+%tmp_data_catalog /usr1/users/raasch/work ibmy parallel trace
+%tmp_user_catalog /usr1/users/raasch/work ibmy parallel trace
+%email_notification raasch@muk.uni-hannover.de ibmy parallel trace
+#
+%write_binary true restart
+#
+#----------------------------------------------------------------------------
+# INPUT-commands, executed before running PALM - lines must start with "IC:"
+#----------------------------------------------------------------------------
+#IC:[[ \$( echo \$localhost | cut -c1-3 ) = t3e ]] && assign -F cachea:512:1:1 f:BININ
+#
+#----------------------------------------------------------------------------
+# ERROR-commands - executed when program terminates abnormally
+#----------------------------------------------------------------------------
+EC:[[ \$locat = compile && ( \$( echo \$localhost | cut -c1-3 ) = t3e ) ]] && cat cflist.out
+EC:[[ \$locat = execution ]] && cat RUN_CONTROL
+EC:[[ \$locat = execution ]] && cat PARTICLE_INFOS/*
+EC:[[ \$( echo \$localhost | cut -c1-3 ) = t3e ]] && ls -al
+EC:[[ \$( echo \$localhost | cut -c1-3 ) = ibm ]] && ls -al
+#
+#----------------------------------------------------------------------------
+# OUTPUT-commands - executed when program terminates normally
+#----------------------------------------------------------------------------
+#
+OC:[[ -f CPU_MEASURES/_0000 ]] && cat CPU_MEASURES/* >> CPU_MEASURE_ALL
+# Combine 1D- and 3D-profile output (these files are not usable for plotting)
+OC:[[ -f LIST_PROFIL_1D ]] && cat LIST_PROFIL_1D >> LIST_PROFILE
+OC:[[ -f LIST_PROFIL ]] && cat LIST_PROFIL >> LIST_PROFILE
+#
+# Combine all particle information files
+OC:[[ -f PARTICLE_INFOS/_0000 ]] && cat PARTICLE_INFOS/* >> PARTICLE_INFO
+#
+# Extend number of files to be opened simultaneously (sometimes necessary
+# for combine_plot_fields
+#OC:[[ \$( echo \$localhost | cut -c1-3 ) = t3e ]] && limit -v -f 255 -p 0
+#
+# Combine the 2D- and 3D-plot-data of the subdomains (one file per PE) to
+# one file respectively
+OC:[[ \$( echo \$localhost | cut -c1-3 ) = t3e ]] && combine_plot_fields.x
+OC:[[ \$( echo \$localhost | cut -c1-3 ) = ibm ]] && combine_plot_fields.x
+OC:[[ \$( echo \$localhost | cut -c1-3 ) = nec ]] && combine_plot_fields.x
+OC:[[ \$( echo \$localhost | cut -c1-3 ) = dec ]] && combine_plot_fields.x
+OC:[[ \$( echo \$localhost | cut -c1-2 ) = lc ]] && combine_plot_fields.x
+#
+# Combine parameter files necessary for plot software (iso2d + AVS)
+OC:[[ -f PLOT2D_XY_GLOBAL ]] && cat PLOT2D_XY_LOCAL >> PLOT2D_XY_GLOBAL
+OC:[[ -f PLOT2D_XZ_GLOBAL ]] && cat PLOT2D_XZ_LOCAL >> PLOT2D_XZ_GLOBAL
+OC:[[ -f PLOT2D_YZ_GLOBAL ]] && cat PLOT2D_YZ_LOCAL >> PLOT2D_YZ_GLOBAL
+OC:[[ -f PLOT3D_FLD ]] && cat PLOT3D_FLD_COOR >> PLOT3D_FLD
+#
+# tar all 3D-plot-data files in case that compressed output is switched on
+OC:[[ -f PLOT3D_COMPRESSED ]] && tar cf PLOT3D_DATA PLOT3D_DATA_*
+#
+#----------------------------------------------------------------------------
+# List of input-files
+#----------------------------------------------------------------------------
+PARIN in:job d3# $base_data/$fname/INPUT _p3d
+PARIN in:job d3f $base_data/$fname/INPUT _p3df
+TOPOGRAPHY_DATA in:locopt d3# $base_data/$fname/INPUT _topo
+BININ in:loc:flpe d3f $base_data/$fname/RESTART _d3d
+PARTICLE_RESTART_DATA_IN in:loc:flpe prtf $base_data/$fname/RESTART _rprt
+DATA_1D_PR_NETCDF in:locopt prf $base_data/$fname/OUTPUT _pr nc
+DATA_1D_SP_NETCDF in:locopt spf $base_data/$fname/OUTPUT _sp nc
+DATA_1D_TS_NETCDF in:locopt tsf $base_data/$fname/OUTPUT _ts nc
+DATA_1D_PTS_NETCDF in:locopt ptsf $base_data/$fname/OUTPUT _pts nc
+DATA_2D_XY_NETCDF in:locopt xyf $base_data/$fname/OUTPUT _xy nc
+DATA_2D_XY_AV_NETCDF in:locopt xyf $base_data/$fname/OUTPUT _xy_av nc
+DATA_2D_XZ_NETCDF in:locopt xzf $base_data/$fname/OUTPUT _xz nc
+DATA_2D_YZ_NETCDF in:locopt yzf $base_data/$fname/OUTPUT _yz nc
+DATA_3D_NETCDF in:locopt 3df $base_data/$fname/OUTPUT _3d nc
+DATA_PRT_NETCDF in:locopt:pe prtf $base_data/$fname/OUTPUT _prt
+#
+#----------------------------------------------------------------------------
+# List of output-files
+#----------------------------------------------------------------------------
+BINOUT out:loc:flpe restart $base_data/$fname/RESTART _d3d
+PARTICLE_RESTART_DATA_OUT out:loc:flpe prt#:prtf $base_data/$fname/RESTART _rprt
+#
+RUN_CONTROL out:loc:tr d3# $base_data/$fname/MONITORING _rc
+RUN_CONTROL out:loc:tra d3f $base_data/$fname/MONITORING _rc
+HEADER out:loc:tr d3# $base_data/$fname/MONITORING _header
+HEADER out:loc:tra d3f $base_data/$fname/MONITORING _header
+CPU_MEASURES out:loc:tr d3# $base_data/$fname/MONITORING _cpu
+CPU_MEASURES out:loc:tra d3f $base_data/$fname/MONITORING _cpu
+DVRP_LOG out:loc:tr dv# $base_data/$fname/MONITORING _dvrp_log
+DVRP_LOG out:loc:tra dvf $base_data/$fname/MONITORING _dvrp_log
+PARTICLE_INFO out:loc:tr pt# $base_data/$fname/MONITORING _prt_info
+PARTICLE_INFO out:loc:tra ptf $base_data/$fname/MONITORING _prt_info
+#
+DATA_1D_PR_NETCDF out:loc:tr pr#:prf $base_data/$fname/OUTPUT _pr nc
+#DATA_1D_PR_NETCDF out:loc pr#:prf $base_data/$fname/OUTPUT _pr nc
+DATA_1D_SP_NETCDF out:loc:tr sp#:spf $base_data/$fname/OUTPUT _sp nc
+DATA_1D_TS_NETCDF out:loc:tr ts#:tsf $base_data/$fname/OUTPUT _ts nc
+DATA_1D_PTS_NETCDF out:loc:tr pts#:ptsf $base_data/$fname/OUTPUT _pts nc
+DATA_2D_XY_NETCDF out:loc:tr xy#:xyf $base_data/$fname/OUTPUT _xy nc
+DATA_2D_XY_AV_NETCDF out:loc:tr xy#:xyf $base_data/$fname/OUTPUT _xy_av nc
+DATA_2D_XZ_NETCDF out:loc:tr xz#:xzf $base_data/$fname/OUTPUT _xz nc
+DATA_2D_XZ_AV_NETCDF out:loc:tr xz#:xzf $base_data/$fname/OUTPUT _xz_av nc
+DATA_2D_YZ_NETCDF out:loc:tr yz#:yzf $base_data/$fname/OUTPUT _yz nc
+DATA_2D_YZ_AV_NETCDF out:loc:tr yz#:yzf $base_data/$fname/OUTPUT _yz_av nc
+DATA_3D_NETCDF out:loc:tr 3d#:3df $base_data/$fname/OUTPUT _3d nc
+DATA_3D_AV_NETCDF out:loc:tr 3d#:3df $base_data/$fname/OUTPUT _3d_av nc
+DATA_PRT_NETCDF out:loc:pe prt#:prtf $base_data/$fname/OUTPUT _prt nc
+DATA_PRT_NETCDF out:loc:trpe prt#:prtf $base_data/$fname/OUTPUT _prt nc
+#
+PLOT3D_FLD out:loc:tr avs $base_data/$fname/OUTPUT _fld fld
+PLOT3D_COOR out:loc:tr avs $base_data/$fname/OUTPUT _avscor
+PLOT3D_DATA out:loc:tr avs $base_data/$fname/OUTPUT _avs
+PARTICLE_DATA out:loc:flpe prt#:prtf $base_data/$fname/OUTPUT _prt_dat
+
Index: /palm/tags/release-3.4a/SCRIPTS/NCL/crosssections.ncl
===================================================================
--- /palm/tags/release-3.4a/SCRIPTS/NCL/crosssections.ncl (revision 141)
+++ /palm/tags/release-3.4a/SCRIPTS/NCL/crosssections.ncl (revision 141)
@@ -0,0 +1,154 @@
+load "$NCARG_ROOT/lib/ncarg/nclex/gsun/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/shea_util.ncl"
+
+; cross-sections
+; last change: $Id$
+
+begin
+;
+; set default value(s) for shell script variables assigned on command line
+ if ( .not. isvar("cm") ) then ; colormap
+ cm = "ncview_default"
+ end if
+ if ( .not. isvar("di") ) then ; input directory (with final /)
+ di = ""
+ end if
+ if ( .not. isvar("d") ) then ; output directory (with final /)
+ d = di
+ end if
+ if ( .not. isvar("fi") ) then ; base name of input file (without suffix)
+ fi = "example_xy"
+ end if
+ if ( .not. isvar("fill_mode") ) then ; "AreaFill", "RasterFill" or "CellFill"
+ fill_mode = "AreaFill"
+ end if
+ if ( .not. isvar("fo") ) then ; base name of output files (without suffix)
+ fo = ""
+ end if
+ if ( .not. isvar("mode") ) then ; output mode ("Fill" or "Line")
+ mode = "Fill"
+ end if
+ if ( .not. isvar("t") ) then ; output time step
+ t = 0
+ end if
+ if ( .not. isvar("var") ) then ; variable to be output
+ var = "u_xy"
+ end if
+ if ( .not. isvar("xs") ) then ; output x-coordinate range start (in m)
+ xs = -1e+38
+ end if
+ if ( .not. isvar("xe") ) then ; output x-coordinate range end (in m)
+ xe = 1e+38
+ end if
+ if ( .not. isvar("ys") ) then ; output y-coordinate range start (in m)
+ ys = -1e+38
+ end if
+ if ( .not. isvar("ye") ) then ; output y-coordinate range end (in m)
+ ye = 1e+38
+ end if
+ if ( .not. isvar("zs") ) then ; output z-coordinate range start (in m)
+ zs = -1e+38
+ end if
+ if ( .not. isvar("ze") ) then ; output z-coordinate range end (in m)
+ ze = 1e+38
+ end if
+;
+; open input file
+ f = addfile( di + fi + ".nc", "r" )
+;
+; open workstation(s) and set colormap
+ wks_x11 = gsn_open_wks("x11","cross-section") ; X11 workstation
+ gsn_define_colormap(wks_x11,cm)
+ if ( isvar("fo") ) then
+ wks_pdf = gsn_open_wks("pdf",d+fo) ; optional workstations
+ gsn_define_colormap(wks_pdf,cm)
+ wks_eps = gsn_open_wks("eps",d+fo) ; for output on file
+ gsn_define_colormap(wks_eps,cm)
+ wks_ps = gsn_open_wks("ps",d+fo)
+ gsn_define_colormap(wks_ps,cm)
+ end if
+;
+; read input data using 'coordinate subscripting'
+; NCL uses the closest corresponding values (in case of two equally distant
+; values NCL chooses the smaller one)
+ raw_data = f->$var$(t:t,{zs:ze},{ys:ye},{xs:xe})
+ raw_data!0 = "t"
+ raw_data!1 = "z"
+ raw_data!2 = "y"
+ raw_data!3 = "x"
+ time = raw_data&t
+;
+; reduce variable dimensions from 4D to 2D according to output ranges
+ if ( zs .eq. ze ) then
+ data = raw_data(0,0,:,:)
+ x_axis = "x"
+ y_axis = "y"
+ plane = "z"
+ if ( raw_data&z .eq. -1 ) then
+ level = "-average"
+ else
+ level = "=" + raw_data&z + "m"
+ end if
+ else
+ if ( ys .eq. ye ) then
+ data = raw_data(0,:,0,:)
+ x_axis = "x"
+ y_axis = "z"
+ plane = "y"
+ if ( raw_data&y .eq. -1 ) then
+ level = "-average"
+ else
+ level = "=" + raw_data&y + "m"
+ end if
+ else
+ if ( xs .eq. xe ) then
+ data = raw_data(0,:,:,0)
+ x_axis = "y"
+ y_axis = "z"
+ plane = "x"
+ if ( raw_data&x .eq. -1 ) then
+ level = "-average"
+ else
+ level = "=" + raw_data&x + "m"
+ end if
+ end if
+ end if
+ end if
+ delete( raw_data )
+;
+; set up resources
+ cs_res = True
+ cs_res@gsnMaximize = True
+ cs_res@gsnPaperOrientation = "portrait"
+ cs_res@gsnPaperWidth = 8.27
+ cs_res@gsnPaperHeight = 11.69
+ cs_res@gsnPaperMargin = 0.79
+ cs_res@tiMainFuncCode = "~"
+ cs_res@tiMainFontHeightF = 0.015
+ cs_res@tiMainString = f@title
+ cs_res@tiXAxisString = x_axis + " [m]"
+ cs_res@tiYAxisString = y_axis + " [m]"
+; cs_res@gsnLeftString = "" ; gsn_csm_* scripts use default data
+ cs_res@gsnCenterString = "t=" + time + "s " + plane + level
+; cs_res@gsnRightString = "" ; gsn_csm_* scripts use default data
+ cs_res@tmXBMode ="Automatic"
+ cs_res@tmYLMode ="Automatic"
+ if ( mode .eq. "Fill" ) then
+ cs_res@cnFillOn = True
+ cs_res@gsnSpreadColors = True
+ cs_res@cnFillMode = fill_mode
+ cs_res@lbOrientation = "Vertical" ; vertical label bar
+ cs_res@cnLinesOn = False
+ cs_res@cnLineLabelsOn = False
+ end if
+;
+; data output
+ plot_x11 = gsn_csm_contour(wks_x11,data,cs_res)
+ if ( isvar("fo") ) then
+ plot_pdf = gsn_csm_contour(wks_pdf,data,cs_res)
+ plot_eps = gsn_csm_contour(wks_eps,data,cs_res)
+ plot_ps = gsn_csm_contour(wks_ps, data,cs_res)
+ end if
+end
Index: /palm/tags/release-3.4a/SCRIPTS/NCL/crosssections.usage.txt
===================================================================
--- /palm/tags/release-3.4a/SCRIPTS/NCL/crosssections.usage.txt (revision 141)
+++ /palm/tags/release-3.4a/SCRIPTS/NCL/crosssections.usage.txt (revision 141)
@@ -0,0 +1,58 @@
+Usage of PALM NCL script crosssections.ncl
+==========================================
+Last change: $Id$
+Marcus Letzel, 17 July 2007
+
+Command-line syntax
+===================
+ncl crosssections.ncl [parameters]
+
+The parameter syntax depends on their data type:
+A) numeric data : parameter=value (for example t=0)
+B) character string: 'parameter="string"' (for example 'var="u_xy"')
+
+Alphabetical parameter list
+===========================
+Name Default value Meaning
+-----------------------------------------------------------------------------
+cm "ncview_default" colormap
+di "" input directory (with final /)
+d =di output directory (with final /)
+fi "example_xy" base name of input file (without suffix)
+fo "" base name of output files (without suffix)
+fill_mode "AreaFill" fill mode for mode="Fill":
+ "AreaFill", "RasterFill" or "CellFill"
+mode "Fill" output mode ("Fill" or "Line")
+t 0 output time step
+var "u_xy" variable to be output
+xs -1e+38 output x-coordinate range start (in m)
+xe +1e+38 output x-coordinate range end (in m)
+ys -1e+38 output y-coordinate range start (in m)
+ye +1e+38 output y-coordinate range end (in m)
+zs -1e+38 output z-coordinate range start (in m)
+ze +1e+38 output z-coordinate range end (in m)
+
+Usage
+=====
+This script draws NCL contour plots from two-dimensional cross-sections of
+NetCDF data produced by PALM. Instantaneous or time-averaged xy-, xz-, yz- or
+3D-data can be used with this script.
+
+The sectional plane has neither a default orientation nor a default position.
+Both must be specified together using the coordinate range parameters:
+- For xy cross-sections specify zs and ze (with zs=za).
+- For xz cross-sections specify ys and ye (with ys=ya).
+- For yz cross-sections specify xs and xe (with xs=xa).
+
+The remaining coordinate range parameters can optionally be used to restrict
+the output coordinate range.
+
+By default, only screen output is produced. Additional file output is optional
+and requires to specify the parameter fo. This will create three files: fo.pdf,
+fo.eps and fo.ps.
+
+Input and output files can optionally be preceeded by an input and output
+directory di and d, respectively. If not specified, this scripts expects the
+input file to reside in the current directory.
+
+The contours can be drawn either in "Fill" (default) or "Line" mode.
Index: /palm/tags/release-3.4a/SCRIPTS/NCL/crosssections_new.ncl
===================================================================
--- /palm/tags/release-3.4a/SCRIPTS/NCL/crosssections_new.ncl (revision 141)
+++ /palm/tags/release-3.4a/SCRIPTS/NCL/crosssections_new.ncl (revision 141)
@@ -0,0 +1,473 @@
+load "$NCARG_ROOT/lib/ncarg/nclex/gsun/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/shea_util.ncl"
+
+; cross-sections
+; last change: $Id$
+
+begin
+;
+; set default value(s) for shell script variables assigned on command line
+ if ( .not. isvar("cm") ) then ; colormap
+ cm = "ncview_default"
+ end if
+ if ( .not. isvar("di") ) then ; input directory (with final /)
+ di = ""
+ end if
+ if ( .not. isvar("d") ) then ; output directory (with final /)
+ d = di
+ end if
+ if ( .not. isvar("fi") ) then ; base name of input file (without suffix)
+ fi = "example_xy"
+ end if
+ if ( .not. isvar("fill_mode") ) then ; "AreaFill", "RasterFill" or "CellFill"
+ fill_mode = "AreaFill"
+ end if
+ if ( .not. isvar("fo") ) then ; base name of output files (without suffix)
+ fo = ""
+ end if
+ if ( .not. isvar("mode") ) then ; output mode ("Fill" or "Line")
+ mode = "Fill"
+ end if
+ if ( .not. isvar("t") ) then ; output time step
+ t = 0
+ end if
+ if ( .not. isvar("var") ) then ; variable to be output
+ var = "u_xy"
+ end if
+ if ( .not. isvar("xs") ) then ; output x-coordinate range start (in m)
+ xs = -1e+38
+ end if
+ if ( .not. isvar("xe") ) then ; output x-coordinate range end (in m)
+ xe = 1e+38
+ end if
+ if ( .not. isvar("ys") ) then ; output y-coordinate range start (in m)
+ ys = -1e+38
+ end if
+ if ( .not. isvar("ye") ) then ; output y-coordinate range end (in m)
+ ye = 1e+38
+ end if
+ if ( .not. isvar("zs") ) then ; output z-coordinate range start (in m)
+ zs = -1e+38
+ end if
+ if ( .not. isvar("ze") ) then ; output z-coordinate range end (in m)
+ ze = 1e+38
+ end if
+;
+; open input file
+ f = addfile( di + fi + ".nc", "r" )
+;
+; open workstation(s) and set colormap
+ wks_x11 = gsn_open_wks("x11","cross-section") ; X11 workstation
+ gsn_define_colormap(wks_x11,cm)
+ if ( isvar("fo") ) then
+ wks_pdf = gsn_open_wks("pdf",d+fo) ; optional workstations
+ gsn_define_colormap(wks_pdf,cm)
+ wks_eps = gsn_open_wks("eps",d+fo) ; for output on file
+ gsn_define_colormap(wks_eps,cm)
+ wks_ps = gsn_open_wks("ps",d+fo)
+ gsn_define_colormap(wks_ps,cm)
+ end if
+;
+; read input data using 'coordinate subscripting'
+; NCL uses the closest corresponding values (in case of two equally distant
+; values NCL chooses the smaller one)
+ raw_data = f->$var$(t:t,{zs:ze},{ys:ye},{xs:xe})
+ raw_data!0 = "t"
+ raw_data!1 = "z"
+ raw_data!2 = "y"
+ raw_data!3 = "x"
+ time = raw_data&t
+;
+; reduce variable dimensions from 4D to 2D according to output ranges
+ if ( zs .eq. ze ) then
+ data = raw_data(0,0,:,:)
+ x_axis = "x"
+ y_axis = "y"
+ plane = "z"
+
+ dx = f->x(1)
+ dy = f->y(1)
+
+ if ( raw_data&z .eq. -1 ) then
+ level = "-average"
+ else
+ level = "=" + raw_data&z + "m"
+ end if
+ else
+ if ( ys .eq. ye ) then
+ data = raw_data(0,:,0,:)
+ x_axis = "x"
+ y_axis = "z"
+ plane = "y"
+
+ dx = f->x(1)
+ if (isfilevar(f, "zw_3d")) then
+ dz = f->zw_3d(1)
+ else
+ dz = f->zw(1)
+ end if
+
+ if ( raw_data&y .eq. -1 ) then
+ level = "-average"
+ else
+ level = "=" + raw_data&y + "m"
+ end if
+ else
+ if ( xs .eq. xe ) then
+ data = raw_data(0,:,:,0)
+ x_axis = "y"
+ y_axis = "z"
+ plane = "x"
+
+ dy = f->y(1)
+ if (isfilevar(f, "zw_3d")) then
+ dz = f->zw_3d(1)
+ else
+ dz = f->zw(1)
+ end if
+
+ if ( raw_data&x .eq. -1 ) then
+ level = "-average"
+ else
+ level = "=" + raw_data&x + "m"
+ end if
+ end if
+ end if
+ end if
+ delete( raw_data )
+;
+; set up resources
+ cs_res = True
+ cs_res@gsnDraw = False
+ cs_res@gsnFrame = False
+ cs_res@gsnMaximize = True
+ cs_res@gsnPaperOrientation = "portrait"
+ cs_res@gsnPaperWidth = 8.27
+ cs_res@gsnPaperHeight = 11.69
+ cs_res@gsnPaperMargin = 0.79
+ cs_res@tiMainFuncCode = "~"
+ cs_res@tiMainFontHeightF = 0.015
+ cs_res@tiMainString = f@title
+ cs_res@tiXAxisString = x_axis + " [m]"
+ cs_res@tiYAxisString = y_axis + " [m]"
+; cs_res@gsnLeftString = "" ; gsn_csm_* scripts use default data
+ cs_res@gsnCenterString = "t=" + time + "s " + plane + level
+; cs_res@gsnRightString = "" ; gsn_csm_* scripts use default data
+ cs_res@tmXBMode ="Automatic"
+ cs_res@tmYLMode ="Automatic"
+ if ( mode .eq. "Fill" ) then
+ cs_res@cnFillOn = True
+ cs_res@gsnSpreadColors = True
+ cs_res@cnFillMode = fill_mode
+ cs_res@lbOrientation = "Vertical" ; vertical label bar
+ cs_res@cnLinesOn = False
+ cs_res@cnLineLabelsOn = False
+ end if
+
+ vector = True
+ co_overlay = True
+
+ if ( .not. isvar("wv1") ) then
+ vector = False
+ end if
+ if ( .not. isvar("wv2") ) then
+ vector = False
+ end if
+ if ( .not. isvar("co") ) then
+ co_overlay = False
+ end if
+
+ if ( vector .eq. True ) then
+
+ if ( wv1 .eq. "u_xy" .or. wv1 .eq. "u_xz" .or. wv1 .eq. "u_yz" ) then
+
+ raw_data = f->$wv1$(t:t,{zs:ze},{ys:ye},{xs-(0.5*dx):xe-(0.5*dx)})
+ raw_data!0 = "t"
+ raw_data!1 = "z"
+ raw_data!2 = "y"
+ raw_data!3 = "x"
+ time = raw_data&t
+
+ else
+
+ if ( wv1 .eq. "v_xy" .or. wv1 .eq. "v_xz" .or. wv1 .eq. "v_yz" ) then
+
+ raw_data = f->$wv1$(t:t,{zs:ze},{ys-(0.5*dy):ye-(0.5*dy)},{xs:xe})
+ raw_data!0 = "t"
+ raw_data!1 = "z"
+ raw_data!2 = "y"
+ raw_data!3 = "x"
+ time = raw_data&t
+
+ else
+
+ if ( wv1 .eq. "w_xy" .or. wv1 .eq. "w_xz" .or. wv1 .eq. "w_yz" ) then
+
+ raw_data = f->$wv1$(t:t,{zs+(0.5*dz):ze+(0.5*dz)},{ys:ye},{xs:xe})
+ raw_data!0 = "t"
+ raw_data!1 = "z"
+ raw_data!2 = "y"
+ raw_data!3 = "x"
+ time = raw_data&t
+
+ end if
+ end if
+ end if
+
+ if ( zs .eq. ze ) then
+ data_u = raw_data(0,0,:,:)
+ else
+ if ( ys .eq. ye ) then
+ data_u = raw_data(0,:,0,:)
+ else
+ if ( xs .eq. xe ) then
+ data_u = raw_data(0,:,:,0)
+ end if
+ end if
+ end if
+ delete( raw_data )
+
+ if ( wv2 .eq. "u_xy" .or. wv2 .eq. "u_xz" .or. wv2 .eq. "u_yz" ) then
+
+ raw_data = f->$wv2$(t:t,{zs:ze},{ys:ye},{xs-(0.5*dx):xe-(0.5*dx)})
+ raw_data!0 = "t"
+ raw_data!1 = "z"
+ raw_data!2 = "y"
+ raw_data!3 = "x"
+ time = raw_data&t
+
+ else
+
+ if ( wv2 .eq. "v_xy" .or. wv2 .eq. "v_xz" .or. wv2 .eq. "v_yz" ) then
+
+ raw_data = f->$wv2$(t:t,{zs:ze},{ys-(0.5*dy):ye-(0.5*dy)},{xs:xe})
+ raw_data!0 = "t"
+ raw_data!1 = "z"
+ raw_data!2 = "y"
+ raw_data!3 = "x"
+ time = raw_data&t
+
+ else
+
+ if ( wv2 .eq. "w_xy" .or. wv2 .eq. "w_xz" .or. wv2 .eq. "w_yz" ) then
+
+ raw_data = f->$wv2$(t:t,{zs+(0.5*dz):ze+(0.5*dz)},{ys:ye},{xs:xe})
+ raw_data!0 = "t"
+ raw_data!1 = "z"
+ raw_data!2 = "y"
+ raw_data!3 = "x"
+ time = raw_data&t
+
+ end if
+ end if
+ end if
+
+
+ if ( zs .eq. ze ) then
+ data_v = raw_data(0,0,:,:)
+ else
+ if ( ys .eq. ye ) then
+ data_v = raw_data(0,:,0,:)
+ else
+ if ( xs .eq. xe ) then
+ data_v = raw_data(0,:,:,0)
+ end if
+ end if
+ end if
+ delete( raw_data )
+
+ wv_res = True
+ wv_res@gsnDraw = False
+ wv_res@gsnFrame = False
+ wv_res@gsnRightString = ""
+ wv_res@gsnLeftString = ""
+ wv_res@gsnCenterString = ""
+ wv_res@vpClipOn = True
+
+ end if
+
+ if ( co_overlay .eq. True ) then
+
+ raw_data = f->$co$(t:t,{zs:ze},{ys:ye},{xs:xe})
+ raw_data!0 = "t"
+ raw_data!1 = "z"
+ raw_data!2 = "y"
+ raw_data!3 = "x"
+ time = raw_data&t
+
+ if ( zs .eq. ze ) then
+ data2 = raw_data(0,0,:,:)
+ else
+ if ( ys .eq. ye ) then
+ data2 = raw_data(0,:,0,:)
+ else
+ if ( xs .eq. xe ) then
+ data2 = raw_data(0,:,:,0)
+ end if
+ end if
+ end if
+ delete( raw_data )
+
+ co_res = True
+ co_res@cnLineThicknessF = 1.0
+ co_res@gsnDraw = False
+ co_res@gsnFrame = False
+ co_res@gsnContourZeroLineThicknessF = 2.0
+ co_res@gsnContourNegLineDashPattern = 4
+ co_res@cnLineColor = "Black"
+ co_res@gsnRightString = ""
+ co_res@gsnLeftString = ""
+ co_res@gsnCenterString = ""
+
+; co_res1@cnLevelSelectionMode = "ManualLevels" ; set manual contour levels
+; co_res1@cnMinLevelValF = -5. ; set min contour level
+; co_res1@cnMaxLevelValF = 5. ; set max contour level
+; co_res1@cnLevelSpacingF = 0.5 ; set contour spacing
+ co_res@cnLineLabelsOn = True
+ co_res@cnLineLabelPlacementMode = "constant"
+; co_res@cnLineLabelBackgroundColor = "white"
+
+ end if
+
+ if ( co_overlay .eq. True .and. vector .eq. True ) then
+
+ if ( isvar("fo") ) then
+
+ plot_pdf2 = gsn_csm_contour(wks_pdf,data2,co_res)
+ plot_pdf1 = gsn_csm_contour(wks_pdf,data,cs_res)
+ plot_pdf3 = gsn_csm_vector(wks_pdf,data_u,data_v,wv_res)
+ overlay(plot_pdf1,plot_pdf2)
+ overlay(plot_pdf1,plot_pdf3)
+ draw(plot_pdf1)
+ frame(wks_pdf)
+
+ plot_eps2 = gsn_csm_contour(wks_eps,data2,co_res)
+ plot_eps1 = gsn_csm_contour(wks_eps,data,cs_res)
+ plot_eps3 = gsn_csm_vector(wks_eps,data_u,data_v,wv_res)
+ overlay(plot_eps1,plot_eps2)
+ overlay(plot_eps1,plot_eps3)
+ draw(plot_eps1)
+ frame(wks_eps)
+
+ plot_ps2 = gsn_csm_contour(wks_ps,data2,co_res)
+ plot_ps1 = gsn_csm_contour(wks_ps,data,cs_res)
+ plot_ps3 = gsn_csm_vector(wks_ps,data_u,data_v,wv_res)
+ overlay(plot_ps1,plot_ps2)
+ overlay(plot_ps1,plot_ps3)
+ draw(plot_ps1)
+ frame(wks_ps)
+
+ end if
+
+ plot1 = gsn_csm_contour(wks_x11,data,cs_res)
+ plot2 = gsn_csm_contour(wks_x11,data2,co_res)
+ plot3 = gsn_csm_vector(wks_x11,data_u,data_v,wv_res)
+
+ overlay(plot1,plot2)
+ overlay(plot1,plot3)
+
+ draw(plot1)
+ frame(wks_x11)
+
+ else
+
+ if ( co_overlay .eq. True .and. vector .ne. True ) then
+
+ if ( isvar("fo") ) then
+
+ plot_pdf2 = gsn_csm_contour(wks_pdf,data2,co_res)
+ plot_pdf1 = gsn_csm_contour(wks_pdf,data,cs_res)
+ overlay(plot_pdf1,plot_pdf2)
+ draw(plot_pdf1)
+ frame(wks_pdf)
+
+ plot_eps2 = gsn_csm_contour(wks_eps,data2,co_res)
+ plot_eps1 = gsn_csm_contour(wks_eps,data,cs_res)
+ overlay(plot_eps1,plot_eps2)
+ draw(plot_eps1)
+ frame(wks_eps)
+
+ plot_ps2 = gsn_csm_contour(wks_ps,data2,co_res)
+ plot_ps1 = gsn_csm_contour(wks_ps,data,cs_res)
+ overlay(plot_ps1,plot_ps2)
+ draw(plot_ps1)
+ frame(wks_ps)
+
+ end if
+
+ plot1 = gsn_csm_contour(wks_x11,data,cs_res)
+ plot2 = gsn_csm_contour(wks_x11,data2,co_res)
+
+ overlay(plot1,plot2)
+
+ draw(plot1)
+ frame(wks_x11)
+
+ else
+
+ if ( co_overlay .ne. True .and. vector .eq. True ) then
+
+ if ( isvar("fo") ) then
+
+ plot_pdf1 = gsn_csm_contour(wks_pdf,data,cs_res)
+ plot_pdf3 = gsn_csm_vector(wks_pdf,data_u,data_v,wv_res)
+ overlay(plot_pdf1,plot_pdf3)
+ draw(plot_pdf1)
+ frame(wks_pdf)
+
+ plot_eps1 = gsn_csm_contour(wks_eps,data,cs_res)
+ plot_eps3 = gsn_csm_vector(wks_eps,data_u,data_v,wv_res)
+ overlay(plot_eps1,plot_eps3)
+ draw(plot_eps1)
+ frame(wks_eps)
+
+ plot_ps1 = gsn_csm_contour(wks_ps,data,cs_res)
+ plot_ps3 = gsn_csm_vector(wks_ps,data_u,data_v,wv_res)
+ overlay(plot_ps1,plot_ps3)
+ draw(plot_ps1)
+ frame(wks_ps)
+
+ end if
+
+ plot1 = gsn_csm_contour(wks_x11,data,cs_res)
+ plot3 = gsn_csm_vector(wks_x11,data_u,data_v,wv_res)
+
+ overlay(plot1,plot3)
+
+ draw(plot1)
+ frame(wks_x11)
+
+ else
+
+ if ( co_overlay .ne. True .and. vector .ne. True) then
+
+ if ( isvar("fo") ) then
+
+ plot_pdf1 = gsn_csm_contour(wks_pdf,data,cs_res)
+ draw(plot_pdf1)
+ frame(wks_pdf)
+
+ plot_eps1 = gsn_csm_contour(wks_eps,data,cs_res)
+ draw(plot_eps1)
+ frame(wks_eps)
+
+ plot_ps1 = gsn_csm_contour(wks_ps,data,cs_res)
+ draw(plot_ps1)
+ frame(wks_ps)
+
+ end if
+
+ plot1 = gsn_csm_contour(wks_x11,data,cs_res)
+
+ draw(plot1)
+ frame(wks_x11)
+
+ end if
+ end if
+ end if
+
+ end if
+
+end
Index: /palm/tags/release-3.4a/SCRIPTS/NCL/crosssections_new.usage.txt
===================================================================
--- /palm/tags/release-3.4a/SCRIPTS/NCL/crosssections_new.usage.txt (revision 141)
+++ /palm/tags/release-3.4a/SCRIPTS/NCL/crosssections_new.usage.txt (revision 141)
@@ -0,0 +1,65 @@
+Usage of PALM NCL script crosssections_new.ncl
+==============================================
+Last change: $Id$
+initial version: Marcus Letzel, 17 July 2007
+contour and vector overlay: Theres Franke/Marcus Letzel, 26 July 2007
+
+Command-line syntax
+===================
+ncl crosssections_new.ncl [parameters]
+
+The parameter syntax depends on their data type:
+A) numeric data : parameter=value (for example t=0)
+B) character string: 'parameter="string"' (for example 'var="u_xy"')
+
+Alphabetical parameter list
+===========================
+Name Default value Meaning
+-----------------------------------------------------------------------------
+cm "ncview_default" colormap
+di "" input directory (with final /)
+d =di output directory (with final /)
+fi "example_xy" base name of input file (without suffix)
+fo "" base name of output files (without suffix)
+fill_mode "AreaFill" fill mode for mode="Fill":
+ "AreaFill", "RasterFill" or "CellFill"
+mode "Fill" output mode ("Fill" or "Line")
+t 0 output time step
+var "u_xy" variable to be output
+xs -1e+38 output x-coordinate range start (in m)
+xe +1e+38 output x-coordinate range end (in m)
+ys -1e+38 output y-coordinate range start (in m)
+ye +1e+38 output y-coordinate range end (in m)
+zs -1e+38 output z-coordinate range start (in m)
+ze +1e+38 output z-coordinate range end (in m)
+co variable to be output as contour overlay
+wv1 first component of wind vector overlay
+wv2 second component of wind vector overlay
+
+Usage
+=====
+This script draws NCL contour plots from two-dimensional cross-sections of
+NetCDF data produced by PALM. Instantaneous or time-averaged xy-, xz-, yz- or
+3D-data can be used with this script.
+
+The sectional plane has neither a default orientation nor a default position.
+Both must be specified together using the coordinate range parameters:
+- For xy cross-sections specify zs and ze (with zs=za).
+- For xz cross-sections specify ys and ye (with ys=ya).
+- For yz cross-sections specify xs and xe (with xs=xa).
+
+The remaining coordinate range parameters can optionally be used to restrict
+the output coordinate range.
+
+By default, only screen output is produced. Additional file output is optional
+and requires to specify the parameter fo. This will create three files: fo.pdf,
+fo.eps and fo.ps.
+
+Input and output files can optionally be preceeded by an input and output
+directory di and d, respectively. If not specified, this scripts expects the
+input file to reside in the current directory.
+
+The contours can be drawn either in "Fill" (default) or "Line" mode.
+
+The parameter co activates an optional contour overlay; the parameters wv1 and
+wv2 activate an optional vector overlay.
Index: /palm/tags/release-3.4a/SCRIPTS/NCL/plotts.ncl
===================================================================
--- /palm/tags/release-3.4a/SCRIPTS/NCL/plotts.ncl (revision 141)
+++ /palm/tags/release-3.4a/SCRIPTS/NCL/plotts.ncl (revision 141)
@@ -0,0 +1,111 @@
+load "$NCARG_ROOT/lib/ncarg/nclex/gsun/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/shea_util.ncl"
+
+; time series
+; last change: $Id$
+
+begin
+;
+; set default value(s) for shell script variables assigned on command line
+ if ( .not. isvar("cm") ) then ; colormap
+ cm = "ncview_default"
+ end if
+ if ( .not. isvar("di") ) then ; input directory (with final /)
+ di = ""
+ end if
+ if ( .not. isvar("d") ) then ; output directory (with final /)
+ d = di
+ end if
+ if ( .not. isvar("fi") ) then ; base name of input file (without suffix)
+ fi = "example_xy"
+ end if
+ if ( .not. isvar("fo") ) then ; base name of output files (without suffix)
+ fo = ""
+ end if
+ if ( .not. isvar("ts") ) then ; output time step
+ ts = 0
+ end if
+ if ( .not. isvar("te") ) then ; output x-coordinate range start (in m)
+ te = 0
+ end if
+;
+; open input file
+ f = addfile( di + fi + ".nc", "r" )
+;
+; open workstation(s) and set colormap
+ wks_x11 = gsn_open_wks("x11","cross-section") ; X11 workstation
+ gsn_define_colormap(wks_x11,cm)
+ if ( isvar("fo") ) then
+ wks_pdf = gsn_open_wks("pdf",d+fo) ; optional workstations
+ gsn_define_colormap(wks_pdf,cm)
+ wks_eps = gsn_open_wks("eps",d+fo) ; for output on file
+ gsn_define_colormap(wks_eps,cm)
+ wks_ps = gsn_open_wks("ps",d+fo)
+ gsn_define_colormap(wks_ps,cm)
+ end if
+;
+; read input data using 'coordinate subscripting'
+; NCL uses the closest corresponding values (in case of two equally distant
+; values NCL chooses the smaller one)
+
+ if ( .not. isvar("var1") .and. .not. isvar("var2") .and. .not. isvar("var3") .and. .not. isvar("var4") .and. .not. isvar("var5") .and. .not. isvar("var6")) then
+ vNam = getfilevarnames(f)
+ n2 = dimsizes(vNam)-1
+
+ print(vNam)
+
+ else
+
+ vNam = new((/6/), string)
+
+ vNam(0) = var1
+ vNam(1) = var2
+ vNam(2) = var3
+ vNam(3) = var4
+ vNam(4) = var5
+ vNam(5) = var6
+ n2 = 6
+ end if
+
+ t= f ->time({ts:te})
+
+ res=True
+ res@gsnDraw=False
+ res@gsnFrame=False
+
+ resP = True
+ resP@txString="time series"
+
+ res@vpWidthF=4
+
+ plot=new(40,graphic) ; create a plot array
+ plot_pdf=new(40,graphic) ; create a plot array
+ plot_ps=new(40,graphic) ; create a plot array
+ plot_eps=new(40,graphic) ; create a plot array
+
+ n = 0
+
+ do while ( n .lt. n2)
+ data = f ->$vNam(n)$({ts:te})
+ plot(n) = gsn_csm_xy(wks_x11,t,data,res)
+ plot_pdf(n) = gsn_csm_xy(wks_pdf,t,data,res)
+ plot_eps(n) = gsn_csm_xy(wks_eps,t,data,res)
+ plot_ps(n) = gsn_csm_xy(wks_ps,t,data,res)
+ n = n + 1
+ end do
+
+ pa = 0
+ pb = 5
+
+ do while ( pa .lt. dimsizes(plot) )
+ gsn_panel(wks_pdf,plot_pdf(pa:pb),(/6,1/),resP) ; Panel the plots, first using rows x columns, then using number of plots per row
+ gsn_panel(wks_eps,plot_eps(pa:pb),(/6,1/),resP)
+ gsn_panel(wks_ps,plot_ps(pa:pb),(/6,1/),resP)
+ gsn_panel(wks_x11,plot(pa:pb),(/6,1/),resP)
+ pa = pa + 6
+ pb = pb + 6
+ end do
+
+end
Index: /palm/tags/release-3.4a/SCRIPTS/batch_scp
===================================================================
--- /palm/tags/release-3.4a/SCRIPTS/batch_scp (revision 141)
+++ /palm/tags/release-3.4a/SCRIPTS/batch_scp (revision 141)
@@ -0,0 +1,691 @@
+#! /bin/ksh
+# batch_scp - Shellskript Version: @(#)batch_scp 1.0a 25/10/05
+# $Id: batch_scp 54 2007-03-08 00:00:02Z raasch $
+
+ # Prozedur zum automatischen Transfer von Dateien mittels scp
+ #
+ # batch_scp hat 4 Argumente:
+ # $1 = IP-Adresse des Zielrechners
+ # $2 = zu uebertragende Datei
+ # $3 = Verzeichnis, in das kopiert werden soll
+ # $4 = Dateiname der Zieldatei
+
+
+ # ACHTUNG!!!!!!!!
+ #
+ # batch_scp hat noch folgenden grossen Mangel: wenn die Verzeichnisse
+ # auf den jeweiligen Remote-Rechnern aeltere Dateien beinhalten,
+ # die beim "ls -al" eine Jahreszahl und keine Uhrzeit (aa:bb) liefern,
+ # dann kann batch_scp die Dateinamen nicht ueberpruefen und findet
+ # z.B. bei -g die entsprechende Datei nicht!
+ #
+ #
+
+
+ # letzte Aenderung:
+ # 29/11/01 - Siggi - Entwicklungsbeginn
+ # 04/01/02 - Siggi - Version 1.0 funktionsfaehig
+ # 15/02/02 - Siggi - Verzeichnis-Listing umgestellt von "ls -al" auf "ls -1"
+ # 30/05/02 - Siggi - Abbruch mit exit 1 bei scp- oder ssh-Fehler
+ # 12/06/02 - Siggi - Version 1.0a, parent directories are also created, if
+ # directory on remote host does not exist
+ # 18/09/02 - Siggi - Fehlerabfragen korrigiert (waren wegen Klammerung
+ # unwirksam)
+ # 12/03/03 - Siggi - errfile and filelist are not stored in /tmp any more
+ # errors in execution of ssh does not lead
+ # to an abort on the NEC-system at DKRZ
+ # 01/04/03 - Siggi - small error concerning creation of catalogs removed
+ # 23/01/04 - Siggi - additional test output for scp on hurrikan
+ # 02/12/04 - Siggi - additional check of file size on remote host after scp.
+ # If the file sizes on local and remote host are equal,
+ # the scp exit status is ignored
+ # 03/12/04 - Siggi - additional checks of ssh actions independent of the
+ # ssh exit status
+ # 11/03/05 - Siggi - arguments are output in case of error exit
+ # 25/10/05 - Siggi - put of catalogs realized
+
+
+
+ # VARIABLENVEREINBARUNGEN + DEFAULTWERTE
+ random=$RANDOM
+
+ absolut=false
+ append=false
+ catalog_copy=false
+ check=false
+ delete=false
+ errfile=ftpcopy.errfile.$random
+ filelist=filelist.$random
+ get=false
+ local_host=`hostname`
+ locat=normal
+ make_catalog=false
+ overwrite=false
+ print_local_filename=false
+ quote_wait=false
+ remote_user=""
+ silent=false
+ transfermode=binary
+ zyklusnr=""
+ typeset -i iii icycle maxcycle=0 wait=0
+
+ # FEHLERBEHANDLUNG
+ # BEI EXIT:
+ trap 'if [[ $locat != normal ]]
+ then
+ cat $filelist $errfile
+ rm -rf $filelist $errfile
+ printf " +++ BATCH_SCP terminated \n"
+ printf " locat = $locat \n"
+ printf " arguments = $1 $2 $3 $4 \n\n"
+ exit 1
+ fi' exit
+
+
+ # BEI TERMINAL-BREAK:
+ trap 'rm -rf $filelist $errfile
+ printf " +++ BATCH_SCP terminated \n\n"
+ exit 1
+ ' 2
+
+
+ # SHELLSCRIPT-OPTIONEN EINLESEN
+ while getopts :aAbcCdgmnoqsu:w: option
+ do
+ case $option in
+ (a) absolut=true;;
+ (A) append=true;;
+ (b) transfermode=binary;;
+ (c) catalog_copy=true;;
+ (C) check=true;;
+ (d) delete=true;;
+ (g) get=true;;
+ (m) make_catalog=true;;
+ (n) print_local_filename=true;; # Option ist nicht dokumentiert !
+ (o) overwrite=true;;
+ (q) quote_wait=true;;
+ (s) silent=true;;
+ (u) remote_user=$OPTARG;;
+ (w) wait=$OPTARG;;
+ (\?) printf " +++ option $OPTARG unknown \n"
+ printf " --> call: batch_scp [-aAbcCdgmnoqsuw] \n"
+ locat=parameter;exit;;
+ esac
+ done
+ shift OPTIND-1
+
+
+
+ # KURZE AUFRUFBESCHREIBUNG WIRD HIER AUSGEGEBEN
+ if [ "$1" = "?" ]
+ then
+ (printf "\n *** batch_scp can be called as follows:\n"
+ printf "\n batch_scp -a -b -d -g -o -q -s -u.. -w.. \n"
+ printf "\n Description of available options:\n"
+ printf "\n Option Description Default-Value"
+ printf "\n -a Filenames are absolute. No cycle- ---"
+ printf "\n numbers will be determined"
+ printf "\n -A append to destination file ---"
+ printf "\n -b use binary-modus for transfer ASCII-modus"
+ printf "\n -c transfer of directory ---"
+ printf "\n -C check-Modus, no transfer ---"
+ printf "\n -d file to be transferred will be ---"
+ printf "\n deleted after successful transfer"
+ printf "\n -g change of transfer direction, i.e. ---"
+ printf "\n file will be transferred from"
+ printf "\n destination host"
+ printf "\n -o any existing file will be overwritten ---"
+ printf "\n -q switch on \"quote wait\" on ---"
+ printf "\n estination host"
+ printf "\n -s do not display informative messages ---"
+ printf "\n -u username on remote machine "
+ printf "\n -w waiting time in seconds, before trans- 0"
+ printf "\n fer will be initiated"
+ printf "\n "
+ printf "\n The positional parameters - must be provided at"
+ printf "\n any time and have the following meaning:"
+ printf "\n - IP-adress of destination host"
+ printf "\n or \"?\" (creates this outline)"
+ printf "\n - abs. or rel. path of file to be transferred"
+ printf "\n - directory (abs.!) on destination host. Special cahracters"
+ printf "\n like \~ are allowed but must be quoted by \"."
+ printf "\n - filename (without path!) on destination host; must not"
+ printf "\n be given, if option -c is used."
+ printf "\n When using option -g, file will be copied from destination host to file"
+ printf "\n . In this case, no overwriting is possible.") | more
+ exit
+ fi
+
+
+ # PRUEFEN, OB ALLE ARGUMENTE VORLIEGEN
+ if [[ "$1" = "" ]]
+ then
+ printf " +++ 1. argument missing \n"
+ locat=argument; exit
+ elif [[ "$2" = "" ]]
+ then
+ printf " +++ 2. argument missing \n"
+ locat=argument; exit
+ elif [[ "$3" = "" ]]
+ then
+ printf " +++ 3. argument missing \n"
+ locat=argument; exit
+ elif [[ "$4" = "" ]]
+ then
+ printf " +++ 4. argument missing \n"
+ locat=argument; exit
+ fi
+
+
+ # USER-NAME AUF ZIELRECHNER AUS .NETRC-DATEI ERMITTELN
+ if [[ -z $remote_user ]]
+ then
+
+ # PRUEFEN, OB NETRC-DATEI VORHANDEN
+ if [[ ! -f ~/.netrc ]]
+ then
+ printf " +++ option -u not given; \n"
+ printf " getting remote-username from password file failed \n"
+ printf " because ~/.netrc does not exist \n"
+ locat=netrc; exit
+ fi
+ grep $1 ~/.netrc | read dum dum dum remote_user dum dum
+ fi
+
+
+ # APPEND IST NUR BEI TRANSFER EINZELNER DATEIEN OHNE UEBERSCHREIBEN
+ # ERLAUBT. GET IST DABEI EBENFALLS NICHT ERLAUBT
+ if [[ $append = true && ( $get = true || $catalog_copy = true || $overwrite = true ) ]]
+ then
+ printf " +++ options -g, -c and -o are not allowed, if -A is given \n"
+ locat=parameter; exit
+ fi
+
+
+ # DATEINAME IM 4. ARGUMENT DARF NUR BEIM UEBERSCHREIBEN ODER IM ABSOLUT-
+ # MODUS PUNKTE ENTHALTEN
+ if [[ $overwrite = false && $absolut = false && $(echo $4 | grep -c "\.") != 0 ]]
+ then
+ printf " +++ 4th argument may only contain dots (".") , if one of the \n"
+ printf " options -a or -o are given \n"
+ locat=argument; exit
+ fi
+
+
+ # QUOTE WAIT FUNKTIONIERT NICHT BEIM KOPIEREN GANZER VERZEICHNISSE
+ if [[ $quote_wait = true && $catalog_copy = true ]]
+ then
+ printf " +++ options -c and -q must not be used simultaneously\n"
+ locat=parameter; exit
+ fi
+
+
+ # IM CHECK-MODUS WIRD SCRIPT HIER BEENDET
+ [[ $check = true ]] && exit
+
+
+ # BESTIMMTE ZEIT WARTEN, BIS WEITERGEMACHT WIRD (NOETIG Z.B. BEI TRANSFER
+ # VON JOBPROTOKOLLEN AUS JOBS HERAUS)
+ sleep $wait
+
+
+ # PRUEFEN, OB LOKALE DATEI/LOKALES VERZEICHNIS VORHANDEN BZW. NICHT VORHANDEN
+ if [[ $get = false ]]
+ then
+ if [[ $catalog_copy = false ]]
+ then
+ if [[ ! -f $2 ]]
+ then
+ printf " +++ file \"$2\" to be transferred does not exist \n"
+ locat=localfile; exit
+ fi
+ else
+ if [[ ! -d $2 ]]
+ then
+ printf " +++ directory \"$2\" to be transferred does not exist\n"
+ printf " or is not a directory \n"
+ locat=localfile; exit
+ fi
+ fi
+ else
+ if [[ $catalog_copy = false ]]
+ then
+ if [[ -f $2 ]]
+ then
+ if [[ $overwrite = true ]]
+ then
+ rm $2
+ else
+ printf " +++ local file \"$2\" is already existing \n"
+ locat=localfile; exit
+ fi
+ else
+
+ # PRUEFEN, OB SICH LOKALE DATEI ANLEGEN LAESST
+ local_dirname=`dirname $2`
+ if [[ ! -d $local_dirname ]]
+ then
+ printf " +++ local directory \"$local_dirname\" \n"
+ printf " does not exist or is not a directory \n"
+ printf " +++ cannot copy file \"$3/$4\" \n"
+ printf " from \"$1\" to \"$local_host\" \n"
+ locat=localfile; exit
+ fi
+ fi
+ else
+ if [[ -d $2 || -f $2 ]]
+ then
+ printf " +++ local directory \"$2\" is already existing, \n"
+ printf " or a file with the same name exists \n"
+ locat=localfile; exit
+ fi
+ fi
+ fi
+
+
+ # VERZEICHNISLSTE DES ZIELRECHNERS ERSTELLEN
+ ssh $1 -l $remote_user "cd $3; ls -1; echo '*** list complete'" > $filelist 2>&1
+ ssh_status=$?
+
+ if [[ $ssh_status != 0 ]]
+ then
+ if [[ ! -f $filelist ]]
+ then
+ echo " local_host = $local_host ssh_status = $ssh_status"
+ locat=ssh_failed_1; exit
+ else
+ if [[ $(grep -c "*** list complete" $filelist) = 0 ]]
+ then
+ echo " local_host = $local_host ssh_status = $ssh_status"
+ locat=ssh_failed_2; exit
+ fi
+ fi
+ fi
+
+
+ # PRUEFEN, OB VERZEICHNIS VORHANDEN IST. WENN GANZES VERZEICHNISS ZUM
+ # ZIELRECHNER KOPIERT WERDEN SOLL, DARF DORT NOCH KEIN ENTSPRECHENDES
+ # VERZEICHNIS VORHANDEN SEIN
+ if [[ $(cat $filelist | grep -c "not found") != 0 || \
+ $(cat $filelist | grep -c "No such file or directory") != 0 ]]
+ then
+ if [[ ! ( $catalog_copy = true && $get = false ) ]]
+ then
+ if [[ $make_catalog = false ]]
+ then
+ printf " +++ directory \"$3\" does not exist on destination host (\"$1\") \n"
+ locat=directory; exit
+ else
+ if [[ $silent = false ]]
+ then
+ printf " >>> directory \"$3\" does not exist on destination host (\"$1\")"
+ printf "\n trying to create \"$3\" \n"
+ fi
+
+ make_catalog=force
+ fi
+ fi
+ fi
+
+
+ # PRUEFEN, OB DATEI/VERZEICHNIS VORHANDEN, WENN JA, HOECHSTEN ZYKLUS
+ # ERMITTELN (BZW. IM ABSOLUT-MODUS PRUEFEN, OB DATEI VORHANDEN IST)
+ # DAS GANZE ABER NUR, WENN NICHT OVERWRITE-MODUS GEWAEHLT WURDE, DIE
+ # EVENTUELL VORHANDENE DATEI ALSO UEBERSCHRIEBEN WERDEN SOLL
+ found=false
+ if [[ ( $overwrite = false && $get = false ) || $get = true ]]
+ then
+ while read zeile
+ do
+ if [[ $absolut = false ]]
+ then
+ text=$(echo $zeile | cut -f1 -d".")
+ if [[ "$text" = "$4" ]]
+ then
+ found=true
+ cycle=$(echo $zeile | cut -f2 -d".")
+ if [[ "$cycle" = "$text" ]]
+ then
+ (( icycle = 0 ))
+ else
+
+ # PRUEFEN, OB CYCLE EINE ZAHL IST
+ (( iii = 1 ))
+ character=`echo $cycle | cut -c$iii`
+ character_found=false
+ while [[ "$character" != "" && $character_found = false ]]
+ do
+ case $character in
+ (0|1|2|3|4|5|6|7|8|9) true;;
+ (*) character_found=true
+ esac
+ (( iii = iii + 1 ))
+ character=`echo $cycle | cut -c$iii`
+ done
+
+ if [[ $character_found = false ]]
+ then
+ (( icycle = $cycle ))
+ fi
+ fi >|$errfile 2>&1 # AUSGABE FEHLER AUF ERRFILE WENN CYCLE NICHTNUMERISCH
+
+
+ # INFORMATIVE AUSGABE, WENN DATEI NICHTNUMERISCHE EXTENSION HAT
+ # if [[ $(cat $errfile | grep -c "bad number") != 0 ]]
+ if [[ $character_found = true ]]
+ then
+ if [[ $cycle != "$5" ]]
+ then
+ printf " +++ file \"$text\" has non-numerical extension \".$cycle\" \n"
+ locat=file; exit
+ else
+ if [[ $silent = false ]]
+ then
+ printf " >>> file \"$text\" has non-numerical extension \".$cycle\" \n"
+ fi
+ fi
+ fi
+
+ if (( icycle > maxcycle ))
+ then
+ (( maxcycle = icycle ))
+ fi
+ fi
+
+ else
+
+ # IM ABSOLUT-MODUS MUSS NUR GEPRUEFT WERDEN, OB DIE DATEI
+ # VORHANDEN IST
+ [[ $4 = $zeile ]] && found=true
+ fi
+
+ done <$filelist
+ fi
+
+ if [[ $found = true ]]
+ then
+ if [[ $get = false ]]
+ then
+ if [[ $absolut = false ]]
+ then
+ if [[ $append = false ]]
+ then
+ (( maxcycle = maxcycle + 1 ))
+ zyklusnr=".$maxcycle"
+ else
+ if (( maxcycle == 0 ))
+ then
+ zyklusnr=""
+ else
+ zyklusnr=".$maxcycle"
+ fi
+ fi
+ else
+ if [[ $overwrite = false ]]
+ then
+ printf " +++ file \"$3/$4\" \n"
+ printf " already exists on destination host (use -o, if necessary) \n"
+ locat=file; exit
+ fi
+ fi
+ else
+ if [[ $absolut = false ]]
+ then
+ if (( maxcycle == 0 ))
+ then
+ zyklusnr=""
+ else
+ zyklusnr=".$maxcycle"
+ (( maxcycle = 0 ))
+ fi
+ else
+ zyklusnr=""
+ fi
+ fi
+ else
+ zyklusnr=""
+
+ # ABBRUCH, WENN DATEI VON ZIELRECHNER GEHOLT WERDEN SOLL, DORT ABER
+ # NICHT VORHANDEN IST
+ if [[ $get = true ]]
+ then
+ printf " +++ file \"$3/$4\" \n"
+ printf " does not exist on destination host (\"$1\") \n"
+ locat=remotefile; exit
+ fi
+ fi
+
+
+ # FALLS KATALOG ERZEUGT WIRD, DARF DIE DATEI IN KEINEM FALL EINE
+ # ZYKLUSNUMMER BESITZEN, DA SIE JA NOCh GARNICHT EXISTIEREN KANN
+ if [[ $make_catalog = force ]]
+ then
+ zyklusnr=""
+ (( maxcycle = 0 ))
+ fi
+
+
+ # FALLS NAMENSOPTION (-n) GEWAEHLT WURDE, NUR DEN ERMITTELTEN LOKALEN
+ # DATEINAMEN DES ZIELRECHNERS AUSGEBEN UND SCRIPT BEENDEN
+ if [[ $print_local_filename = true ]]
+ then
+ printf "$4$zyklusnr\n"
+ rm -r $filelist
+ exit
+ fi
+
+
+ # FALLS 5. ARGUMENT ANGEGEBEN WURDE, WIRD DIES ALS FILE-EXTENSION
+ # HINTER DIE ZYKLUS-NUMMER GEHAENGT (FUNKTIONIERT NUR BEI KOPIEREN EINER
+ # DATEI AUF ZIELRECHNER
+ if [[ "$5" != "" && $get = false ]]
+ then
+ zyklusnr=${zyklusnr}.$5
+ fi
+
+
+ # BEI VERZEICHNISTRANSFER VON ZIELRECHNER AUF LOKALEN RECHNER PRUEFEN, OB
+ # $3 AUF ZIELRECHNER WIRKLICH EIN VERZEICHNIS IST
+ if [[ $catalog_copy = true && $get = true ]]
+ then
+ rm -rf $filelist
+ ssh $1 -l $remote_user "cd $3" > $filelist
+ if [[ $? != 0 ]]
+ then
+ locat=ssh_failed_3; exit
+ fi
+
+ if [[ $(cat $filelist | grep -c "Not a directory") != 0 ]]
+ then
+ printf " +++ \"$3\" on destination host is not a directory \n"
+ locat=directory; exit
+ fi
+ fi
+
+
+ # BEI KATALOGTRANSFER AUF LOKALEN RECHNER ENTSPRECHENDES VERZEICHNIS
+ # ANLEGEN
+ if [[ $catalog_copy = true ]]
+ then
+ if [[ $get = true ]]
+ then
+ mkdir $2
+ fi
+ fi
+
+
+ # Auf IBM-Rechnern (HLRN) Tilde aus Katalognamen entfernen, da scp
+ # diese nicht versteht
+ catalog_name=$3
+ if [[ $(hostname | cut -c1-4) = hreg || $(hostname | cut -c1-4) = breg ]]
+ then
+ catalog_name=${catalog_name#"~/"}
+ catalog_name=${catalog_name#"~"}
+ fi
+ [[ "$catalog_name" != "" ]] && catalog_name=${catalog_name}/
+
+
+ # DATEI/VERZEICHNIS PER SCP UEBERTRAGEN
+ if [[ $get = false ]]
+ then
+ if [[ $make_catalog != force ]]
+ then
+ if [[ $append = false ]]
+ then
+ if [[ $(echo $local_host | cut -c1-2) = cs ]]
+ then
+ if [[ $catalog_copy = false ]]
+ then
+ scp -q -v $2 $remote_user@$1:$catalog_name$4$zyklusnr
+ else
+ scp -r -q -v $2 $remote_user@$1:$catalog_name$4$zyklusnr
+ fi
+ else
+ if [[ $catalog_copy = false ]]
+ then
+ scp $2 $remote_user@$1:$catalog_name$4$zyklusnr > /dev/null
+ else
+ scp -r $2 $remote_user@$1:$catalog_name$4$zyklusnr > /dev/null
+ fi
+ fi
+ scp_status=$?
+
+ if [[ $scp_status != 0 ]]
+ then
+ # CHECK, OB DATEIGROESSEN AUF LOKALEM UND REMOTERECHNER
+ # UEBEREINSTIMMEN
+ local_size=`ls -al $2`
+ local_size=`echo $local_size | cut -d" " -f5`
+
+ remote_size=`ssh $1 -l $remote_user "ls -al $catalog_name$4$zyklusnr"`
+ remote_size=`echo $remote_size | cut -d" " -f5`
+
+ if [[ "$remote_size" != "$local_size" ]]
+ then
+ echo " +++ scp failed on host \"$local_host\" with exit $scp_status"
+ echo " local size = \"$local_size\" remote size = \"$remote_size\" "
+ date
+ locat=scp_failed; exit
+ fi
+ fi
+ else
+ scp $2 $remote_user@$1:${catalog_name}batch_scp_append_file.$random > /dev/null
+ if [[ $? != 0 ]]
+ then
+ # CHECK, OB DATEIGROESSEN AUF LOKALEM UND REMOTERECHNER
+ # UEBEREINSTIMMEN
+ local_size=`ls -al $2`
+ local_size=`echo $local_size | cut -d" " -f5`
+
+ remote_size=`ssh $1 -l $remote_user "ls -al ${catalog_name}batch_scp_append_file.$random"`
+ remote_size=`echo $remote_size | cut -d" " -f5`
+
+ if [[ "$remote_size" != "$local_size" ]]
+ then
+ echo " +++ scp failed on host \"$local_host\" with exit $scp_status"
+ echo " local size = \"$local_size\" remote size = \"$remote_size\" "
+ date
+ locat=scp_for_append_failed; exit
+ fi
+ fi
+
+ rm $filelist
+
+ ssh $1 -l $remote_user "cd $3; cat batch_scp_append_file.$random >> $4$zyklusnr; rm batch_scp_append_file.$random; echo '*** append complete'" > $filelist
+ if [[ $? != 0 ]]
+ then
+ if [[ ! -f $filelist ]]
+ then
+ locat=append_via_ssh_failed; exit
+ else
+ if [[ $(grep -c "*** append complete" $filelist) = 0 ]]
+ then
+ locat=append_via_ssh_failed; exit
+ fi
+ fi
+ fi
+ fi
+ else
+ ssh $1 -l $remote_user "mkdir -p $3"
+ if [[ $? != 0 ]]
+ then
+ locat=ssh_failed_4; exit
+ fi
+ scp $2 $remote_user@$1:$catalog_name$4$zyklusnr > /dev/null
+ if [[ $? != 0 ]]
+ then
+ locat=scp_failed; exit
+ fi
+ fi
+
+ else
+
+ if [[ $catalog_copy = false ]]
+ then
+ if [[ $quote_wait = true ]]
+ then
+
+ printf " +++ quote wait not realized with BATCH_SCP"
+ locat=unavailable_feature; exit
+
+ else
+
+ scp $remote_user@$1:$catalog_name$4$zyklusnr $2 > /dev/null
+ if [[ $? != 0 ]]
+ then
+ locat=scp_failed; exit
+ fi
+
+ fi
+ else
+
+ printf " +++ get of whole cataloges not realized with BATCH_SCP so far"
+ locat=unavailable_feature; exit
+
+# ftp -i $1 << %END% > /dev/null
+#$transfermode
+#cd $3
+#mget *
+#quit
+#%END%
+ fi
+ fi
+
+
+
+ # EVTL. TRANSFERIERTE DATEI AUF LOKALEM RECHNER LOESCHEN
+ if [[ $delete = true && $get = false ]]
+ then
+ rm -rf $2
+ fi
+
+
+
+ # ABSCHLUSSMELDUNG
+ if [[ $silent = false ]]
+ then
+ if (( maxcycle == 0 ))
+ then
+ if [[ $append = false ]]
+ then
+ printf " >>> transfer successful \n"
+ else
+ printf " >>> file was appended \n"
+ fi
+ else
+ printf " >>> transfer successful \n"
+ if [[ $append = false ]]
+ then
+ if [[ $catalog_copy = false ]]
+ then
+ printf " new file has cycle number $maxcycle \n"
+ else
+ printf " new catalog has cycle number $maxcycle \n"
+ fi
+ else
+ printf " append to cycle number $maxcycle \n"
+ fi
+ fi
+ fi
+
+ rm -rf $filelist $errfile
Index: /palm/tags/release-3.4a/SCRIPTS/mbuild
===================================================================
--- /palm/tags/release-3.4a/SCRIPTS/mbuild (revision 141)
+++ /palm/tags/release-3.4a/SCRIPTS/mbuild (revision 141)
@@ -0,0 +1,1530 @@
+#!/bin/ksh
+# mbuild - Programmuebersetzungsscript
+# $Id: mbuild 54 2007-03-08 00:00:02Z raasch $
+
+ # Prozedur zur Uebersetzung von Programmteilen mittels make-Mechanismus
+ # auf einem Remote-Rechner, ausgehend von Quellcode auf einem lokalen
+ # Rechner
+
+ # Folgende Probleme existieren unter Linux, wenn keine AT&T-Korn-Shell
+ # verwendet wird:
+ # Wertzuweisungen an Variablen innerhalb von DO-Schleifen werden nicht
+ # nach aussen weitergegeben. "while read line" funktioniert nicht
+ # innerhalb einer Pipe.
+
+ # letzte Aenderung:
+ # 06/05/02 - Siggi - Beginn der Entwicklung
+ # 12/06/02 - Siggi - Abschluss der Entwicklungsarbeiten
+ # 23/06/02 - Siggi - voerst kein make-clean, Abbruch bei batch-mode
+ # 24/07/02 - Siggi - Keine Verwendung der temporaeren Datei tmp_mbuild
+ # unter linux mehr noetig, da nun AT&T-Korn-Shell
+ # benutzt wird
+ # 12/09/02 - Siggi - ibmh (hanni.hlrn.de) validiert
+ # 19/12/02 - Siggi - ibmb validiert
+ # 05/02/03 - Siggi - hostname nobela included
+ # 04/03/03 - Siggi - host nech included
+ # 06/03/03 - Siggi - make_call_string is echoed without '' to
+ # file LAST_MAKE_CALL (otherwise error on NEC, because
+ # '' are part of compiler options
+ # 16/03/03 - Siggi - Two underscores are placed in front of every define
+ # string, in case that palm.f90 version contains
+ # such strings
+ # 16/04/03 - Siggi - First extensions for linux machines
+ # 24/06/03 - Siggi - host orkan included
+ # 17/07/03 - Siggi - IP adress set to new "cross" machine at DKRZ
+ # 24/07/03 - Siggi - host maestro admitted
+ # 06/08/03 - Siggi - host gregale admitted
+ # 05/11/03 - Siggi - hosts irifi and quanero are now belonging to lcmuk
+ # 19/11/03 - Heiko - on lcmuk, mbuild does not tar the *.i files
+ # 08/01/04 - Siggi - additional preprocessor directive for ibm included
+ # (-D$OMP=OMP) in order to avoid problems with
+ # OMP_NUM_THREADS
+ # 09/01/04 - Siggi - action above cancelled
+ # 28/01/04 - Siggi - action above re-cancelled
+ # 08/03/04 - Siggi - host scirocco admitted
+ # 26/03/04 - Siggi - .o and .mod files are also deleted in depository, if
+ # the respective .f90 file is not listed in the makefile
+ # and deletion is demanded by the user
+ # 12/04/04 - Siggi - scp2 instead of scp used for transfer from decalpha
+ # due to error in ssh installation (otherwise a prompt
+ # for the password appears)
+ # 23/07/04 - Siggi - changes due to the new berni configuration
+ # (federation switch)
+ # 08/09/04 - Siggi - hanni IP address changed to 130.75.4.10
+ # 23/09/04 - Joerg - correction of IP-Address for 'cross' (DKRZ)
+ # 09/03/05 - Siggi - on nech, mbuild does not tar the *.i files
+ # 31/03/05 - Siggi - mbuild does not tar *.i files any more
+ # 24/04/05 - Siggi - netcdf support on lcmuk
+ # 25/04/05 - Siggi - netcdf support on gfdl3 (decalpha)
+ # 12/05/05 - Siggi - netcdf support on ibm
+ # set OBJECT_MODE=64 for compiling on ibmb, ibmh
+ # 18/05/05 - Siggi - netcdf support on nec
+ # 19/05/05 - Siggi - IP addres 134.75.155.74 changed to 165.132.26.56
+ # 23/05/05 - Siggi - netcdf support on ibms
+ # 01/06/05 - Siggi - reset of cpp_options to "" on lcmuk
+ # 30/06/05 - Siggi - netcdf support on bora
+ # 20/10/05 - Siggi - update of netcdf-version on decalpha (gfdl3)
+ # 04/11/05 - Siggi - netcdf 3.6.0-p1 on ibmh/ibmb
+ # 30/12/05 - Siggi - change of IP adresses in subnet 130.75.105
+ # host gfdl5 (ibmy) admitted
+ # 10/01/06 - Siggi - cpp directive for NetCDF 64bit support
+ # 20/01/06 - Siggi - cpp directive for ibmy
+ # 09/02/06 - Marcus- compile only once on lcmuk (as on ibmh/ibmb)
+ # 10/02/06 - Siggi - modifications for scp on decalpha
+ # 13/04/06 - Siggi - ostria admitted
+ # 19/04/06 - Siggi - preprocessor directive -D$OMP=OMP for ibm removed
+ # 23/05/05 - Siggi - lctit (SUN Fire X4600) admitted
+ # 29/05/05 - Siggi - atmos (lcide) admitted
+ # 23/08/06 - Siggi - netcdf support for scirocco (notebook)
+ # 24/11/06 - Siggi - breva and levanto admitted
+ # 07/02/07 - Siggi - adapted for RIAM (neck)
+ # 10/02/07 - Siggi - all hpmuk-related code removed
+ # 02/03/07 - Siggi - compilation of utility programs and transfer of
+ # scripts to remote hosts added (option -u)
+ # 14/03/07 - Siggi - fimm admitted, revision number added to terminal
+ # output
+ # 16/03/07 - Siggi - adjustments (netcdf) for lctit
+ # adjustments for running under pdksh, local ip-addres
+ # is not determined any more
+ # 30/03/07 - Siggi - cpp-directives/options + netcdf-options are read
+ # from configuration file
+ # host identifier (local_host) is read from config file
+ # 10/10/07 - Siggi - bugfix: handling of comment lines
+
+
+
+ # VARIABLENVEREINBARUNGEN + DEFAULTWERTE
+ compile_utility_programs=false
+ config_file=.mrun.config
+ fimm=false
+ host=all
+ host_found=false
+ ibm_hb_done=false
+ lcmuk_done=false
+ locat=normal
+ makefile=""
+ remote_mode=interactive
+ scirocco=false
+ silent=false
+ suf=f90
+ update=false
+ working_directory=`pwd`
+
+ typeset -i ih ihost=0
+
+ typeset -R30 calltime
+ typeset -L20 column1
+ typeset -L50 column2
+ typeset -L70 column3
+ typeset -L40 version="MBUILD 2.0 Rev$Rev$"
+
+ # FEHLERBEHANDLUNG
+ # BEI EXIT:
+ trap 'rm -rf $working_directory/tmp_mbuild
+ if [[ $locat != normal ]]
+ then
+ printf "\n\n +++ mbuild killed \n\n"
+ else
+ printf "\n\n *** mbuild finished \n\n"
+ fi' exit
+
+
+ # BEI TERMINAL-BREAK:
+ trap 'rm -rf $working_directory/tmp_mbuild
+ printf "\n\n +++ mbuild killed by \"^C\" \n\n"
+ exit
+ ' 2
+
+
+
+ # SHELLSCRIPT-OPTIONEN EINLESEN
+ while getopts :c:h:m:rs:u option
+ do
+ case $option in
+ (c) config_file=$OPTARG;;
+ (h) host=$OPTARG;;
+ (m) makefile=$OPTARG;;
+ (r) remote_mode=batch;;
+ (s) suf=$OPTARG;;
+ (u) compile_utility_programs=true;;
+ (\?) printf "\n +++ unknown option $OPTARG \n";
+ locat=parameter; exit;;
+ esac
+ done
+
+
+
+ # BATCH-MODE IST ZUR ZEIT NICHT FUNKTIONSFAEHIG
+ if [[ $remote_mode = batch ]]
+ then
+ printf "\n +++ sorry, batch mode does not work! \n"
+ locat=parameter; exit
+ fi
+
+
+
+ # PRUEFEN, OB KONFIGURATIONS-DATEI VORHANDEN
+ if [[ ! -f $config_file ]]
+ then
+ printf "\n +++ configuration file: "
+ printf "\n $config_file"
+ printf "\n does not exist"
+ locat=configuration; exit
+ fi
+
+
+
+ # LOKALEN RECHNER ERMITTELN
+ local_host_real_name=$(hostname)
+# local_addres=$(nslookup `hostname` 2>&1 | grep "Address:" | tail -1 | awk '{print $2}')
+
+
+
+ # HOST-IDENTIFIER (local_host) AUS KONFIGURATIONSDATEI BESTIMMEN
+ line=""
+ grep "%host_identifier" $config_file > tmp_mbuild
+ while read line
+ do
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ HOSTNAME=`echo $line | cut -d" " -s -f2`
+ host_identifier=`echo $line | cut -d" " -s -f3`
+ if [[ $local_host_real_name = $HOSTNAME ]]
+ then
+ local_host=$host_identifier
+ break
+ fi
+ fi
+ done < tmp_mbuild
+
+ if [[ "$local_host" = "" ]]
+ then
+ printf "\n +++ no host identifier found in configuration file \"$config_file\""
+ printf "\n for local host \"$local_host_real_name\"."
+ printf "\n Please add line"
+ printf "\n \"\%host_identifier $local_host_real_name \""
+ printf "\n to the configuration file."
+ locat=local_host; exit
+ fi
+
+
+
+ [[ $local_host_real_name = scirocco ]] && scirocco=true
+ [[ $local_host_real_name = fimm.bccs.uib.no ]] && fimm=true
+
+
+
+ if [[ $local_host != ibms ]]
+ then
+ config_file=$PWD/$config_file
+ else
+ config_file=`pwd`/$config_file
+ fi
+
+
+
+ # BENUTZERNAMEN AUF LOKALEM RECHNER AUS KONFIGURATIONSDATEI ERMITTELN
+ line=""
+ grep " $local_host" $config_file | grep "%remote_username" > tmp_mbuild
+ while read line
+ do
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ local_username=`echo $line | cut -d" " -s -f2`
+ fi
+ done < tmp_mbuild
+
+
+ if [[ "$local_username" = "" ]]
+ then
+ printf "\n +++ no user name found in configuration file"
+ printf "\n for local host \"$local_host\" "
+ locat=config_file; exit
+ fi
+
+
+ # LOKALEN QUELLTEXTPFAD ERMITTELN.
+ # ZUERST PRUEFEN, OB EIN GLOBALER QUELLTEXTPFAD FUER ALLE RECHNER
+ # VEREINBART WURDE.
+ # DAZU ZUNAECHST ALLE IN DER KONFIGURATIONSDATEI VEREINBARTEN GLOBALEN
+ # VARIABLEN SETZEN, WEIL DIESE EVTL. IN PFADNAMEN VERWENDET WERDEN
+ line=""
+ grep "%" $config_file > tmp_mbuild
+ while read line
+ do
+ if [[ "$line" != "" && "$(echo $line | cut -d" " -s -f3)" = "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ var=`echo $line | cut -d" " -s -f1 | cut -c2-`
+ value=`echo $line | cut -d" " -s -f2`
+ eval export $var=\$value
+# eval echo \" $var=\$$var \" # AUSGABE ZU TESTZWECKEN
+ fi
+ done < tmp_mbuild
+
+ # NUN PRUEFEN, OB EIN GLOBALER QUELLTEXTPFAD VEREINBART WURDE
+ line=""
+ grep "%source_path" $config_file > tmp_mbuild
+ while read line
+ do
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ if [[ "$(echo $line | cut -d" " -s -f3)" = "" ]]
+ then
+ global_source_path=`echo $line | cut -d" " -s -f2`
+ fi
+ fi
+ done < tmp_mbuild
+
+ line=""
+ grep " $local_host" $config_file | grep "%source_path" > tmp_mbuild
+ while read line
+ do
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ local_source_path=`echo $line | cut -d" " -s -f2`
+ fi
+ done < tmp_mbuild
+
+ if [[ "$local_source_path" = "" ]]
+ then
+ if [[ "$global_source_path" != "" ]]
+ then
+ local_source_path=$global_source_path
+ else
+ printf "\n +++ no source path found in configuration file"
+ printf "\n for local host \"$local_host\" "
+ printf "\n please set \"\%source_path\" in configuration file"
+ locat=config_file; exit
+ fi
+ fi
+ eval local_source_path=$local_source_path
+ eval local_source_path=$local_source_path
+
+
+ # EBENSO PFAD FUER DAS MAKE-DEPOSITORY ERMITTELN
+ line=""
+ grep "%depository_path" $config_file > tmp_mbuild
+ while read line
+ do
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ if [[ "$(echo $line | cut -d" " -s -f3)" = "" ]]
+ then
+ global_depository_path=`echo $line | cut -d" " -s -f2`
+ fi
+ fi
+ done < tmp_mbuild
+
+ line=""
+ grep " $local_host" $config_file | grep "%depository_path" > tmp_mbuild
+ while read line
+ do
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ local_depository_path=`echo $line | cut -d" " -s -f2`
+ fi
+ done < tmp_mbuild
+
+ if [[ "$local_depository_path" = "" ]]
+ then
+ if [[ "$global_depository_path" != "" ]]
+ then
+ local_depository_path=$global_depository_path
+ else
+ printf "\n +++ no depository path found in configuration file"
+ printf "\n for local host \"$local_host\" "
+ printf "\n please set \"\%depository_path\" in configuration file"
+ locat=config_file; exit
+ fi
+ fi
+ eval local_depository_path=$local_depository_path
+ eval local_depository_path=$local_depository_path
+
+
+
+ # PRUEFEN, OB IN KONFIGURATIONSDATEI EIN HAUPTPROGRAMM
+ # VEREINBART WURDE
+ if [[ $(grep -c "%mainprog" $config_file) != 1 ]]
+ then
+ printf "\n +++ no main program or more than one main program defined"
+ printf "\n in configuration file"
+ locat=configuration; exit
+ else
+ line=`grep "%mainprog" $config_file`
+ if [[ "$line" = "" || $(echo $line | cut -c1) = "#" ]]
+ then
+ printf "\n +++ no main program defined in configuration file"
+ locat=configuration; exit
+ fi
+ mainprog=`echo $line | cut -d" " -s -f2 | cut -d"." -f1`
+ fi
+
+
+
+ # MAKEFILE vorhanden
+ [[ "$makefile" = "" ]] && makefile=$local_source_path/Makefile
+ if [[ ! -f $makefile ]]
+ then
+ printf "\n +++ makefile: "
+ printf "\n $makefile"
+ printf "\n does not exist"
+ locat=makefile; exit
+ fi
+
+
+ # HEADER-AUSGABE (TEIL1: MELDUNGEN UEBER LOKALEN RECHNER)
+ calltime=$(date)
+ printf "\n"
+ printf "#------------------------------------------------------------------------# \n"
+ printf "| $version$calltime | \n"
+ printf "| | \n"
+ column1="called on:"; column2=$local_host_real_name
+ printf "| $column1$column2 | \n"
+ column1="local username:"; column2=$local_username
+ printf "| $column1$column2 | \n"
+ column1="local IP-addres:"; column2=$local_addres
+ printf "| $column1$column2 | \n"
+ column1="config file:"; column2=$config_file
+ printf "| $column1$column2 | \n"
+ column1="makefile:"; column2=$makefile
+ printf "| $column1$column2 | \n"
+ column1="local source path:"; column2=$local_source_path
+ printf "| $column1$column2 | \n"
+ column1="make depository:"; column2=$local_depository_path
+ printf "| $column1$column2 | \n"
+ printf "#------------------------------------------------------------------------# \n"
+
+# printf "| | \n"
+
+
+ if [[ $compile_utility_programs = false ]]
+ then
+
+ cd $local_source_path
+
+
+ # LISTE DER ZU PRUEFENDEN QUELLTEXTDATEIEN ERSTELLEN
+ source_code_files=`ls -1 *.$suf`
+
+
+
+ # VERZEICHNIS FUER DAS MAKE-DEPOSITORY ERZEUGEN,
+ # FALLS NOCH NICHT VORHANDEN. ANSONSTEN ALLE DATEIEN
+ # NEUEREN DATUMS IN DIESES VERZEICHNIS KOPIEREN
+ if [[ ! -d $local_depository_path ]]
+ then
+ if mkdir $local_depository_path
+ then
+ printf "\n\n *** directory for make depository:"
+ printf "\n $local_depository_path"
+ printf "\n was created\n"
+
+ # MAKEFILE UND QUELLTEXTDATEIEN UNTER BEIBEHALTUNG
+ # IHRES DATUMS INS VERZEICHNIS KOPIEREN
+ printf "\n *** makefile and source code files are copied to"
+ printf "\n $local_depository_path\n"
+ printf "\n copying makefile \"$makefile\" ..."
+ cp -p $makefile $local_depository_path/Makefile
+
+ # QUELLTEXTDATEIEN MUESSEN IM MAKEFILE AUFGEFUEHRT
+ # SEIN
+ for filename in $source_code_files
+ do
+ if [[ $(grep -c $filename $makefile) = 0 ]]
+ then
+ printf "\n +++ source code file:"
+ printf "\n $filename"
+ printf "\n is not listed in makefile"
+ locat=makefile; exit
+ else
+ printf "\n copying source code file \"$filename\" ..."
+ cp -p $filename $local_depository_path
+ fi
+ done
+ printf "\n"
+ else
+ printf "\n +++ directory for make depository:"
+ printf "\n $local_depository_path"
+ printf "\n cannot be created"
+ locat=local_depository_path; exit
+ fi
+ else
+
+ printf "\n *** checking file status ..."
+
+ # MAKEFILE KOPIEREN, FALLS NEUEREN DATUMS
+ if [[ $makefile -nt $local_depository_path/Makefile ]]
+ then
+ printf "\n *** update of \"$makefile\" "
+ cp -f -p $makefile $local_depository_path/Makefile
+ update=true
+
+ # PRUEFEN, OB ALLE DATEIEN IM DEPOSITORY AUCH IM NEUEN MAKEFILE
+ # VERZEICHNET SIND UND GEGEBENENFALLS DATEIEN LOESCHEN
+ cd $local_depository_path
+ source_code_files_in_depository=`ls -1 *.$suf`
+ for filename in $source_code_files_in_depository
+ do
+ if [[ $(grep -c $filename Makefile) = 0 ]]
+ then
+ printf "\n *** source code file in \"$local_depository_path\":"
+ printf "\n $filename"
+ printf "\n is not listed in makefile"
+ if [[ $silent = false ]]
+ then
+ answer=dummy
+ printf "\n\n"
+ while [[ "$answer" != y && "$answer" != Y && "$answer" != n && "$answer" != N ]]
+ do
+ printf " >>> delete \"$filename\" in \"$local_depository_path\" (y/n) ? "
+ read answer
+ done
+ if [[ $answer = y || $answer = Y ]]
+ then
+ base=`echo $filename | cut -d. -f2`
+ rm -f $filename
+ rm -f ${base}.o ${base}.mod
+ printf "\n *** \"$filename\" deleted in \"$local_depository_path\" "
+ else
+ printf "\n *** \"$filename\" not deleted in \"$local_depository_path\" "
+ fi
+ fi
+ fi
+ done
+ cd - > /dev/null 2>&1
+
+ elif [[ $local_depository_path/Makefile -nt $makefile ]]
+ then
+ printf "\n *** makefile in depository is newer than"
+ printf "\n \"$makefile\" "
+ if [[ $silent = false ]]
+ then
+ answer=dummy
+ printf "\n\n"
+ while [[ "$answer" != y && "$answer" != Y && "$answer" != n && "$answer" != N ]]
+ do
+ printf " >>> update \"$makefile\" (y/n) ? "
+ read answer
+ done
+ if [[ $answer = y || $answer = Y ]]
+ then
+ cp -f -p $local_depository_path/Makefile $makefile
+ printf "\n *** \"$makefile\" updated"
+ else
+ printf "\n *** \"$makefile\" not updated"
+ fi
+ fi
+ fi
+
+ # QUELLTEXTDATEIEN KOPIEREN, FALLS NEUEREN DATUMS
+ # SIE MUESSEN IM MAKEFILE AUFGEFUEHRT SEIN
+ for filename in $source_code_files
+ do
+ if [[ $(grep -c $filename $makefile) = 0 ]]
+ then
+ printf "\n +++ source code file:"
+ printf "\n $filename"
+ printf "\n is not listed in makefile"
+ locat=makefile; exit
+ else
+ if [[ ! -f $local_depository_path/$filename ]]
+ then
+ cp -p $filename $local_depository_path
+ printf "\n *** source code file \"$filename\" created in \"$local_depository_path\" "
+ fi
+ if [[ $filename -nt $local_depository_path/$filename ]]
+ then
+ printf "\n *** update of source code file \"$filename\" "
+ cp -f -p $filename $local_depository_path
+ update=true
+ fi
+ fi
+ done
+
+
+ # PRUEFEN, OB ALLE DATEIEN IM DEPOSITORY IM AKTUELLEN ARBEITSVERZEICHNIS VORHANDEN
+ # ODER EVTL. NEUEREN DATUMS SIND
+ cd $local_depository_path
+ source_code_files_in_depository=`ls -1 *.$suf`
+ cd - > /dev/null 2>&1
+ for filename in $source_code_files_in_depository
+ do
+ if [[ ! -f $filename ]]
+ then
+ printf "\n *** source code file \"$filename\" does not exist in current directory"
+ if [[ $silent = false ]]
+ then
+ answer=dummy
+ printf "\n\n"
+ while [[ "$answer" != y && "$answer" != Y && "$answer" != n && "$answer" != N ]]
+ do
+ printf " >>> create \"$filename\" in current directory (y/n) ? "
+ read answer
+ done
+ if [[ $answer = y || $answer = Y ]]
+ then
+ cp -p $local_depository_path/$filename $filename
+ printf "\n *** source code file \"$filename\" created in current directory"
+ else
+ printf "\n *** source code file \"$filename\" not created in current directory"
+ fi
+ fi
+ elif [[ $local_depository_path/$filename -nt $filename ]]
+ then
+ ls -al $local_depository_path/$filename
+ ls -al $filename
+ printf "\n *** source code file \"$filename\" in depository is newer than in current directory"
+ if [[ $silent = false ]]
+ then
+ answer=dummy
+ printf "\n\n"
+ while [[ "$answer" != y && "$answer" != Y && "$answer" != n && "$answer" != N ]]
+ do
+ printf " >>> update \"$filename\" in current directory (y/n) ? "
+ read answer
+ done
+ if [[ $answer = y || $answer = Y ]]
+ then
+ cp -f -p $local_depository_path/$filename $filename
+ printf "\n *** source code file \"$filename\" updated in current directory"
+ else
+ printf "\n *** source code file \"$filename\" not updated in current directory"
+ fi
+ fi
+ fi
+ done
+
+ if [[ $update = false ]]
+ then
+ printf "\n *** no updates necessary in \"$local_depository_path\" "
+ if [[ $silent = false ]]
+ then
+ answer=dummy
+ printf "\n\n"
+ while [[ "$answer" != y && "$answer" != Y && "$answer" != n && "$answer" != N ]]
+ do
+ printf " >>> continue with updates on remote hosts (y/n) ? "
+ read answer
+ done
+ if [[ $answer = n || $answer = N ]]
+ then
+ locat=user_abort; exit
+ fi
+ fi
+ fi
+ fi
+
+
+
+ # QUELLTEXTDATEIEN UND MAKEFILE MIT TAR ZUSAMMENBINDEN
+ # IN JEDEM FALL ALLEN DATEIEN WRITE-PERMIT GEBEN, DAMIT ES AUF
+ # DEN REMOTE-RECHNERN NICHT EVTL. ZU PROBLEMEN BEIM UEBERSCHREIBEN KOMMT
+ printf "\n\n *** tar of makefile and source files in depository ..."
+ cd $local_depository_path
+ chmod u+w Makefile *.$suf
+ tar -cf ${mainprog}_sources.tar Makefile *.$suf
+ printf "\n"
+
+ fi
+
+
+
+ # BESTAETIGUNG ZUM WEITERMACHEN EINHOLEN
+ if [[ $host = all ]]
+ then
+ printf "\n *** updates will be made for ALL hosts found in"
+ printf "\n the configuration file"
+ else
+ printf "\n *** update will be made for host \"$host\" "
+ fi
+
+ if [[ $silent = false ]]
+ then
+ answer=dummy
+ printf "\n\n"
+ while [[ "$answer" != y && "$answer" != Y && "$answer" != n && "$answer" != N ]]
+ do
+ printf " >>> continue (y/n) ? "
+ read answer
+ done
+ if [[ $answer = n || $answer = N ]]
+ then
+ locat=user_abort; exit
+ fi
+ fi
+
+
+
+
+ # GENERIERUNG DER AKTUELLEN MODELLVERSION FUER ALLE RECHNER-/UEBERSETZUNGS-
+ # VERSIONEN, DIE IN DER KONFIGURATIONSDATEI GEFUNDEN WERDEN
+ printf "\n *** scanning configuration file for host(s) ..."
+
+ grep %fopts $config_file > tmp_mbuild
+ while read line
+ do
+ # KOMMENTARZEILEN UEBERSPRINGEN
+ [[ $(echo $line | cut -c1) = "#" ]] && continue
+ (( ihost = ihost + 1 ))
+ hostline[$ihost]="$line"
+ done < tmp_mbuild
+
+
+ while (( ih < ihost ))
+ do
+
+ (( ih = ih + 1 ))
+
+ # REMOTE-RECHNER UND UEBERSETZUNGS-VERSION FESTSTELLEN
+ # NUR WEITERMACHEN, WENN ENTSPRECHENDER REMOTE-RECHNER MITTELS
+ # SHELLSCRIPT-OPTION AUCH AUSGEWAEHLT WURDE
+ remote_host_string=`echo ${hostline[$ih]} | cut -d" " -s -f3-`
+ remote_host=`echo $remote_host_string | cut -d" " -f1`
+ if [[ $host != all ]]
+ then
+ [[ $remote_host != $host ]] && continue
+ fi
+ host_found=true
+ condition1=`echo $remote_host_string | cut -d" " -s -f2`
+ if [[ $condition1 = $remote_host ]]
+ then
+ condition1=""
+ else
+ condition2=`echo $remote_host_string | cut -d" " -s -f3`
+ fi
+
+ netcdf_inc=""
+ netcdf_lib=""
+
+ # AUF HLRN-RECHNER NUR EINMAL UEBERSETZEN
+ if [[ $remote_host = ibmb || $remote_host = ibmh ]]
+ then
+ if [[ $ibm_hb_done = true ]]
+ then
+ printf "\n *** remote host \"$remote_host\" skipped since compilation has already"
+ printf "\n been carried out on one of the HLRN machines\n"
+ continue
+ fi
+ fi
+
+ # AUF LCMUK-RECHNER NUR EINMAL UEBERSETZEN
+ if [[ $remote_host = lcmuk ]]
+ then
+ if [[ $lcmuk_done = true ]]
+ then
+ printf "\n *** local host \"$remote_host\" skipped since compilation has already"
+ printf "\n been carried out on this host\n"
+ continue
+ fi
+ fi
+
+
+ # IP-ADRESSE DES REMOTE-RECHNERS BESTIMMEN
+ case $remote_host in
+ (lcmuk) remote_addres=130.75.105.2;;
+ (lctit) remote_addres=172.17.75.161;;
+ (decalpha) remote_addres=165.132.26.56;;
+ (ibmb) remote_addres=130.73.230.10;;
+ (ibmh) remote_addres=130.75.4.10;;
+ (ibms) remote_addres=150.183.5.101;;
+ (ibmy) remote_addres=165.132.26.58;;
+ (nech) remote_addres=136.172.44.192;;
+ (neck) remote_addres=133.5.178.11;;
+ (ground.yonsei.ac.kr) remote_addres=134.75.155.33;;
+ (*) if [[ $local_host != $remote_host ]]
+ then
+ printf "\n +++ remote host \"$remote_host\" unknown";
+ printf "\n please inform S. Raasch!"
+ fi;;
+ esac
+
+
+ # REMOTE-USERNAMEN ERMITTELN
+ line=""
+ found=false
+ grep "$remote_host_string" $config_file | grep "%remote_username" > tmp_mbuild
+ while read line1
+ do
+
+ if [[ $(echo $line1 | cut -d" " -s -f3-) = "$remote_host_string" ]]
+ then
+ line="$line1"
+ fi
+
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ remote_username=`echo $line | cut -d" " -s -f2`
+ found=true
+ fi
+
+ done < tmp_mbuild
+
+ if [[ $found = false ]]
+ then
+ printf "\n +++ no remote username found in configuration file"
+ printf "\n for \"$remote_host_string\" "
+ locat=config_file; exit
+ fi
+
+
+ # REMOTE-QUELLTEXTPFAD ERMITTELN
+ line=""
+ remote_source_path=""
+ grep "$remote_host_string" $config_file | grep "%source_path" > tmp_mbuild
+ while read line1
+ do
+
+ if [[ $(echo $line1 | cut -d" " -s -f3-) = "$remote_host_string" ]]
+ then
+ line="$line1"
+ fi
+
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ remote_source_path=`echo $line | cut -d" " -s -f2`
+ fi
+
+ done < tmp_mbuild
+
+ if [[ "$remote_source_path" = "" ]]
+ then
+ if [[ "$global_source_path" != "" ]]
+ then
+ remote_source_path=$global_source_path
+ else
+ printf "\n +++ no source path found in configuration file"
+ printf "\n for \"$remote_host_string\" "
+ locat=config_file; exit
+ fi
+ fi
+
+ remote_ud=${remote_source_path}/../UTIL
+ remote_ud=$(eval echo $remote_ud)
+
+
+ # REMOTE-PFAD FUER MAKE-DEPOSITORY ERMITTELN
+ remote_md=""
+ line=""
+ grep "$remote_host_string" $config_file | grep "%depository_path" > tmp_mbuild
+ while read line1
+ do
+
+ if [[ $(echo $line1 | cut -d" " -s -f3-) = "$remote_host_string" ]]
+ then
+ line="$line1"
+ fi
+
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ remote_md=`echo $line | cut -d" " -s -f2`
+ fi
+
+ done < tmp_mbuild
+
+ if [[ "$remote_md" = "" ]]
+ then
+ if [[ "$global_depository_path" != "" ]]
+ then
+ remote_md=$global_depository_path
+ else
+ printf "\n +++ no depository path found in configuration file"
+ printf "\n for \"$remote_host_string\" "
+ printf "\n please set \"\%depository_path\" in configuration file"
+ locat=config_file; exit
+ fi
+ fi
+
+ remote_md=$(eval echo $remote_md)
+
+
+ # COMPILERNAMEN ERMITTELN
+ line=""
+ found=false
+ grep "$remote_host_string" $config_file | grep "%compiler_name " > tmp_mbuild
+ while read line1
+ do
+
+ if [[ $(echo $line1 | cut -d" " -s -f3-) = "$remote_host_string" ]]
+ then
+ line="$line1"
+ fi
+
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ compiler_name=`echo $line | cut -d" " -s -f2`
+ found=true
+ fi
+
+ done < tmp_mbuild
+
+ if [[ $found = false ]]
+ then
+ printf "\n +++ no compiler name found in configuration file"
+ printf "\n for \"$remote_host_string\" "
+ locat=config_file; exit
+ fi
+
+
+ # BEI BENUTZUNG EINES PARALLELEN COMPILERS MUSS AUCH EIN
+ # SERIELLER COMPILERNAME ERMITTELT WERDEN
+ if [[ $(echo $remote_host_string | grep -c parallel) = 1 ]]
+ then
+ line=""
+ found=false
+ grep "$remote_host_string" $config_file | grep "%compiler_name_ser" > tmp_mbuild
+ while read line1
+ do
+
+ if [[ $(echo $line1 | cut -d" " -s -f3-) = "$remote_host_string" ]]
+ then
+ line="$line1"
+ fi
+
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ compiler_name_ser=`echo $line | cut -d" " -s -f2`
+ found=true
+ fi
+
+ done < tmp_mbuild
+
+ if [[ $found = false ]]
+ then
+ printf "\n +++ no serial compiler name found in configuration file"
+ printf "\n for \"$remote_host_string\" "
+ locat=config_file; exit
+ fi
+ else
+ compiler_name_ser=$compiler_name
+ fi
+
+
+
+ # PRAEPROZESSOR-OPTIONEN/DIREKTIVEN ERMITTELN
+ line=""
+ found=false
+ grep "$remote_host_string" $config_file | grep "%cpp_options" > tmp_mbuild
+ while read line1
+ do
+
+ if [[ $(echo $line1 | cut -d" " -s -f3-) = "$remote_host_string" ]]
+ then
+ line="$line1"
+ fi
+
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ # EVENTUELLE DOPPELPUNKTE AUS OPTIONSSTRING ENTFERNEN
+ cpp_options=`echo $line | cut -d" " -s -f2 | sed 's/::/%DUM%/g' | sed 's/:/ /g' | sed 's/%DUM%/:/g'`
+ found=true
+ fi
+
+ done < tmp_mbuild
+
+ if [[ $found = false ]]
+ then
+ printf "\n +++ no preprocessor options found in configuration file"
+ printf "\n for \"$remote_host_string\" "
+ locat=config_file; exit
+ fi
+
+
+ # RECHNERSPEZIFISCHE CPP-DIREKTIVEN HINZUFUEGEN
+ for string in $remote_host_string
+ do
+ if [[ $(echo $remote_host | cut -c1-2) = lc && $(echo $string | cut -c1-2) = lc ]]
+ then
+ cpp_options="$cpp_options -D__lc "
+ elif [[ $(echo $remote_host | cut -c1-3) = ibm && $(echo $string | cut -c1-3) = ibm ]]
+ then
+ cpp_options="${cpp_options},-D__ibm"
+ elif [[ $(echo $remote_host | cut -c1-3) = nec && $(echo $string | cut -c1-3) = nec ]]
+ then
+ cpp_options="${cpp_options} -D__nec"
+ else
+ if [[ $(echo $remote_host | cut -c1-3) = ibm ]]
+ then
+ cpp_options="${cpp_options},-D__$string"
+ else
+ cpp_options="$cpp_options -D__$string "
+ fi
+ fi
+ done
+
+
+
+ # NETCDF-OPTIONEN ERMITTELN
+ line=""
+ grep "$remote_host_string" $config_file | grep "%netcdf_inc" > tmp_mbuild
+ while read line1
+ do
+
+ if [[ $(echo $line1 | cut -d" " -s -f3-) = "$remote_host_string" ]]
+ then
+ line="$line1"
+ fi
+
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ # EVENTUELLE DOPPELPUNKTE AUS OPTIONSSTRING ENTFERNEN
+ netcdf_inc=`echo $line | cut -d" " -s -f2 | sed 's/::/%DUM%/g' | sed 's/:/ /g' | sed 's/%DUM%/:/g'`
+ fi
+
+ done < tmp_mbuild
+
+ line=""
+ grep "$remote_host_string" $config_file | grep "%netcdf_lib" > tmp_mbuild
+ while read line1
+ do
+
+ if [[ $(echo $line1 | cut -d" " -s -f3-) = "$remote_host_string" ]]
+ then
+ line="$line1"
+ fi
+
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ # EVENTUELLE DOPPELPUNKTE AUS OPTIONSSTRING ENTFERNEN
+ netcdf_lib=`echo $line | cut -d" " -s -f2 | sed 's/::/%DUM%/g' | sed 's/:/ /g' | sed 's/%DUM%/:/g'`
+ fi
+
+ done < tmp_mbuild
+
+
+
+ # COMPILEROPTIONEN ERMITTELN
+ line=""
+ found=false
+ grep "$remote_host_string" $config_file | grep "%fopts" > tmp_mbuild
+ while read line1
+ do
+
+ if [[ $(echo $line1 | cut -d" " -s -f3-) = "$remote_host_string" ]]
+ then
+ line="$line1"
+ fi
+
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ # EVENTUELLE DOPPELPUNKTE AUS DIREKTIVENSTRING ENTFERNEN
+ compiler_options=`echo $line | cut -d" " -s -f2 | sed 's/::/%DUM%/g' | sed 's/:/ /g' | sed 's/%DUM%/:/g'`
+ found=true
+
+ # NETCDF-INCLUDEVERZEICHNIS HINZUFUEGEN
+ compiler_options="$compiler_options $netcdf_inc"
+ fi
+
+ done < tmp_mbuild
+
+ if [[ $found = false ]]
+ then
+ printf "\n +++ no compiler options found in configuration file"
+ printf "\n for \"$remote_host_string\" "
+ locat=config_file; exit
+ fi
+
+
+
+ # LADER-OPTIONEN ERMITTELN
+ line=""
+ found=false
+ grep "$remote_host_string" $config_file | grep "%lopts" > tmp_mbuild
+ while read line1
+ do
+
+ if [[ $(echo $line1 | cut -d" " -s -f3-) = "$remote_host_string" ]]
+ then
+ line="$line1"
+ fi
+
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ # EVENTUELLE DOPPELPUNKTE AUS DIREKTIVENSTRING ENTFERNEN
+ loader_options=`echo $line | cut -d" " -s -f2 | sed 's/::/%DUM%/g' | sed 's/:/ /g' | sed 's/%DUM%/:/g'`
+ found=true
+
+ # NETCDF-LIBRARY HINZUFUEGEN
+ loader_options="$loader_options $netcdf_lib"
+ fi
+
+ done < tmp_mbuild
+
+ if [[ $found = false ]]
+ then
+ printf "\n +++ no loader options found in configuration file"
+ printf "\n for \"$remote_host_string\" "
+ locat=config_file; exit
+ fi
+
+
+ printf "\n\n#------------------------------------------------------------------------# \n"
+ if [[ $remote_host = $local_host ]]
+ then
+ column1="remote_host:"; column2="$remote_host (= local host!)"
+ else
+ column1="remote_host:"; column2=$remote_host
+ fi
+ printf "| $column1$column2 | \n"
+ printf "| | \n"
+ column1="conditions:"; column2="$condition1 $condition2"
+ printf "| $column1$column2 | \n"
+ column1="make depository:"; column2=$remote_md
+ printf "| $column1$column2 | \n"
+ if [[ $compile_utility_programs = true ]]
+ then
+ column1="utility directory:"; column2=$remote_ud
+ printf "| $column1$column2 | \n"
+ fi
+ column1="username:"; column2=$remote_username
+ printf "| $column1$column2 | \n"
+ column1="addres:"; column2=$remote_addres
+ printf "| $column1$column2 | \n"
+ column1="compiler:"; column2=$compiler_name
+ printf "| $column1$column2 | \n"
+ if [[ $compile_utility_programs = true ]]
+ then
+ column1="serial compiler:"; column2=$compiler_name_ser
+ printf "| $column1$column2 | \n"
+ fi
+ column1="cpp options:"; column2=$cpp_options
+ printf "| $column1$column2 | \n"
+ line=$(echo "$cpp_options" | cut -c51-)
+ while [[ "$line" != "" ]]
+ do
+ column1=""
+ column2=$line
+ printf "| $column1$column2 | \n"
+ line=$(echo "$line" | cut -c51-)
+ done
+ column1="compiler options:"; column2=$compiler_options
+ printf "| $column1$column2 | \n"
+ line=$(echo "$compiler_options" | cut -c51-)
+ while [[ "$line" != "" ]]
+ do
+ column1=""
+ column2=$line
+ printf "| $column1$column2 | \n"
+ line=$(echo "$line" | cut -c51-)
+ done
+ column1="loader options:"; column2=$loader_options
+ printf "| $column1$column2 | \n"
+ line=$(echo "$loader_options" | cut -c51-)
+ while [[ "$line" != "" ]]
+ do
+ column1=""
+ column2=$line
+ printf "| $column1$column2 | \n"
+ line=$(echo "$line" | cut -c51-)
+ done
+ printf "#------------------------------------------------------------------------# \n"
+
+ if [[ $silent = false ]]
+ then
+ answer=dummy
+ printf "\n\n"
+ while [[ "$answer" != y && "$answer" != Y && "$answer" != c && "$answer" != C && "$answer" != s && "$answer" != S && "$answer" != a && "$answer" != A ]]
+ do
+ printf " >>> continue (y(es)/c(ontinue)/a(bort)/s(skip)) ? "
+ read answer
+ done
+ if [[ $answer = a || $answer = A ]]
+ then
+ locat=user_abort; exit
+ fi
+ if [[ $answer = c || $answer = C ]]
+ then
+ silent=false
+ fi
+ if [[ $answer = s || $answer = S ]]
+ then
+ continue
+ fi
+ fi
+
+
+ if [[ $remote_mode = batch ]]
+ then
+
+ # BATCH-JOB PARAMETER SETZEN
+ case $remote_host in
+ (t3eb) queue=berte; memory=60; cputime=1000; xoption="-X 0";;
+ (t3eh) queue=comp_t3e; memory=60; cputime=360;;
+ (t3ej2) queue=normal; memory=60; cputime=1000; xoption="-X 0";;
+ (t3ej5|ground.yonsei.ac.kr) printf "\n --- remote host \"$remote_host\" does not allow batch jobs"; continue;;
+ esac
+
+
+ # BATCH-JOB ZUSAMMENSTELLEN
+ printf "\n *** creating batch-job for remote host"
+ echo " " > mbuild_job
+
+ # AUF CRAY-RECHNERN IN JUELICH WIRD KEIN BENUTZER-PROFILE AUSGEFUEHRT
+ # DIES WIRD HIER GETAN, UM PFADE USW. ZU SETZEN
+ if [[ $remote_host = t3ej2 ]]
+ then
+ echo "set +vx" >> mbuild_job
+ echo ". .profile" >> mbuild_job
+ echo "set -x" >> mbuild_job
+ fi
+
+ # AUF CRAY-RECHNERN GELADENE MODULE AUFLISTEN
+ if [[ $host = t3eb || $host = t3eh || $host = t3ej2 ]]
+ then
+ echo "module list" >> mbuild_job
+ fi
+
+
+ # WECHSEL IN TEMPORAERES VERZEICHNIS
+ echo "cd ${remote_md}" >> mbuild_job
+
+
+ # AKTUELLE QUELLTEXTVERSION INS REMOTE-QUELLTEXTVERZEICHNIS KOPIEREN
+ echo "scp ${local_username}@${local_addres}:~/modell/code_3dp/palm_current_version/${mainprog}_sources.tar ${mainprog}_sources.tar" >> mbuild_job
+# echo "[[ \$? != 0 ]] && (echo "+++ scp failed"; exit)" >> mbuild_job
+
+
+ # FALLS VORHANDEN, LETZTE VERSION AUF DEM REMOTE-RECHNER AUSPACKEN
+ echo "[[ -f ${mainprog}_current_version.tar ]] && tar -xvf ${mainprog}_current_version.tar" >> mbuild_job
+
+
+ # AKTUELLE QUELLTEXTVERSION AUF REMOTE-RECHNER AUSPACKEN
+ echo "tar -xvf ${mainprog}_sources.tar" >> mbuild_job
+
+
+ # MAKE MIT ZUVOR ERMITTELTEN OPTIONEN AUF REMOTE RECHNER AUSFUEHREN
+ echo "make PROG=$mainprog F90=$compiler_name COPT=\"$cpp_options\" F90FLAGS=\"$compiler_options\" LDFLAGS=\"$loader_options\" " >> mbuild_job
+ echo "chmod u+w *" >> mbuild_job
+
+ # NEUE VERSION AUF REMOTE-RECHNER ZUSAMMENPACKEN
+ echo "tar -cvf ${mainprog}_current_version.tar *.f90 *.o" >> mbuild_job
+
+
+ # AKTUELLES VERSIONSVERZEICHNIS AUF REMOTE-RECHNER BEREINIGEN
+ echo "make clean" >> mbuild_job
+ echo "rm ${mainprog}_sources.tar" >> mbuild_job
+ echo "rm *.f90 Makefile" >> mbuild_job
+
+
+
+ # JOB MITTELS SUBJOB STARTEN
+ printf "\n *** sending batch job to remote host"
+# subjob $xoption -h $remote_host -q $queue -m $memory -t $cputime -v mbuild_job
+
+
+ # JOBFILE LOESCHEN
+# rm aljob
+
+ else
+
+ if [[ $remote_host != $local_host ]]
+ then
+
+ if [[ $compile_utility_programs = false ]]
+ then
+
+ # AKTUELLE QUELLTEXTVERSION INS REMOTE-QUELLTEXTVERZEICHNIS KOPIEREN
+ # FALLS DIESES NOCH NICHT EXISTIERT, WIRD ES ERZEUGT
+ echo " *** copying \"${mainprog}_sources.tar\" to \"${remote_addres}:${remote_md}/\" "
+ if [[ $remote_host != lctit ]]
+ then
+ ssh ${remote_username}@${remote_addres} "[[ ! -d ${remote_md} ]] && (echo \" *** ${remote_md} will be created\"; mkdir -p ${remote_md})"
+ else
+ # TIT ERLAUBT NUR DIE AUSFÃœHRUNG GANZ BESTIMMTER KOMMANDOS
+ # MIT SSH, DESHALB AUFRUF PER PIPE
+ print "[[ ! -d ${remote_md} ]] && (echo \" *** ${remote_md} will be created\"; mkdir -p ${remote_md})" | ssh ${remote_username}@${remote_addres} 2>&1
+ fi
+ if [[ $local_host = decalpha ]]
+ then
+ # DECALPHA BENUTZT BEI NICHTANGABE DES VOLLSTÄNDIGEN PFADES
+ # IRGENDEIN ANDERES SCP (WAS NICHT FUNKTIONIERT). AUSSERDEM
+ # KOENNEN DOLLAR-ZEICHEN NICHT BENUTZT WERDEN
+ remote_md=`echo $remote_md | sed 's/\$HOME\///'`
+ /bin/scp ${mainprog}_sources.tar ${remote_username}@${remote_addres}:${remote_md}/${mainprog}_sources.tar
+ else
+ scp ${mainprog}_sources.tar ${remote_username}@${remote_addres}:${remote_md}/${mainprog}_sources.tar
+ fi
+
+
+
+ # FALLS VORHANDEN, LETZTE VERSION AUF DEM REMOTE-RECHNER AUSPACKEN
+ echo " *** untar previous update on remote host, if existing"
+ if [[ $remote_host != lctit ]]
+ then
+ ssh ${remote_username}@${remote_addres} "cd ${remote_md}; [[ -f ${mainprog}_current_version.tar ]] && tar -xf ${mainprog}_current_version.tar"
+ else
+ # TIT ERLAUBT NUR DIE AUSFÃœHRUNG GANZ BESTIMMTER KOMMANDOS
+ # MIT SSH, DESHALB AUFRUF PER PIPE
+ print "cd ${remote_md}; [[ -f ${mainprog}_current_version.tar ]] && tar -xf ${mainprog}_current_version.tar" | ssh ${remote_username}@${remote_addres} 2>&1
+ fi
+
+
+ # AKTUELLE QUELLTEXTVERSION AUF REMOTE-RECHNER AUSPACKEN
+ echo " *** untar actual sources on remote host"
+ if [[ $remote_host != lctit ]]
+ then
+ ssh ${remote_username}@${remote_addres} "cd ${remote_md}; tar -xf ${mainprog}_sources.tar"
+ else
+ # TIT ERLAUBT NUR DIE AUSFÃœHRUNG GANZ BESTIMMTER KOMMANDOS
+ # MIT SSH, DESHALB AUFRUF PER PIPE
+ print "cd ${remote_md}; tar -xf ${mainprog}_sources.tar" | ssh ${remote_username}@${remote_addres} 2>&1
+ fi
+
+
+ # MAKE MIT ZUVOR ERMITTELTEN OPTIONEN AUF REMOTE RECHNER AUSFUEHREN
+ # KOMMANDOUEBERGABE AN SSH PER PIPE, DA SO DIE SYSTEM- UND
+ # BENUTZERPROFILE VOLLSTAENDIG AUSGEFUEHRT WERDEN (SONST FEHLEN MAKE
+ # Z.B. DIE PFADE ZUM COMPILER)
+ echo " *** execute \"make\" on remote host"
+
+ if [[ $remote_host = nech ]]
+ then
+ make_call_string="sxmake PROG=$mainprog F90=$compiler_name COPT=\"$cpp_options\" F90FLAGS=\"$compiler_options\" LDFLAGS=\"$loader_options\" "
+ else
+ make_call_string="make PROG=$mainprog F90=$compiler_name COPT=\"$cpp_options\" F90FLAGS=\"$compiler_options\" LDFLAGS=\"$loader_options\" "
+ fi
+
+ if [[ $remote_host = t3eh ]]
+ then
+
+ print "xterm\nexit\n cd ${remote_md}; make PROG=$mainprog F90=$compiler_name COPT=\"$cpp_options\" F90FLAGS=\"$compiler_options\" LDFLAGS=\"$loader_options\" " | ssh ${remote_username}@${remote_addres} 2>&1 | tee ${remote_host}_last_make_protokoll
+
+ elif [[ $remote_host = t3ej2 || $remote_host = ibms || $remote_host = ibmy ]]
+ then
+
+ ssh ${remote_username}@${remote_addres} "cd ${remote_md}; echo '$make_call_string' > LAST_MAKE_CALL; chmod u+x LAST_MAKE_CALL; $make_call_string; [[ \$? != 0 ]] && echo MAKE_ERROR" 2>&1 | tee ${remote_host}_last_make_protokoll
+
+ elif [[ $remote_host = ibmb || $remote_host = ibmh ]]
+ then
+
+ print "export OBJECT_MODE=64; cd ${remote_md}; echo $make_call_string > LAST_MAKE_CALL; chmod u+x LAST_MAKE_CALL; $make_call_string; [[ \$? != 0 ]] && echo MAKE_ERROR" | ssh ${remote_username}@${remote_addres} 2>&1 | tee ${remote_host}_last_make_protokoll
+
+ elif [[ $remote_host = lctit ]]
+ then
+
+ echo " " > ${remote_host}_last_make_protokoll
+ while [[ $(cat ${remote_host}_last_make_protokoll | grep -c "Forwarding to N1GE") = 0 ]]
+ do
+ print "cd ${remote_md}; echo $make_call_string > LAST_MAKE_CALL; chmod u+x LAST_MAKE_CALL; $make_call_string; [[ \$? != 0 ]] && echo MAKE_ERROR" | ssh ${remote_username}@${remote_addres} 2>&1 | tee ${remote_host}_last_make_protokoll
+ done
+
+ else
+
+ print "cd ${remote_md}; echo $make_call_string > LAST_MAKE_CALL; chmod u+x LAST_MAKE_CALL; $make_call_string; [[ \$? != 0 ]] && echo MAKE_ERROR" | ssh ${remote_username}@${remote_addres} 2>&1 | tee ${remote_host}_last_make_protokoll
+
+ fi
+
+ if [[ $(grep -c MAKE_ERROR ${remote_host}_last_make_protokoll) != 0 ]]
+ then
+ printf "\a\n +++ error(s) occurred during compiling or linking on host \"$remote_host\" "
+ if [[ $silent = false ]]
+ then
+ answer=dummy
+ printf "\n"
+ while [[ "$answer" != c && "$answer" != k ]]
+ do
+ printf " >>> continue / list errors / kill mbuild (c/l/k) ? "
+ read answer
+ if [[ "$answer" = l ]]
+ then
+ more ${remote_host}_last_make_protokoll
+ fi
+ done
+ if [[ $answer = k ]]
+ then
+ locat=user_abort; exit
+ fi
+ fi
+ fi
+
+
+
+ # NEUE VERSION AUF REMOTE-RECHNER ZUSAMMENPACKEN
+ printf "\n *** tar update on remote host ..."
+ if [[ $remote_host != lctit ]]
+ then
+ ssh ${remote_username}@${remote_addres} "cd ${remote_md}; chmod u+w *; tar -cf ${mainprog}_current_version.tar *.f90 *.o *.mod"
+ else
+ # TIT ERLAUBT NUR DIE AUSFÃœHRUNG GANZ BESTIMMTER KOMMANDOS
+ # MIT SSH, DESHALB AUFRUF PER PIPE
+ print "cd ${remote_md}; chmod u+w *; tar -cf ${mainprog}_current_version.tar *.f90 *.o *.mod" | ssh ${remote_username}@${remote_addres} 2>&1
+ fi
+
+
+ # AKTUELLES VERSIONSVERZEICHNIS AUF REMOTE-RECHNER BEREINIGEN
+# printf "\n *** \"make clean\" on remote host ..."
+# ssh ${remote_username}@${remote_addres} "cd ${remote_md}; make clean; rm ${mainprog}_sources.tar; rm *.f90 Makefile"
+# printf "\n"
+
+
+
+
+ # GLEICHE AKTIONEN FUER DIE UTILITY-PROGRAMME DURCHFUEHREN
+ # AKTUELLE QUELLTEXTVERSION INS REMOTE-QUELLTEXTVERZEICHNIS KOPIEREN
+ # FALLS DIESES NOCH NICHT EXISTIERT, WIRD ES ERZEUGT
+ elif [[ $compile_utility_programs = true ]]
+ then
+
+ printf "\n\n"
+ echo " *** copying scripts and utility programs to \"${remote_addres}:${remote_ud}/\" "
+ cd ${local_source_path}/../SCRIPTS
+
+ if [[ $remote_host != lctit ]]
+ then
+ ssh ${remote_username}@${remote_addres} "[[ ! -d ${remote_ud} ]] && (echo \" *** ${remote_ud} will be created\"; mkdir -p ${remote_ud}); [[ ! -d ${remote_ud}/../SCRIPTS ]] && (echo \" *** ${remote_ud}/../SCRIPTS will be created\"; mkdir -p ${remote_ud}/../SCRIPTS)"
+ else
+ # TIT ERLAUBT NUR DIE AUSFÃœHRUNG GANZ BESTIMMTER KOMMANDOS
+ # MIT SSH, DESHALB AUFRUF PER PIPE
+ print "[[ ! -d ${remote_ud} ]] && (echo \" *** ${remote_ud} will be created\"; mkdir -p ${remote_ud}); [[ ! -d ${remote_ud}/../SCRIPTS ]] && (echo \" *** ${remote_ud}/../SCRIPTS will be created\"; mkdir -p ${remote_ud}/../SCRIPTS)" | ssh ${remote_username}@${remote_addres} 2>&1
+ fi
+
+ # KOPIEREN DER SCRIPTE
+ if [[ $local_host = decalpha ]]
+ then
+ # DECALPHA BENUTZT BEI NICHTANGABE DES VOLLSTÄNDIGEN PFADES
+ # IRGENDEIN ANDERES SCP (WAS NICHT FUNKTIONIERT). AUSSERDEM
+ # KOENNEN DOLLAR-ZEICHEN NICHT BENUTZT WERDEN
+ remote_ud=`echo $remote_ud | sed 's/\$HOME\///'`
+ /bin/scp batch_scp mbuild mrun subjob ${remote_username}@${remote_addres}:${remote_ud}/../SCRIPTS > /dev/null
+ else
+ scp batch_scp mbuild mrun subjob ${remote_username}@${remote_addres}:${remote_ud}/../SCRIPTS > /dev/null
+ fi
+
+ cd - > /dev/null
+ cd ${local_source_path}/../UTIL
+
+
+ # KOPIEREN DER UTILITY-PROGRAMME
+ if [[ $local_host = decalpha ]]
+ then
+ # DECALPHA BENUTZT BEI NICHTANGABE DES VOLLSTÄNDIGEN PFADES
+ # IRGENDEIN ANDERES SCP (WAS NICHT FUNKTIONIERT). AUSSERDEM
+ # KOENNEN DOLLAR-ZEICHEN NICHT BENUTZT WERDEN
+ remote_ud=`echo $remote_ud | sed 's/\$HOME\///'`
+ /bin/scp Makefile *.f90 ${remote_username}@${remote_addres}:${remote_ud} > /dev/null
+ else
+ scp Makefile *.f90 ${remote_username}@${remote_addres}:${remote_ud} > /dev/null
+ fi
+
+
+
+ # MAKE MIT ZUVOR ERMITTELTEN OPTIONEN AUF REMOTE RECHNER AUSFUEHREN
+ # KOMMANDOUEBERGABE AN SSH PER PIPE, DA SO DIE SYSTEM- UND
+ # BENUTZERPROFILE VOLLSTAENDIG AUSGEFUEHRT WERDEN (SONST FEHLEN MAKE
+ # Z.B. DIE PFADE ZUM COMPILER)
+ echo " *** execute \"make\" on remote host"
+
+ if [[ $remote_host = nech ]]
+ then
+ make_call_string="sxmake F90=$compiler_name F90_SER=$compiler_name_ser COPT=\"$cpp_options\" F90FLAGS=\"$compiler_options\" LDFLAGS=\"$loader_options\" "
+ else
+ make_call_string="make F90=$compiler_name F90_SER=$compiler_name_ser COPT=\"$cpp_options\" F90FLAGS=\"$compiler_options\" LDFLAGS=\"$loader_options\" "
+ fi
+
+ if [[ $remote_host = ibms || $remote_host = ibmy ]]
+ then
+
+ ssh ${remote_username}@${remote_addres} "cd ${remote_ud}; $make_call_string; [[ \$? != 0 ]] && echo MAKE_ERROR"
+
+ elif [[ $remote_host = ibmb || $remote_host = ibmh ]]
+ then
+
+ print "export OBJECT_MODE=64; cd ${remote_ud}; $make_call_string; [[ \$? != 0 ]] && echo MAKE_ERROR" | ssh ${remote_username}@${remote_addres}
+
+ elif [[ $remote_host = lctit ]]
+ then
+
+ echo " " > ${remote_host}_last_make_protokoll
+ while [[ $(cat ${remote_host}_last_make_protokoll | grep -c "Forwarding to N1GE") = 0 ]]
+ do
+ print "cd ${remote_ud}; $make_call_string; [[ \$? != 0 ]] && echo MAKE_ERROR" | ssh ${remote_username}@${remote_addres} 2>&1 | tee ${remote_host}_last_make_protokoll
+ done
+
+ else
+
+ print "cd ${remote_ud}; $make_call_string; [[ \$? != 0 ]] && echo MAKE_ERROR" | ssh ${remote_username}@${remote_addres} 2>&1 | tee ${remote_host}_last_make_protokoll
+
+ fi
+
+ fi # ENDE UEBERSETZUNG DER UTILITY-PROGRAMME
+
+ rm -rf ${remote_host}_last_make_protokoll
+
+ # NUR AUF EINEM HLRN-RECHNER UEBERSETZEN
+ [[ $remote_host = ibmb || $remote_host = ibmh ]] && ibm_hb_done=true
+
+ else
+
+ if [[ $compile_utility_programs = false ]]
+ then
+
+ # MAKE MIT ZUVOR ERMITTELTEN OPTIONEN AUF LOKALEM RECHNER AUSFUEHREN
+ echo " "
+ echo " *** execute \"make\" on local host"
+
+ make PROG=$mainprog F90=$compiler_name COPT="$cpp_options" F90FLAGS="$compiler_options" LDFLAGS="$loader_options" 2>&1 | tee ${remote_host}_last_make_protokoll
+
+ if [[ $? != 0 ]]
+ then
+ printf "\a\n +++ error(s) occurred during compiling or linking on host \"$remote_host\" "
+ if [[ $silent = false ]]
+ then
+ answer=dummy
+ printf "\n"
+ while [[ "$answer" != c && "$answer" != k ]]
+ do
+ printf " >>> continue / list errors / kill mbuild (c/l/k) ? "
+ read answer
+ if [[ "$answer" = l ]]
+ then
+ more ${remote_host}_last_make_protokoll
+ fi
+ done
+ if [[ $answer = k ]]
+ then
+ locat=user_abort; exit
+ fi
+ fi
+ fi
+
+
+ # NEUE VERSION AUF LOKALEM RECHNER ZUSAMMENPACKEN
+ printf "\n *** tar update on local host ..."
+ tar -cf ${mainprog}_current_version.tar *.$suf *.o *.mod
+
+
+ # COMPILE THE UTILITY PROGRAMS
+ elif [[ $compile_utility_programs = true ]]
+ then
+ printf "\n\n"
+ echo " *** compiling the utility programs ..."
+ cd ${local_source_path}/../UTIL
+ make F90=$compiler_name F90_SER=$compiler_name_ser COPT="$cpp_options" F90FLAGS="$compiler_options" LDFLAGS="$loader_options"
+ cd - > /dev/null
+ fi
+
+
+ # NUR EINMAL AUF LCMUK UEBERSETZEN
+ [[ $remote_host = lcmuk ]] && lcmuk_done=true
+
+ fi
+
+ fi
+ done
+
+
+ if [[ $host_found = false ]]
+ then
+ if [[ $host = all ]]
+ then
+ printf "\n +++ no hosts found in configuration file"
+ else
+ printf "\n +++ host \"$host\" not found in configuration file"
+ fi
+ locat=config_file; exit
+ fi
+
+
+
+ # ABSCHLIESSENDE ARBEITEN
+ rm -f hosts_found_in_config_file
+
Index: /palm/tags/release-3.4a/SCRIPTS/mrun
===================================================================
--- /palm/tags/release-3.4a/SCRIPTS/mrun (revision 141)
+++ /palm/tags/release-3.4a/SCRIPTS/mrun (revision 141)
@@ -0,0 +1,3751 @@
+#!/bin/ksh
+# mrun - Plot-Shellskript
+# $Id: mrun 61 2007-03-12 05:42:06Z raasch $
+
+ # Prozedur zum Starten von Modellaeufen
+
+ # letzte Aenderung:
+ # 03/03/94 - Siggi - Entwicklungsbeginn
+ # 21/03/94 - Siggi - Entwicklungsabschluss (Version 1.0)
+ # 09/12/94 - Siggi - allexport unterbunden; statt dessen werden jetzt ein-
+ # zelne Variable exportiert. Dies ist noetig, weil an-
+ # sonsten irgendein Speicher ueberlaeuft und von mrun
+ # aufgerufene Programme (z.B. stageout) mit Fehlern
+ # abbrechen (too many arguments)
+ # 20/06/95 - Siggi - noclobber muss explizit abgeschaltet, da jetzt
+ # defaultmaessig im RRZN-Profile eingeschaltet
+ # 10/06/97 - Siggi - Zusaetzliche Option -C bei cpp, damit // nicht
+ # wegfallen
+ # 25/04/00 - Siggi - Version 1.5
+ # remote_addres und remote_user in return_addres bzw.
+ # return_username umbenannt, return_username wird dem
+ # mrun-Aufruf im Job ueber Option -U mitgegeben.
+ # Neue Variable remote_username, die beim interaktiven
+ # mrun-Aufruf zwingend ueber die neue Option -u oder
+ # in der Konfigurationsdatei angegeben werden muss.
+ # 08/02/01 - Siggi - Alle mrun-Meldungen ins englische uebersetzt,
+ # Version 1.7
+ # 05/05/02 - Siggi - Uebersetzungen mittels make-Mechanismus moeglich
+ # 21/11/02 - Siggi - ENV-Variable XLFRTEOPTS wird vor Ausfuehrung auf
+ # IBM gesetzt, um Record-Laenge der NAMELIST-Dateien,
+ # zu bestimmen; Praeprozessoroptionen haben nun alle
+ # die Form -Dtext=text, weil auf IBM sonst text durch
+ # die leere Zeichenkette ersetzt wird
+ # 01/08/03 - Siggi - Test of implementing dvrp+1PE on ibm
+ # 07/01/04 - Siggi - additional preprocessor directive for ibm included
+ # (-D$OMP=OMP) in order to avoid problems with
+ # OMP_NUM_THREADS
+ # 04/01/05 - Siggi - archiving on hanni and berni is done in separate
+ # tar files, one for each node used
+ # 07/01/04 - Siggi - old code for t3e, vpp and hpcs eliminated
+ # 09/01/05 - Siggi - workaround for getting the IP address on gfdl3
+ # 17/01/05 - Siggi - job for data transfer to local machine now within
+ # job class c1 (HLRN)
+ # 27/01/05 - Siggi - IP address workaround for gfdl3 removed
+ # 28/01/05 - Siggi - tar-filenames on $PERM (HLRN) now include the
+ # base filename and cycle number
+ # 16/02/05 - Gerald - hababai validated
+ # 14/03/05 - Siggi - abort on NEC after first runtime error (F_ERRCNT)
+ # 29/03/05 - Marcus - berni*-en0 validated
+ # 21/04/05 - Siggi - transfer-job-protocol for avs-data is no more stored
+ # 24/04/05 - Siggi - netcdf support on lcmuk
+ # 25/04/05 - Siggi - netcdf support on gfld3 (decalpha)
+ # 11/05/05 - Siggi - files with non-numeric extensions (.xxx after cycle
+ # number) can now be used within interactive runs
+ # 12/05/05 - Siggi - netcdf support on ibm
+ # 13/05/05 - Siggi - error in tar-filenames on $PERM (HLRN) removed
+ # 18/05/05 - Siggi - netcdf support on nec
+ # 24/05/05 - Siggi - netcdf support on ibms
+ # 14/06/05 - Siggi - sleep interval after submit of restart job increased
+ # to 30 seconds
+ # 28/06/05 - Siggi - bora adjusted to new intel compiler (LD_LIBRARY_
+ # PATH is temporarily set)
+ # 07/09/05 - Siggi - setting of MP_EAGER_LIMIT switched off because it
+ # caused warnings in the job protocol
+ # 20/10/05 - Siggi - update of netcdf-version on decalpha (gfdl3)
+ # 25/10/05 - Siggi - error in listing files for getting the cycle number
+ # removed
+ # 26/10/05 - Siggi - new paths for dvrp-library, transfer of catalogs
+ # realized by file attribute trpe
+ # 28/10/05 - Siggi - if existing, the file extension is output in case
+ # of missing input file - no job abort in case of
+ # missing input files with file extensions
+ # (preliminary solution)
+ # 31/10/05 - Siggi - data transfer from nech now within seperate job
+ # 04/11/05 - Siggi - netcdf 3.6.0-p1 on ibmh/ibmb
+ # 07/12/05 - Siggi - gallego and elephanta admitted
+ # 30/12/05 - Siggi - gfdl5 (ibmy) admitted
+ # 10/01/06 - Siggi - cpp directive for NetCDF 64bit support
+ # 20/01/06 - Siggi - cpp directive for ibmy
+ # 09/02/06 - Siggi - ibmy admitted for batch mode
+ # 13/04/06 - Siggi - ostria admitted
+ # 18/04/06 - Siggi - usage of OpenMP implemented (additional option -O)
+ # 10/05/06 - Siggi - environment variable XLSMPOPTS set on IBM for
+ # optimization of OpenMP runs (option stacksize is
+ # necessary for large gridpoint numbers because
+ # otherwise a segmentation fault occurs)
+ # 23/05/05 - Siggi - lctit (SUN Fire X4600) admitted
+ # 21/08/06 - Siggi - standard mrun path on scirocco is as on bora
+ # 23/08/06 - Siggi - netcdf support for scirocco (notebook)
+ # 20/09/06 - Marcus - add DVRP library on nech
+ # 24/10/06 - Siggi - Environment variables for PALM steering are written
+ # on local NAMELIST file ENVPAR
+ # 24/11/06 - Siggi - levanto admitted, maestro switched to ifc 9.1
+ # 28/11/06 - Siggi - call to interpret_config.x_levanto because of SuSe 10
+ # 06/02/07 - Siggi - add DVRP library on lcmuk
+ # 07/02/07 - Siggi - revision of source code handling, source code is
+ # now expected in directory given by source_path and
+ # not in the current working directory, source code
+ # files provided in add_source_path are allways
+ # compiled, source code to be compiled is allways
+ # sampled in SOURCES_FOR_RUN_$fname which is a
+ # subdirectory of the current working directory,
+ # -s TEST changed to -s WRITE_PERMIT or -s WP,
+ # adapted for RIAM (neck)
+ # bugfix for cycle number of output file (extout)
+ # all hpmuk-related code removed
+ # 14/02/07 - Siggi - dvrp support for neck added
+ # 28/02/07 - Siggi - empty lines in configuration file are accepted
+ # mrun_path replaced by PALM_BIN,
+ # all machines are calling interpret_config.x
+ # 14/03/07 - Siggi - fimm admitted, revision number added to terminal
+ # output
+ # 16/03/07 - Siggi - adjustments for lctit
+ # 29/03/07 - Siggi - global revision transfered to batch job by new
+ # option -G
+ # 30/03/07 - Siggi - compilation "by hand" removed, cpp-directives/options
+ # + netcdf/dvrp-options are read from configuration
+ # file, host identifier (local_host) is read from
+ # config file, code related to ftp filetransfer
+ # removed (incl. option -f)
+ # 19/06/07 - Siggi - time limit for cdata jobs increased
+ # 25/07/07 - Siggi - two sets of executables can be started on lcmuk,
+ # if new option -Y (coupling) is given,
+ # output of executables to aout_output removed,
+ # messages are immediately written to stdout instead
+ # 03/08/07 - Marcus - add XOPT="-X $numprocs" for lcfimm
+ # 09/08/07 - Marcus - workaround on lcfimm to propagate environment
+ # variables out to the nodes in coupled mode -disabled-
+ # 13/08/07 - Marcus - start local restart jobs per ssh on lcfimm
+ # 28/08/07 - Marcus - completely remove workaround on lcfimm to propagate
+ # environment variables out to the nodes in coupled mode
+ # 15/10/07 - Siggi - Preliminary adjustments for lctit, based on Jin's
+ # suggestions
+ # 19/10/07 - Marcus - further adjustments for lctit: add new optional
+ # argument -g group_number, admit all sla* node_usage
+ # queues
+ # 30/10/07 - Marcus - further adjustments for queues on lctit
+
+
+ # VARIABLENVEREINBARUNGEN + DEFAULTWERTE
+
+ set +o allexport # SICHERHEITSHALBER UNTERBINDEN, DA SONST EVTL. STAGEOUT
+ # NICHT LAUEFT (TOO MANY ARGUMENTS - PROBLEM)
+ set +o noclobber # EXISTIERENDE DATEIEN DUERFEN UEBERSCHRIEBEN WERDEN
+
+ AddFilenames=""
+ additional_conditions=""
+ add_source_path=""
+ afname=""
+ archive_save=true
+ archive_system=none
+ compiler_name=""
+ cond1=""
+ cond2=""
+ config_file=.mrun.config
+ cpp_opts=""
+ cpp_options=""
+ cpumax=0
+ cpurest=0
+ delete_temporary_catalog=true
+ do_batch=false
+ do_compile=true
+ do_remote=false
+ do_stagein=true
+ do_stageout=true
+ do_trace=false
+ email_notification=""
+ exclude=""
+ executable=""
+ execution_error=false
+ fimm=false
+ fname=test
+ fromhost=""
+ global_revision=""
+ group_number=none
+ host=""
+ host_file=""
+ hp=""
+ ignore_archive_error=false
+ input_list=""
+ interpreted_config_file=""
+ job_on_file=""
+ keep_data_from_previous_run=false
+ localhost_realname=$(hostname)
+ local_compile=false
+ locat=normal
+ mainprog=""
+ makefile=""
+ mc=$0
+ while [[ $(echo $mc | grep -c "/") != 0 ]]
+ do
+ mc=`echo $mc | cut -f2- -d"/"`
+ done
+ module_files=""
+ mrun_script_name=$mc
+ netcdf_inc=""
+ netcdf_lib=""
+ netcdf_support=false
+ node_usage=default
+ numprocs=""
+ OOPT=""
+ openmp=false
+ output_list=""
+ package_list=""
+ punkte="..........................................................."
+ queue=none
+ read_from_config=""
+ restart_run=false
+ return_addres=$(nslookup `hostname` 2>&1 | grep "Address:" | tail -1 | awk '{print $2}')
+ if [[ $return_addres = 130.75.105.158 ]]
+ then
+ return_addres=172.20.25.41
+ echo "+++ WARNING: return_addres changed to $return_addres !!!!!"
+ fi
+# if [[ $return_addres = 210.117.65.1 ]]
+# if [[ $(nslookup `hostname` 2>&1 | grep -c 210.117.65.1) = 1 ]]
+# then
+# [[ $localhost_realname = gfdl3.yonsei.ac.kr ]] && return_addres=165.132.26.56
+# fi
+ return_password=""
+ return_username=$LOGNAME
+ remotecall=false
+ remote_username=""
+ run_coupled_model=false
+ run_mode=""
+ scirocco=false
+ store_on_archive_system=true
+ striche=" ----------------------------------------------------------------------------"
+ silent=false
+ source_list=""
+ source_path=SOURCE
+ tasks_per_node=""
+ threads_per_task=1
+ tmpcreate=false
+ tmp_data_catalog=""
+ transfer_problems=false
+ usern=$LOGNAME
+ working_directory=`pwd`
+ TOPT=""
+ XOPT=""
+ zeit=$( date | cut -c 12-19 )
+
+ typeset -i iec=0 iic=0 iin=0 ioc=0 iout=0 memory=0 stagein_anz=0 stageout_anz=0
+ typeset -i cputime i ii iii icycle inode ival jobges jobsek maxcycle minuten nodes pes sekunden tp1
+
+ typeset -R30 calltime
+ typeset -L20 spalte1
+ typeset -L40 spalte2
+ typeset -L60 spalte3
+ typeset -L35 string1=`date`
+ typeset -L12 string2=$usern
+ typeset -L12 string3=$localhost_realname
+ typeset -L12 string4
+ typeset -L12 string5
+ typeset -L30 version="MRUN 2.0 Rev$Rev$"
+
+
+
+ # EINZELNE VARIABLE FUER HAUPTPROGRAMM EXPORTIEREN
+ export cpurest fname host localhost return_addres return_username remotecall tasks_per_node
+
+ # FOLGENDE VARIABLEN MUESSEN FUER DIE INTERPRETATION DER KONFIGURATIONSDATEI
+ # EXPORTIERT WERDEN
+ export afname config_file cpp_opts cpumax do_batch do_trace fname fromhost
+ export group_number input_list memory numprocs output_list queue run_mode
+
+
+
+ # FEHLERBEHANDLUNG
+ # BEI EXIT:
+ trap 'rm -rf $working_directory/tmp_mrun
+ if [[ $locat != localhost ]]
+ then
+# if [[ ! -f ${mrun_path}/statistik/mrun_statistik ]]
+# then
+# cat > ${mrun_path}/statistik/mrun_statistik << %STATEND%
+#MRUN-calls on $localhost
+#
+#date and time user localhost remotehost termination mrun-command
+#--------------------------------------------------------------------------------------------------------------------
+#%STATEND%
+# chmod 666 ${mrun_path}/statistik/mrun_statistik
+# fi
+#
+# # EINTRAG IN DIE STATISTIK-DATEI
+# string4=$host
+# string5=$locat
+# if [[ "$job_on_file" = "" && $locat != control_c && $locat != user_abort ]]
+# then
+# if [[ $do_batch = true ]]
+# then
+# printf "$string1$string2$string3$string4$string5$mrun_com \n" >> ${mrun_path}/statistik/mrun_statistik
+# else
+# printf "$string1$string2$string3$string4$string5$mc \n" >> ${mrun_path}/statistik/mrun_statistik
+# fi
+# fi
+ echo " " > /dev/null
+ fi
+
+ if [[ $locat != normal && $locat != control_c && $locat != local_compile ]]
+ then
+
+ # EVENTUELLE ERROR-KOMMANDOS ABARBEITEN
+ (( i = 0 ))
+ while (( i < iec ))
+ do
+ (( i = i + 1 ))
+ printf "\n *** Execution of ERROR-command:\n"
+ printf " >>> ${err_command[$i]}\n"
+ eval ${err_command[$i]}
+ done
+ if [[ -n $interpreted_config_file ]] then
+ rm -rf $interpreted_config_file
+ fi
+ if [[ -n .mrun_environment ]] then
+ rm -rf .mrun_environment
+ fi
+ if [[ $tmpcreate = true ]]
+ then
+ printf "\n *** Contents of \"$TEMPDIR\":\n"
+ ls -al; cd
+ [[ $delete_temporary_catalog = true ]] && rm -rf $TEMPDIR
+ fi
+ if [[ -f ~/job_queue/JOBINFO.$QSUB_REQID ]]
+ then
+ rm -rf ~/job_queue/JOBINFO.$QSUB_REQID
+ fi
+ printf "\n\n+++ MRUN killed \n\n"
+ elif [[ $locat != control_c ]]
+ then
+ printf "\n\n --> all actions finished\n\n"
+ printf " Bye, bye $usern !!\n\n"
+ fi' exit
+
+
+ # BEI TERMINAL-BREAK:
+ trap 'rm -rf $working_directory/tmp_mrun
+ [[ $tmpcreate = true ]] && (cd; rm -rf $TEMPDIR)
+ if [[ -f ~/job_queue/JOBINFO.$QSUB_REQID ]]
+ then
+ rm -rf ~/job_queue/JOBINFO.$QSUB_REQID
+ fi
+ printf "\n+++ MRUN killed by \"^C\" \n\n"
+ locat=control_c
+ exit
+ ' 2
+
+
+ # CHECK IF THE PATH FOR THE PALM BINARIES (SCRIPTS+UTILITY-PROGRAMS) HAS
+ # BEEN SET
+ if [[ "$PALM_BIN" = "" ]]
+ then
+ printf "\n +++ environment variable PALM_BIN has not been set"
+ printf "\n please set it to the directory where the PALM scripts are located"
+ locat=palm_bin; exit
+ fi
+
+
+
+ # SHELLSCRIPT-OPTIONEN EINLESEN UND KOMMANDO NEU ZUSAMMENSETZEN, FALLS ES
+ # FUER FOLGEJOBS BENOETIGT WIRD
+ while getopts :a:AbBc:Cd:D:Fg:G:h:H:i:IkK:m:M:n:o:Op:P:q:r:R:s:St:T:u:U:vxX:Y option
+ do
+ case $option in
+ (a) afname=$OPTARG;;
+ (A) store_on_archive_system=false; mc="$mc -A";;
+ (b) do_batch=true; mc="$mc -b";;
+ (B) delete_temporary_catalog=false; mc="$mc -B";;
+ (c) config_file=$OPTARG; mc="$mc -c$OPTARG";;
+ (C) restart_run=true; mc="$mc -C";;
+ (d) fname=$OPTARG; mc="$mc -d$OPTARG";;
+ (D) cpp_opts="$cpp_opts $OPTARG"; mc="$mc -D$OPTARG";;
+ (F) job_on_file="-D"; mc="$mc -F";;
+ (g) group_number=$OPTARG; mc="$mc -g$OPTARG";;
+ (G) global_revision=$OPTARG; mc="$mc -G'$OPTARG'";;
+ (h) host=$OPTARG; mc="$mc -h$OPTARG";;
+ (H) fromhost=$OPTARG; mc="$mc -H$OPTARG";;
+ (i) input_list=$OPTARG; mc="$mc -i'$OPTARG'";;
+ (I) ignore_archive_error=true; mc="$mc -I";;
+ (k) keep_data_from_previous_run=true; mc="$mc -k";;
+ (K) additional_conditions="$OPTARG"; mc="$mc -K$OPTARG";;
+ (m) memory=$OPTARG; mc="$mc -m$OPTARG";;
+ (M) makefile=$OPTARG; mc="$mc -M$OPTARG";;
+ (n) node_usage=$OPTARG; mc="$mc -n$OPTARG";;
+ (o) output_list=$OPTARG; mc="$mc -o'$OPTARG'";;
+ (O) use_openmp=true; mc="$mc -O";;
+ (p) package_list=$OPTARG; mc="$mc -p'$OPTARG'";;
+ (P) return_password=$OPTARG; mc="$mc -P$OPTARG";;
+ (q) queue=$OPTARG; mc="$mc -q$OPTARG";;
+ (r) run_mode=$OPTARG; mc="$mc -r'$OPTARG'";;
+ (R) remotecall=true;return_addres=$OPTARG; mc="$mc -R$OPTARG";;
+ (s) source_list=$OPTARG; mc="$mc -s'$OPTARG'";;
+ (S) read_from_config=false; mc="$mc -S";;
+ (t) cpumax=$OPTARG; mc="$mc -t$OPTARG";;
+ (T) tasks_per_node=$OPTARG; mc="$mc -T$OPTARG";;
+ (u) remote_username=$OPTARG; mc="$mc -u$OPTARG";;
+ (U) return_username=$OPTARG; mc="$mc -U$OPTARG";;
+ (v) silent=true; mc="$mc -v";;
+ (x) do_trace=true;set -x; mc="$mc -x";;
+ (X) numprocs=$OPTARG; mc="$mc -X$OPTARG";;
+ (Y) run_coupled_model=true; mc="$mc -Y";;
+ (\?) printf "\n +++ unknown option $OPTARG \n"
+ printf "\n --> type \"$0 ?\" for available options \n"
+ locat=parameter;exit;;
+ esac
+ done
+
+
+ # EVTL. POSITIONSPARAMETER EINLESEN
+ # ZUR ZEIT GIBT ES NUR DEN PARAMETER ? (=KURZINFO)
+ shift OPTIND-1
+
+
+ # KURZE AUFRUFBESCHREIBUNG WIRD HIER AUSGEGEBEN
+ if [[ "$1" = "?" ]]
+ then
+ (printf "\n *** mrun can be called as follows:\n"
+ printf "\n $mrun_script_name -b -c.. -d.. -D.. -f.. -F -h.. -i.. -I -K.. -m.. -o.. -p.. -r.. -R -s.. -t.. -T.. -v -x -X.. \n"
+ printf "\n Description of available options:\n"
+ printf "\n Option Description Default-Value"
+ printf "\n -a base name of input files equiv. -d"
+ printf "\n -A no archiving when using file-attribute fl"
+ printf "\n -b batch-job on local machine ---"
+ printf "\n -B do not delete temporary directory at end ---"
+ printf "\n -c configuration file .mrun.config"
+ printf "\n -d base name of files attached to program test"
+ printf "\n -D preprocessor(cpp)-directives \"\" "
+ printf "\n -F create remote job file only ---"
+ printf "\n -h execution host $localhost_realname"
+ printf "\n -i INPUT control list \"\" "
+ printf "\n -I archiving errors of previous batch-jobs"
+ printf "\n will be ignored"
+ printf "\n -k keep data from previous run"
+ printf "\n -K additional conditions for controling"
+ printf "\n usage of conditional code and"
+ printf "\n env-variables in configuration file \"\" "
+ printf "\n -m memory demand in MB (batch-jobs) 0 MB"
+ printf "\n -M Makefile name Makefile"
+ printf "\n -n node usage (shared/not_shared) depending on -h"
+ printf "\n -o OUTPUT control list \"\" "
+ printf "\n -O use OpenMP ---"
+ printf "\n -p software package list \"\" "
+ printf "\n -q queue \"$queue\" "
+ printf "\n -r run control list (combines -i -o) \"\" "
+ printf "\n -s filenames of routines to be compiled \"\" "
+ printf "\n must end with .f, .f90, .F, or .c !"
+ printf "\n use \"..\" for more than one file and wildcards"
+ printf "\n -s TEST compiles all files with w-permit"
+ printf "\n -S config file interpreted by shellscript ---"
+ printf "\n -t allowed cpu-time in seconds (batch) 0"
+ printf "\n -T tasks per node depending on -h"
+ printf "\n -u username on remote machine \"\" "
+ printf "\n -v no prompt for confirmation ---"
+ printf "\n -x tracing of mrun for debug purposes ---"
+ printf "\n -X # of processors (on parallel machines) 1"
+ printf "\n -Y run coupled model ---"
+ printf "\n "
+ printf "\n Possible values of positional parameter :"
+ printf "\n \"?\" - this outline \n\n") | more
+ exit
+ elif [[ "$1" != "" ]]
+ then
+ printf "\n +++ positional parameter $1 unknown \n"
+ locat=parameter; exit
+ fi
+
+
+
+ # KURZE STARTMELDUNG
+ printf "\n*** $version "
+ printf "\n will be executed. Please wait ..."
+
+
+
+ # PRUEFEN, OB KONFIGURATIONS-DATEI VORHANDEN
+ if [[ ! -f $config_file ]]
+ then
+ printf "\n\n +++ configuration file: "
+ printf "\n $config_file"
+ printf "\n does not exist"
+ locat=connect; exit
+ fi
+
+
+ # HOST-IDENTIFIER (local_host) AUS KONFIGURATIONSDATEI BESTIMMEN
+ line=""
+ grep "%host_identifier" $config_file > tmp_mrun
+ while read line
+ do
+ if [[ "$line" != "" || $(echo $line | cut -c1) != "#" ]]
+ then
+ HOSTNAME=`echo $line | cut -d" " -s -f2`
+ host_identifier=`echo $line | cut -d" " -s -f3`
+ if [[ $localhost_realname = $HOSTNAME ]]
+ then
+ localhost=$host_identifier
+ break
+ fi
+ fi
+ done < tmp_mrun
+
+ if [[ "$localhost" = "" ]]
+ then
+ printf "\n\n +++ no host identifier found in configuration file \"$config_file\""
+ printf "\n for local host \"$localhost_realname\"."
+ printf "\n Please add line"
+ printf "\n \"\%host_identifier $localhost_realname \""
+ printf "\n to the configuration file."
+ locat=localhost; exit
+ fi
+
+
+
+ # HOSTSPEZIFISCHE VARIABLEN SETZEN
+ case $localhost_realname in
+ (breg*-en0|berni*-en0) archive_system=tivoli;;
+ (cs*) archive_system=ut;;
+ (fimm.bccs.uib.no) fimm=true;;
+ (gate|n-sx) PATH=$PALM_BIN:$PATH:/usr/bin/nqsII;;
+ (hreg*-en0|hanni*-en0) archive_system=tivoli;;
+ (scirocco) scirocco=true;;
+ esac
+
+
+
+ # BASISNAME DER INPUT-DATEIEN GLEICH ALLGEMEINEM BASISNAMEN SETZEN,
+ # WENN NICHT VOM BENUTZER ANDERS BESTIMMT
+ [[ "$afname" = "" ]] && afname=$fname
+
+
+ # EVTL. RUN-MODUS DEN I/O-LISTEN HINZUFUEGEN
+ if [[ "$run_mode" != "" ]]
+ then
+ input_list="$input_list $run_mode"
+ output_list="$output_list $run_mode"
+ fi
+
+
+ # RECHNERNAMEN ABSPEICHERN, VON DEM AUS JOB GESTARTET WIRD,
+ # ALLERDINGS NUR DANN, WENN NICHT PER OPTION -H BEREITS EIN WERT
+ # ZUGEWIESEN WURDE (MRUN MACHT DIES IMMER, WENN ES SELBST BATCH-JOBS
+ # STARTET)
+ if [[ "$fromhost" = "" ]]
+ then
+ fromhost=$localhost
+ fi
+
+
+ # PRUEFEN, OB MRUN NUR TESTWEISE AUF DER LOKALEN MASCHINE KOMPILIEREN SOLL
+ if [[ "$source_list" = LOCAL_COMPILE_TEST ]]
+ then
+ source_list=TEST
+ local_compile=true
+ host=$localhost
+ fi
+
+
+ # PRUEFEN, OB AUF REMOTE-MASCHINE GERECHNET WERDEN SOLL
+ # WERT VON do_remote WIRD FUER DATEIVERBINDUNGEN BENOETIGT.
+ # WENN AUF REMOTE-MASCHINE GERECHNET WIRD, IST GLEICHZEITIG KLAR,
+ # DASS EIN BATCH-JOB GESTARTET WERDEN MUSS
+ if [[ -n $host && "$host" != $localhost ]]
+ then
+ do_batch=true
+ do_remote=true
+ case $host in
+ (ibm|ibmb|ibmh|ibms|ibmy|nech|neck|lctit|unics) true;;
+ (*) printf "\n"
+ printf "\n +++ sorry: execution of batch jobs on remote host \"$host\""
+ printf "\n is not available"
+ locat=nqs; (( iec = 0 )); exit;;
+ esac
+ else
+ host=$localhost
+ fi
+
+
+ # ZUSATZBEDINGUNGEN (OPTION -K) AUSWERTEN
+ if [[ -n $additional_conditions ]]
+ then
+# echo $additional_conditions | cut -d" " -f1-3 | read cond1 cond2 dummy
+ cond1=`echo $additional_conditions | cut -d" " -f1`
+ cond2=`echo $additional_conditions | cut -d" " -s -f2`
+ dummy=`echo $additional_conditions | cut -d" " -s -f3`
+ if [[ -n $dummy ]]
+ then
+ printf "\n +++ more than 2 additional conditions given for Option \"-K\""
+ locat=options; exit
+ fi
+ fi
+
+
+ # PRUEFEN, OB EVTL. BEI VORHERGEHENDEM LAUF (KETTENJOB) EINE
+ # ARCHIVIERUNG FEHLGESCHLAGEN IST
+ if [[ -f ~/job_queue/ARCHIVE_ERROR_$fname ]]
+ then
+ if [[ $ignore_archive_error = false ]]
+ then
+ printf "\n +++ data archiving of previous run failed"
+ printf "\n see directory \~/job_queue on remote machine"
+ locat=archive; exit
+ else
+ printf "\n +++ warning: data archiving in a previous run failed"
+ printf "\n MRUN continues, trying to get backup copy"
+ fi
+ fi
+
+
+
+ # LESEN UND INTERPRETIEREN DER KONFIGURATIONS-DATEI VOM SHELLSCRIPT AUS
+ # VORUEBERGEHEND ZWINGEND AUF LINUX-RECHNERN
+ if [[ "$read_from_config" = false ]]
+ then
+
+ [[ $silent = false ]] && printf "\n Reading the configuration file... "
+ while read zeile
+ do
+ [[ $silent = false ]] && printf "."
+
+
+ # ZUERST EVENTUELL VORKOMMENDE ENVIRONMENT-VARIABLEN DURCH IHRE WERTE
+ # ERSETZEN
+ eval zeile=\"$zeile\"
+
+
+ # INTERPRETATION DER ZEILE
+ if [[ "$(echo $zeile)" = "" ]]
+ then
+ # LEERZEILE, KEINE AKTION
+ continue
+
+ elif [[ "$(echo $zeile | cut -c1)" = "#" ]]
+ then
+
+ # ZEILE IST KOMMENTARZEILE
+ true
+
+ elif [[ "$(echo $zeile | cut -c1)" = "%" ]]
+ then
+
+ # ZEILE DEFINIERT ENVIRONMENT-VARIABLE
+ zeile=$(echo $zeile | cut -c2-)
+# echo $zeile | cut -d" " -f1-5 | read var value for_host for_cond1 for_cond2
+ var=`echo $zeile | cut -d" " -f1`
+ value=`echo $zeile | cut -d" " -s -f2`
+ for_host=`echo $zeile | cut -d" " -s -f3`
+ for_cond1=`echo $zeile | cut -d" " -s -f4`
+ for_cond2=`echo $zeile | cut -d" " -s -f5`
+
+ if [[ "$for_host" = "" || ( "$for_host" = $host && "$for_cond1" = "$cond1" && "$for_cond2" = "$cond2" ) || $(echo "$input_list$output_list"|grep -c "$for_host") != 0 ]]
+ then
+
+ # BEI COMPILER- CPP- ODER LINKEROPTIONEN EVTL ":" DURCH " "
+ # ERSETZEN. "::" WIRD DURCH ":" ERSETZT.
+ value=`echo $value | sed 's/::/%DUM%/g' | sed 's/:/ /g' | sed 's/%DUM%/:/g'`
+
+
+ # ENVIRONMENT-VARIABLE WIRD WERT AUS KONFIGURATIONSDATEI
+ # ZUGEWIESEN, WENN SIE SELBST NOCH KEINEN WERT UEBER DIE
+ # ENTSPRECHENDE SCRIPT-OPTION ERHALTEN HAT. SOLCHE
+ # VARIABLEN HAETTEN DANN DEN WERT "" ODER IM INTEGER-FALL DEN
+ # WERT 0. ALLGEMEINE REGEL ALSO: SCRIPT-OPTION GEHT UEBER
+ # KONFIGURATIONSDATEI
+ if [[ "$(eval echo \$$var)" = "" || "$(eval echo \$$var)" = "0" ]]
+ then
+ eval $var=\$value
+
+ # EVTL. BILDSCHIRMAUSGABEN DER ENVIRONMENT-VARIABLEN
+ if [[ $do_trace = true ]]
+ then
+ printf "\n*** ENVIRONMENT-VARIABLE $var = $value"
+ fi
+ fi
+
+ # WENN ENVIRONMENT-VARIABLE HOST VEREINBART, DANN SOFORT AUSWERTEN
+ # WERT VON do-remote WIRD BEI DATEIVERBINDUNGEN BENOETIGT
+ # WENN AUF REMOTE-MASCHINE GERECHNET WIRD, IST GLEICHZEITIG KLAR,
+ # DASS EIN BATCH-JOB GESTARTET WERDEN MUSS
+ if [[ $var = host ]]
+ then
+ if [[ -n $host && "$host" != $localhost ]]
+ then
+ do_batch=true
+ do_remote=true
+ case $host in
+ (ibm|ibms|ibmy|lctit|nech|neck|unics) true;;
+ (*) printf "\n +++ sorry: execution of batch jobs on remote host \"$host\""
+ printf "\n is not available"
+ locat=nqs; exit;;
+ esac
+ else
+ host=$localhost
+ fi
+ fi
+
+ # VOM BENUTZER DEFINIERTE ENVIRONMENT VARIABLEN MUESSEN PRINZIPIELL
+ # EXPORTIERT WERDEN, DA SIE VIELLEICHT IN WEITER UNTEN AUFZURUFEN-
+ # DEN PROGRAMMEN BENOETIGT WERDEN
+ export $var
+ fi
+
+
+
+
+ elif [[ "$(echo $zeile | cut -c1-3)" = "EC:" ]]
+ then
+
+ # ZEILE DEFINIERT ERROR-KOMMANDO
+ (( iec = iec + 1 ))
+ zeile=$(echo $zeile | cut -c4-)
+ err_command[$iec]="$zeile"
+
+ elif [[ "$(echo $zeile | cut -c1-3)" = "IC:" ]]
+ then
+
+ # ZEILE DEFINIERT INPUT-KOMMANDO
+ (( iic = iic + 1 ))
+ zeile=$(echo $zeile | cut -c4-)
+ in_command[$iic]="$zeile"
+
+ elif [[ "$(echo $zeile | cut -c1-3)" = "OC:" ]]
+ then
+
+ # ZEILE DEFINIERT OUTPUT-KOMMANDO
+ (( ioc = ioc + 1 ))
+ zeile=$(echo $zeile | cut -c4-)
+ out_command[$ioc]="$zeile"
+
+ else
+
+ # ZEILE DEFINIERT DATEIVERBINDUNG. EINLESEN DER DATEIEIGENSCHAFTEN
+ # s2a: in/out - Feld
+ # s2b: loc - Feld (optional)
+ # s2c: tr/ar - Feld (optional)
+# echo $zeile | cut -d" " -f1-2 | read s1 s2
+ s1=`echo $zeile | cut -d" " -f1`
+ s2=`echo $zeile | cut -d" " -s -f2`
+ s2a=$(echo $s2 | cut -d":" -f1)
+ if [[ $(echo $s2 | grep -c ":") = 0 ]]
+ then
+ s2b=""
+ s2c=""
+ else
+# echo $s2 | cut -d":" -f2-3 | sed 's/:/ /g' | read s2b s2c
+ s2b=`echo $s2 | cut -d":" -f2 | sed 's/:/ /g'`
+ s2c=`echo $s2 | cut -d":" -s -f3 | sed 's/:/ /g'`
+ fi
+# echo $zeile | cut -d" " -f3-6 | read s3 s4 s5 s6
+ s3=`echo $zeile | cut -d" " -f3`
+ s4=`echo $zeile | cut -d" " -s -f4`
+ s5=`echo $zeile | cut -d" " -s -f5`
+ s6=`echo $zeile | cut -d" " -s -f6`
+
+
+ # ABSPEICHERN DER DATEIVERBINDUNG, FALLS IN INPUT- ODER OUTPUT-LIST
+ # VERMERKT. VARIABLE S3 KANN AUCH LISTE ENTHALTEN (FELDTRENNER ":")
+ # DATEIVERBINDUNG WIRD DANN NICHT ABGESPEICHERT UND GEPRUEFT, WENN
+ # PROGRAMMLAUF AUF REMOTE-MASCHINE ERFOLGT UND DATEI NUR LOKAL VOR-
+ # HANDEN SEIN MUSS (D.H. s2b = loc)
+ IFSALT="$IFS"; IFS="$IFS:"
+ if [[ "$s2a" = in && ! ( $do_remote = true && ( "$s2b" = loc || "$s2b" = locopt ) ) ]]
+ then
+ found=false
+ for actual in $input_list
+ do
+ for formal in $s3
+ do
+ [[ $actual = $formal || "$formal" = "-" ]] && found=true
+ done
+ done
+ if [[ $found = true ]]
+ then
+ (( iin = iin + 1 ))
+ localin[$iin]=$s1; transin[$iin]=$s2b; actionin[$iin]=$s2c;
+ typein[$iin]=$s3; pathin[$iin]=$s4; endin[$iin]=$s5;
+ extin[$iin]=$s6
+ fi
+ elif [[ "$s2a" = out && ! ( $do_remote = true && "$s2b" = loc ) ]]
+ then
+ found=false
+ for actual in $output_list
+ do
+ for formal in $s3
+ do
+ [[ $actual = $formal || "$formal" = "-" ]] && found=true
+ done
+ done
+ if [[ $found = true ]]
+ then
+ (( iout = iout + 1 ))
+ localout[$iout]=$s1; actionout[$iout]=$s2c; typeout[$iout]=$s3;
+ pathout[$iout]=$s4; endout[$iout]=$s5; extout[$iout]=$s6
+ fi
+ elif [[ "$s2a" != in && "$s2a" != out ]]
+ then
+ printf "\n +++ I/O-attribute in configuration file $config_file has the invalid"
+ printf "\n value \"$s2\". Only \"in\" and \"out\" are allowed!"
+ locat=connect; exit
+ fi
+ IFS="$IFSALT"
+ fi
+ done < $config_file
+
+ else
+
+
+ # INTERPRETATION DER KONFIGURATIONSDATEI MITTELS FORTRAN 90 - PROGRAMM
+ [[ $silent = false ]] && printf "..."
+ export cond1 cond2 config_file do_remote do_trace input_list localhost output_list
+ export interpreted_config_file=.icf.$RANDOM
+
+
+
+ # ENVIRONMENT-VARIABLEN FUER INTERPRET_CONFIG UEBER NAMELIST_DATEI ZUR
+ # VERFUEGUNG STELLEN
+ cat > .mrun_environment << %%END%%
+ &mrun_environment cond1 = '$cond1', cond2 = '$cond2',
+ config_file = '$config_file', do_remote = '$do_remote',
+ do_trace = '$do_trace', host = '$host',
+ input_list = '$input_list', icf = '$interpreted_config_file',
+ localhost = '$localhost', output_list = '$output_list' /
+
+%%END%%
+
+ # WERTE VON MRUN-OPTIONEN SICHERN UND DAMIT GEGEBENENFALLS SPAETER DIE
+ # IN DER KONFIGURAIONSDATEI ANGEGEBENEN WERTE UEBERSTEUERN
+ mrun_memory=$memory
+ mrun_group_number=$group_number
+ mrun_cpumax=$cpumax
+ mrun_numprocs=$numprocs
+
+ if [[ $localhost_realname = "gate" ]]
+ then
+ interpret_config_gate.x
+ else
+ interpret_config.x
+ fi
+ rm .mrun_environment
+
+
+ # AUSFUEHRUNG DER GENERIERTEN SHELL-KOMMANDOS IN DIESER SHELL
+ chmod u+x $interpreted_config_file
+ export PATH=$PATH:.
+ . $interpreted_config_file
+ rm $interpreted_config_file
+
+
+ # OPTIONSWERTE UEBERSTEUERN KONFIGURATIONSDATEI
+ [[ $mrun_memory != 0 ]] && memory=$mrun_memory
+ [[ "$mrun_group_number" != "none" ]] && group_number=$mrun_group_number
+ [[ $mrun_cpumax != 0 ]] && cpumax=$mrun_cpumax
+ [[ "$mrun_numprocs" != "" ]] && numprocs=$mrun_numprocs
+
+ fi
+
+
+ # QUELLTEXTVERZEICHNIS AUF LOKALER MASCHINE AUS KONFIGURATIONSDATEI
+ # BESTIMMEN (WUERDE SONST EVTL. DAS VERZEICHNIS DES JEWEILS UNTER -h
+ # ANGEGEBENEN REMOTE-RECHNERS SEIN)
+ # BEI BATCH-JOBS SIND DIE ZU UEBERSETZENDEN PROGRAMMTEILE SCHON KOMPLETT
+ if [[ "$SOURCES_COMPLETE" = "" ]]
+ then
+
+ # ZUERST PRUEFEN, OB EIN GLOBALER QUELLTEXTPFAD FUER ALLE RECHNER
+ # VEREINBART WURDE
+ source_path=""
+ line=""
+ grep "%source_path" $config_file > tmp_mrun
+ while read line
+ do
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ if [[ "$(echo $line | cut -d" " -f3)" = "" ]]
+ then
+ global_source_path=`echo $line | cut -d" " -f2`
+ fi
+ fi
+ done < tmp_mrun
+
+ line=""
+ found=false
+ grep " $localhost" $config_file | grep "%source_path" > tmp_mrun
+ while read line
+ do
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ if [[ $found = true ]]
+ then
+ printf "\n\n +++ more than one source path found in configuration file"
+ printf "\n for local host \"$localhost\" "
+ locat=source_path; exit
+ fi
+ source_path=`echo $line | cut -d" " -f2`
+ found=true
+ fi
+ done < tmp_mrun
+ rm tmp_mrun
+
+ if [[ "$source_path" = "" ]]
+ then
+ if [[ "$global_source_path" != "" ]]
+ then
+ source_path=$global_source_path
+ else
+ printf "\n\n +++ no source path found in configuration file"
+ printf "\n for local host \"$localhost\" "
+ locat=source_path; exit
+ fi
+ fi
+ eval source_path=$source_path
+
+ if [[ ! -d $source_path ]]
+ then
+ printf "\n\n +++ source path \"$source_path\" on local host"
+ printf "\n \"$localhost\" does not exist"
+ locat=source_path; exit
+ fi
+
+ fi
+
+
+ # GLOBALE REVISIONSNUMMER ERMITTELN (FORTSETZUNGSLAEUFEN WIRD DIESE
+ # DURCH OPTION -G MITGETEILT)
+ if [[ "$global_revision" = "" ]]
+ then
+ global_revision=`svnversion $source_path 2>/dev/null`
+ global_revision="Rev: $global_revision"
+ fi
+
+
+ # NOCHMAL PRUEFEN, OB AUF REMOTE-MASCHINE GERECHNET WERDEN SOLL
+ # (HOST KANN IN KONFIGURATIONSDATEI ANDERS FESTGELEGT WORDEN SEIN)
+ # WERT VON do_remote WIRD FUER DATEIVERBINDUNGEN BENOETIGT.
+ # WENN AUF REMOTE-MASCHINE GERECHNET WIRD, IST GLEICHZEITIG KLAR,
+ # DASS EIN BATCH-JOB GESTARTET WERDEN MUSS
+ if [[ -n $host && "$host" != $localhost ]]
+ then
+ do_batch=true
+ do_remote=true
+ case $host in
+ (ibm|ibmb|ibmh|ibms|ibmy|lctit|nech|neck|unics) true;;
+ (*) printf "\n"
+ printf "\n +++ sorry: execution of batch jobs on remote host \"$host\""
+ printf "\n is not available"
+ locat=nqs; (( iec = 0 )); exit;;
+ esac
+ else
+ host=$localhost
+ fi
+
+
+ # PRUEFUNG EINIGER PROZESSORZAHLANGABEN BEI RECHNUNGEN AUF PARALLELRECHNERN
+ if [[ "$cond1" = parallel || "$cond2" = parallel ]]
+ then
+
+ # PRUEFEN, OB DIE ANZAHL DER ZU VERWENDENDEN PES ANGEGEBEN WURDE
+ if [[ ! -n $numprocs ]]
+ then
+ printf "\n"
+ printf "\n +++ option \"-K parallel\" requires additional specification"
+ printf "\n of the number of processors to be used by"
+ printf "\n mrun-option \"-X\" or by environment-variable"
+ printf "\n \"numprocs\" in the configuration file"
+ locat=numprocs; (( iec = 0 )); exit
+ fi
+
+ # PRUEFEN, OB DIE PROZESSORANZAHL PRO KNOTEN ANGEGEBEN WURDE (GGF.
+ # DEFAULT-WERT SETZEN) UND OB SIE EIN GANZZAHLIGER TEILER DER
+ # GESAMTPROZESSORANZAHL IST
+ if [[ $host = nech || $host = neck || $host = ibmh || $host = ibmb || $host = ibms ]]
+ then
+ [[ "$tasks_per_node" = "" ]] && tasks_per_node=6
+ (( ival = $tasks_per_node ))
+ (( pes = numprocs ))
+# if [[ $(echo $package_list | grep -c dvrp_graphics+1PE) = 1 ]]
+# then
+# (( pes = pes - 1 ))
+# fi
+ (( ii = pes / ival ))
+ if (( pes - ii * ival > 0 ))
+ then
+ printf "\n"
+ printf "\n +++ tasks per node (option \"-T\") must be an integral"
+ printf "\n divisor of the total number of processors (option \"-X\")"
+ printf "\n values of this mrun-call: \"-T $tasks_per_node\" \"-X $numprocs\""
+ locat=tasks_per_node; (( iec = 0 )); exit
+ fi
+ fi
+
+ # IBMY HAT NUR EINEN KNOTEN
+ if [[ $host = ibmy ]]
+ then
+ if [[ "$tasks_per_node" != "" && "$tasks_per_node" != "$numprocs" ]]
+ then
+ printf "\n"
+ printf "\n +++ on ibmy, tasks per node (option \"-T\") must be equal to the"
+ printf "\n total number of processors (option \"-X\")"
+ printf "\n values of this mrun-call: \"-T $tasks_per_node\" \"-X $numprocs\""
+ locat=tasks_per_node; (( iec = 0 )); exit
+ fi
+ fi
+
+ # FALLS OPENMP PARALLELISIERUNG VERWENDET WERDEN SOLL, ANZAHL VON THREADS
+ # SETZEN UND ZAHL DER TASKS PRO KNOTEN AUF 1 SETZEN
+ if [[ $use_openmp = true ]]
+ then
+ threads_per_task=$tasks_per_node
+ tasks_per_node=1
+ fi
+ OOPT="-O $threads_per_task"
+ TOPT="-T $tasks_per_node"
+
+ # GESAMTZAHL DER KNOTEN BESTIMMEN
+ if [[ "$tasks_per_node" != "" ]]
+ then
+ (( nodes = numprocs / ( tasks_per_node * threads_per_task ) ))
+ fi
+
+ # PRUEFEN, OB NODE USAGE EINEN ERLAUBTEN WERT HAT BZW. DEN DEFAULT
+ # SETZEN
+ if [[ $node_usage = default ]]
+ then
+ if [[ $host = ibms ]]
+ then
+ node_usage=shared
+ elif [[ $host = lctit ]]
+ then
+ node_usage=sla3
+ else
+ node_usage=not_shared
+ fi
+ fi
+ if [[ $node_usage != shared && $node_usage != not_shared && "$(echo $node_usage | cut -c1-3)" != "sla" && $node_usage != novice ]]
+ then
+ printf "\n"
+ printf "\n +++ node usage (option \"-n\") is only allowed to be set"
+ printf "\n \"shared\" or \"not_shared\""
+ locat=tasks_per_node; (( iec = 0 )); exit
+ fi
+
+ fi
+
+ # PRUEFEN, OB HOSTFILE EXISTIERT
+ if [[ -n $hostfile ]]
+ then
+ if [[ ! -f $hostfile ]]
+ then
+ printf "\n"
+ printf "\n +++ hostfile \"$hostfile\" does not exist"
+ locat=hostfile; exit
+ fi
+ fi
+
+ # PRUEFEN, OB RHOSTS DATEI EXISTIERT. GEGEBENENFALLS ANLEGEN BZW. ERWEITERN
+ if [[ $host = ibmy && $do_remote = false ]]
+ then
+ if [[ ! -f $HOME/.rhosts ]]
+ then
+ echo "gfdl5.yonsei.ac.kr" > $HOME/.rhosts
+ printf "\n\n *** file:"
+ printf "\n $HOME/.rhosts"
+ printf "\n was created\n"
+ fi
+ if [[ $(grep -c gfdl5.yonsei.ac.kr $HOME/.rhosts) = 0 ]]
+ then
+ echo "gfdl5.yonsei.ac.kr" >> $HOME/.rhosts
+ printf "\n\n *** file:"
+ printf "\n $HOME/.rhosts"
+ printf "\n was extended by the name of the current host\n"
+ fi
+ fi
+
+
+
+ # FALLS NICHT VORGEGEBEN, DEFAULT-QUEUE AUF DER ZIELMASCHINE FESTLEGEN
+ if [[ $queue = none ]]
+ then
+ case $host in
+ (ibmb) if [[ $node_usage = shared ]]
+ then
+ queue=cshare
+ else
+ queue=csolo
+ fi;;
+ (ibmh) if [[ $node_usage = shared ]]
+ then
+ queue=cshare
+ else
+ queue=csolo
+ fi;;
+ (ibmy) queue=parallel;;
+ (lctit) queue=sla3;;
+ (nech) queue=none;;
+ (neck) queue=P;;
+ (unics) queue=unics;;
+ esac
+ fi
+
+
+ # VOLLSTAENDIGE DATEINAMEN DER INPUT-FILES BILDEN,
+ # INPUT-DATEIEN AUF VORHANDENSEIN PRUEFEN UND EVTL. HOECHSTE ZYKLUSNUMMER
+ # ERMITTELN
+ (( i = 0 ))
+ while (( i < iin ))
+ do
+ (( i = i + 1 ))
+ (( maxcycle = 0 ))
+
+ # NAMENSBILDUNG (EVTL. IST FESTER DATEINAME VORGEGEBEN)
+ if [[ "${actionin[$i]}" = di ]]
+ then
+ remotepathin[$i]=${pathin[$i]}/${endin[$i]} # REMOTE-PFAD ERST AUF
+ # REM-MASCHINE AUSWERTEN
+ eval filename=${pathin[$i]}/${endin[$i]}
+ else
+ remotepathin[$i]=${pathin[$i]}/${afname}${endin[$i]} # REMOTE-PFAD ERST AUF
+ # REM-MASCHINE AUSWERTEN
+ eval filename=${pathin[$i]}/${afname}${endin[$i]}
+ fi
+
+ # PRUEFEN AUF VORHANDENSEIN
+ if [[ $(ls $filename* 2>&1 | grep -c "not found") = 1 || \
+ $(ls $filename* 2>&1 | grep -c "No such file") = 1 || \
+ $(ls $filename* 2>&1 | grep -c "does not exist") = 1 ]]
+ then
+ # DATEIEN MIT EXTENSION (Z.B. NC) MUESSEN NICHT ZWINGEND VORHANDEN
+ # SEIN, DESHALB IN SOLCHEN FAELLEN KEIN ABBRUCH. DIES IST NUR EINE
+ # VORUEBERGEHENDE LOESUNG (OKT 05). NICHT ZWINGEND BENOETIGTE
+ # EINGABEDATEIEN SOLLTEN EINE SPEZIELLE OPTION IN DER DATEI-
+ # VERBINDUNGSANWEISUNG BEKOMMEN (Z.B. inopt?)
+ if [[ "${transin[$i]}" != "locopt" ]]
+ then
+ printf "\n\n +++ INPUT-file: "
+ if [[ "${extin[$i]}" = "" ]]
+ then
+ printf "\n $filename"
+ else
+ printf "\n $filename.${extin[$i]}"
+ fi
+ printf "\n does not exist\n"
+ locat=input; exit
+ else
+ transin[$i]="unavailable"
+ fi
+ else
+
+ # ZYKLUSNUMMER FESTSTELLEN
+ ls -1 -d $filename > filelist 2>/dev/null
+ ls -1 -d $filename.* >> filelist 2>/dev/null
+ while read zeile
+ do
+ cycle=$(print $zeile | cut -f2 -d".")
+ if [[ "$cycle" = "$zeile" ]]
+ then
+ (( icycle = 0 ))
+ elif [[ "$cycle" = "${extin[$i]}" ]]
+ then
+ (( icycle = 0 ))
+ else
+ (( icycle = $cycle ))
+ fi
+ if (( icycle > maxcycle ))
+ then
+ (( maxcycle = icycle ))
+ file_to_be_used=$zeile
+ fi
+ done 0 ))
+ then
+ if [[ "${extin[$i]}" != " " && "${extin[$i]}" != "" ]]
+ then
+ filename=${filename}.$maxcycle.${extin[$i]}
+ else
+ filename=${filename}.$maxcycle
+ fi
+ else
+ if [[ "${extin[$i]}" != " " && "${extin[$i]}" != "" ]]
+ then
+ filename=${filename}.${extin[$i]}
+ fi
+ fi
+
+ # DATEINAMEN OHNE PFAD ABER MIT ZYKLUSNUMMER ABSPEICHERN,
+ # DA SPAETER BEI RUECKSPEICHERN VOM ARCHIVSYSTEM EVTL. BENOETIGT
+ absnamein[$i]=$filename
+ if (( maxcycle > 0 ))
+ then
+ if [[ "${actionin[$i]}" = di ]]
+ then
+ frelin[$i]=${endin[$i]}.$maxcycle
+ else
+ frelin[$i]=${afname}${endin[$i]}.$maxcycle
+ fi
+ else
+ if [[ "${actionin[$i]}" = di ]]
+ then
+ frelin[$i]=${endin[$i]}
+ else
+ frelin[$i]=${afname}${endin[$i]}
+ fi
+ fi
+
+ fi
+ done
+
+
+ # VOLLSTAENDIGE DATEINAMEN (OHNE $ ODER ~) DER OUTPUT-FILES BILDEN,
+ # OUTPUT-DATEIEN AUF VORHANDENSEIN PRUEFEN UND EVTL. HOECHSTE ZYKLUSNUMMER
+ # ERMITTELN ODER, FALLS NICHT VORHANDEN, PRUEFEN, OB SIE SICH ANLEGEN LASSEN
+ # DIESE AKTIONEN FINDEN NICHT STATT, WENN PROGRAMM AUF REMOTE-MASCHINE
+ # RECHNET UND DATEI ANSCHLIESSEND TRANSFERIERT WERDEN SOLL!
+ (( i = 0 ))
+ while (( i < iout ))
+ do
+ (( i = i + 1 ))
+ if [[ ! ( $fromhost != $localhost && ( "${actionout[$i]}" = tr || "${actionout[$i]}" = tra || "${actionout[$i]}" = trpe ) ) ]]
+ then
+ if [[ "${actionout[$i]}" = tr || "${actionout[$i]}" = trpe ]]
+ then
+ actionout[$i]=""
+ elif [[ "${actionout[$i]}" = tra ]]
+ then
+ actionout[$i]=a
+ fi
+ (( maxcycle = 0 ))
+ eval filename=${pathout[$i]}/${fname}${endout[$i]}
+ eval catalogname=${pathout[$i]}
+ if [[ $(ls $filename* 2>&1 | grep -c "not found") = 1 || \
+ $(ls $filename* 2>&1 | grep -c "No such file") = 1 || \
+ $(ls $filename* 2>&1 | grep -c "does not exist") = 1 ]]
+ then
+
+ # OUTPUT-DATEI NICHT VORHANDEN. PRUEFEN, OB ANLEGEN MOEGLICH.
+ if cat /dev/null > $filename
+ then
+ rm $filename
+ else
+
+ # PRUEFEN, OB KATALOG VORHANDEN UND EVTL. DIESEN ANLEGEN
+ if [[ ! -d $catalogname ]]
+ then
+ if mkdir -p $catalogname
+ then
+ printf "\n\n *** directory:"
+ printf "\n $catalogname"
+ printf "\n was created\n"
+ else
+ printf "\n\n +++ OUTPUT-file:"
+ printf "\n $filename"
+ printf "\n cannot be created, because directory does not exist"
+ printf "\n and cannot be created either"
+ printf "\n"
+ locat=output ; exit
+ fi 2>/dev/null
+ else
+ printf "\n\n +++ OUTPUT-file:"
+ printf "\n $filename"
+ printf "\n cannot be created, although directory exists"
+ printf "\n"
+ locat=output ; exit
+ fi
+ fi 2>/dev/null
+ else
+
+ # ZYKLUSNUMMER FESTSTELLEN
+ ls -1 -d $filename > filelist 2>/dev/null
+ ls -1 -d $filename.* >> filelist 2>/dev/null
+ while read zeile
+ do
+ cycle=$(print $zeile | cut -f2 -d".")
+ if [[ "$cycle" = "$zeile" || "$cycle" = ${extout[$i]} ]]
+ then
+ (( icycle = 1 ))
+ else
+ (( icycle = $cycle + 1 ))
+ fi
+ if (( icycle > maxcycle ))
+ then
+ (( maxcycle = icycle ))
+ fi
+ done 0 ))
+ then
+ filename=${filename}.$maxcycle
+ if cat /dev/null > $filename
+ then
+ rm $filename
+ else
+ printf "\n +++ OUTPUT-file:"
+ printf "\n $filename"
+ printf "\n cannot be created"
+ locat=output ; exit
+ fi
+ fi
+ else
+ (( maxcycle = maxcycle - 1 ))
+ if (( maxcycle > 0 ))
+ then
+ filename=${filename}.$maxcycle
+ fi
+ fi
+
+ # DATEINAMEN OHNE PFAD ABER MIT ZYKLUSNUMMER ABSPEICHERN,
+ # DA SPAETER BEI ABLAGE AUF ARCHIVSYSTEM BZW. FUER
+ # DATEI OUTPUT_FILE_CONNECTIONS EVTL. BENOETIGT
+ pathout[$i]=$filename
+ if (( maxcycle > 0 ))
+ then
+ frelout[$i]=${fname}${endout[$i]}.$maxcycle
+ else
+ frelout[$i]=${fname}${endout[$i]}
+ fi
+
+ fi
+ done
+
+
+ # DAS DVRP-PAKET ERFORDERT EINE ENTSPRECHENDE BIBLIOTHEK
+ if [[ $(echo $package_list | grep -c dvrp_graphics) != 0 ]]
+ then
+ if [[ "$dvrp_inc" = "" ]]
+ then
+ printf "\n\n +++ no value for \"dvrp_inc\" given in configuration file"
+ printf "\n This is required for the dvrp_graphics package.\n"
+ locat=dvrp; exit
+ fi
+ if [[ "$dvrp_lib" = "" ]]
+ then
+ printf "\n\n +++ no value for \"dvrp_lib\" given in configuration file"
+ printf "\n This is required for the dvrp_graphics package.\n"
+ locat=dvrp; exit
+ fi
+ fi
+
+
+ # PRUEFEN, OB ENTWEDER HAUPTPROGRAMM ODER NUR EIN AUSFUEHRBARES
+ # PROGRAMM VEREINBART WURDE (IN DIESEM FALL BRAUCHT IM WEITEREN NICHT
+ # UEBERSETZT ZU WERDEN)
+ if [[ "$mainprog" = "" && "$executable" = "" ]]
+ then
+ printf "\n +++ neither main program nor executable defined"
+ locat=source; exit
+ elif [[ "$mainprog" != "" && "$executable" != "" ]]
+ then
+ printf "\n +++ main program as well as executable defined"
+ locat=source; exit
+ elif [[ "$mainprog" = "" && "$executable" != "" ]]
+ then
+ do_compile=false
+ fi
+
+
+ # ALLE ZU UEBERSETZENDEN PROGRAMMTEILE ZUSAMMENSAMMELN
+ # BEI BATCH-JOBS IST DIES NICHT NOETIG, WEIL DIE PROGRAMMTEILE BEREITS DURCH
+ # DEN MRUN-AUFRUF ERMITTELT SIND, DER DEN BATCH-JOB GENERIERT HAT, UND
+ # IM VERZEICHNIS SOURCES_FOR_RUN_... ABGELEGT SIND
+ if [[ $do_compile = true && "$SOURCES_COMPLETE" = "" ]]
+ then
+
+ [[ "$source_list" = LM ]] && source_list=LOCALLY_MODIFIED
+ [[ "$source_list" = WP ]] && source_list=WRITE_PERMIT
+
+ if [[ $restart_run != true ]]
+ then
+ rm -rf SOURCES_FOR_RUN_$fname
+ mkdir SOURCES_FOR_RUN_$fname
+ fi
+
+
+ # EVTL. ZU UEBERSETZENDE PROGRAMMTEILE DADURCH BESTIMMEN, DASS GEPRUEFT
+ # WIRD, WELCHE DATEIEN WRITE-PERMIT BESITZEN (DATEIEN SOLLTEN DESHALB
+ # UNTER RCS-KONTROLLE STEHEN). MIT DER VARIABLEN EXCLUDE KOENNEN
+ # BESTIMMTE DATEIEN GRUNDSAETZLICH VON DER UEBERSETZUNG AUSGESCHLOSSEN
+ # WERDEN. DIES IST NUR BEI MANUELLEM START VON MRUN DURCH DEN BENUTZER
+ # MOEGLICH, DA BEI AUTOMATISCHEN RESTARTS TEST DURCH DIE TATSAECHLICH
+ # ZU UBERSETZENDEN DATEIEN ERSETZT IST.
+ # ALLE ERMITTELTEN DATEIEN WERDEN IM VERZEICHNIS SOURCES_FOR_RUN_...
+ # GESAMMELT
+ if [[ "$source_list" = WRITE_PERMIT ]]
+ then
+
+ source_list=""
+ cd $source_path
+
+
+ # ALLE MOEGLICHEN QUELLCODEDATEIEN AUFLISTEN
+ Names=$(ls -1 *.f90 2>&1)
+ [[ $(echo $Names | grep -c '*.f90') = 0 ]] && Filenames="$Names"
+ Names=$(ls -1 *.F90 2>&1)
+ [[ $(echo $Names | grep -c '*.F90') = 0 ]] && Filenames="$Filenames $Names"
+ Names=$(ls -1 *.F 2>&1)
+ [[ $(echo $Names | grep -c '*.F') = 0 ]] && Filenames="$Filenames $Names"
+ Names=$(ls -1 *.f 2>&1)
+ [[ $(echo $Names | grep -c '*.f') = 0 ]] && Filenames="$Filenames $Names"
+ Names=$(ls -1 *.c 2>&1)
+ [[ $(echo $Names | grep -c '*.c') = 0 ]] && Filenames="$Filenames $Names"
+
+
+ # DATEIEN MIT WRITE-PERMIT NACH SOURCES_FOR_RUN_... KOPIEREN
+ for dateiname in $Filenames
+ do
+ if [[ -w $dateiname ]]
+ then
+ if [[ "$exclude" = "" || $(echo $exclude | grep -c $dateiname) = 0 ]]
+ then
+ cp $dateiname $working_directory/SOURCES_FOR_RUN_$fname
+ source_list=$source_list"$dateiname "
+ fi
+ fi
+ done
+
+ cd - > /dev/null
+
+
+ elif [[ "$source_list" = LOCALLY_MODIFIED ]]
+ then
+
+ # MODIFIZIERTE DATEIEN DER SVN-ARBEITSKOPIE BESTIMMEN
+ source_list=""
+ cd $source_path
+
+
+ # PRUEFEN, OB VERZEICHNIS UEBERHAUPT UNTER SVN-KONTROLLE STEHT
+ if [[ ! -d .svn ]]
+ then
+ printf "\n\n +++ source directory"
+ printf "\n \"$source_path\" "
+ printf "\n is not under control of \"subversion\"."
+ printf "\n Please do not use mrun-option \"-s LOCALLY MODIFIED\"\n"
+ fi
+
+
+ # ALLE MODIFIZIERTEN QUELLCODEDATEIEN AUFLISTEN
+ Filenames=""
+ svn status > tmp_mrun
+ while read line
+ do
+ firstc=`echo $line | cut -c1`
+ if [[ $firstc = M || $firstc = "?" ]]
+ then
+ Name=`echo "$line" | cut -c8-`
+ extension=`echo $Name | cut -d. -f2`
+ if [[ "$extension" = f90 || "$extension" = F90 || "$extension" = f || "$extension" = F || "$extension" = c ]]
+ then
+ Filenames="$Filenames "$Name
+ fi
+ fi
+ done < tmp_mrun
+
+
+ # DATEIEN NACH SOURCES_FOR_RUN_... KOPIEREN
+ for dateiname in $Filenames
+ do
+ cp $dateiname $working_directory/SOURCES_FOR_RUN_$fname
+ source_list=$source_list"$dateiname "
+ done
+
+ cd - > /dev/null
+
+
+ # MITTELS OPTION -s ANGEGEBENE DATEIEN NACH SOURCES_FOR_RUN_... KOPIEREN
+ # BEI AUTOMATISCHEN FORTSETZUNGSLAEUFEN SIND DORT SCHON ALLE DATEIEN
+ # VORHANDEN
+ elif [[ "$source_list" != "" && $restart_run != true ]]
+ then
+
+ cd $source_path
+
+ for filename in $source_list
+ do
+
+ # QUELLTEXT-DATEI DARF KEINE PFADE BEINHALTEN
+ if [[ $(print $filename | grep -c "/") != 0 ]]
+ then
+ printf "\n +++ source code file: $filename"
+ printf "\n must not contain (\"/\") "
+ locat=source; exit
+ fi
+
+ if [[ ! -f $filename ]]
+ then
+ printf "\n +++ source code file: $filename"
+ printf "\n does not exist"
+ locat=source; exit
+ else
+ cp $filename $working_directory/SOURCES_FOR_RUN_$fname
+ fi
+
+ done
+
+ cd - > /dev/null
+
+ fi
+
+
+ # PRUEFEN, OB ENTWEDER HAUPTPROGRAMM VORHANDEN UND ES EVTL. IN DER
+ # LISTE DER ZU UEBERSETZENDEN PROGRAMMTEILE MIT ENTHALTEN IST (WENN
+ # NICHT, WIRD ES DIESER LISTE HINZUGEFUEGT)
+ if [[ $restart_run != true ]]
+ then
+
+ if [[ ! -f "$source_path/$mainprog" ]]
+ then
+ printf "\n\n +++ main program: $mainprog"
+ printf "\n does not exist in source directory"
+ printf "\n \"$source_path\"\n"
+ locat=source; exit
+ else
+ if [[ $(echo $source_list | grep -c $mainprog) = 0 ]]
+ then
+ cp $source_path/$mainprog SOURCES_FOR_RUN_$fname
+ source_list=${mainprog}" $source_list"
+ fi
+ fi
+ fi
+
+
+ # DATEIEN AUS ZUSAETZLICHEM QUELLVERZEICHNIS HINZUFUEGEN
+ if [[ $restart_run != true && "$add_source_path" != "" ]]
+ then
+
+ # GIBT ES DAS VERZEICHNIS UEBERHAUPT?
+ if [[ ! -d $add_source_path ]]
+ then
+ printf "\n\n +++ WARNING: additional source code directory"
+ printf "\n \"$add_source_path\" "
+ printf "\n does not exist or is not a directory."
+ printf "\n No source code will be used from this directory!\n"
+ add_source_path=""
+ sleep 3
+ else
+
+ cd $add_source_path
+
+ Names=$(ls -1 *.f90 2>&1)
+ [[ $(echo $Names | grep -c '*.f90') = 0 ]] && AddFilenames="$Names"
+ Names=$(ls -1 *.F90 2>&1)
+ [[ $(echo $Names | grep -c '*.F90') = 0 ]] && AddFilenames="$AddFilenames $Names"
+ Names=$(ls -1 *.F 2>&1)
+ [[ $(echo $Names | grep -c '*.F') = 0 ]] && AddFilenames="$AddFilenames $Names"
+ Names=$(ls -1 *.f 2>&1)
+ [[ $(echo $Names | grep -c '*.f') = 0 ]] && AddFilenames="$AddFilenames $Names"
+ Names=$(ls -1 *.c 2>&1)
+ [[ $(echo $Names | grep -c '*.c') = 0 ]] && AddFilenames="$AddFilenames $Names"
+
+ cd - > /dev/null
+ cd SOURCES_FOR_RUN_$fname
+
+ for dateiname in $AddFilenames
+ do
+ if [[ -f $dateiname ]]
+ then
+ printf "\n +++ source code file \"$dateiname\" found in additional"
+ printf "\n source code directory \"$add_source_path\" "
+ printf "\n as well as in directory \"$source_path\"."
+ locat=source; exit
+ fi
+
+ cp $add_source_path/$dateiname .
+ source_list="$source_list $dateiname"
+
+ # Default User-Interface von der Liste entfernen, falls Datei
+ # ein User-Interface enthaelt
+ if [[ $( cat $dateiname | grep -c "END SUBROUTINE user_parin" ) != 0 ]]
+ then
+ if [[ $dateiname != user_interface.f90 && -f user_interface.f90 ]]
+ then
+ rm -rf user_interface.f90
+ source_list=`echo $source_list | sed -e 's/user_interface.f90//'`
+ printf "\n\n *** default \"user_interface.f90\" removed from the files to be translated"
+ printf "\n since a user-interface is found in file"
+ printf "\n \"$add_source_path/$dateiname\" \n"
+ sleep 3
+ else
+ printf "\n\n *** user-interface file \"$dateiname\" "
+ printf "\n added to the files to be translated \n"
+ sleep 3
+ fi
+ fi
+ done
+
+ cd - > /dev/null
+ fi
+ fi
+
+
+ # ALLE UNTERPROGRAMME, DIE ZU VEREINBARTEN SOFTWAREPAKETEN GEHOEREN,
+ # DER LISTE DER ZU UEBERSETZENDEN DATEIEN HINZUFUEGEN
+ if [[ $restart_run != true && -n $package_list ]]
+ then
+
+ cd $source_path
+
+ for package in $package_list
+ do
+
+ [[ $package = "dvrp_graphics+1PE" ]] && package=dvrp_graphics
+
+ # ERMITTELE ALLE DATEIEN, DIE ZUM PAKET GEHOEREN
+ # FEHLERMELDUNGEN WERDEN ABGEFANGEN, DA * AUCH VERZEICHNISSNAMEN
+ # LIEFERT
+ package_source_list=`grep "defined( __$package " * 2>/dev/null | cut -f1 -d:`
+
+
+ # FUEGE DIESE DATEIEN DER LISTE DER ZU UEBERSETZENDEN DATEIEN
+ # HINZU, FALLS SIE NOCH NICHT DAZUGEHOEREN
+ for source_list_name in $package_source_list
+ do
+ if [[ $(echo $source_list | grep -c $source_list_name) = 0 ]]
+ then
+
+ # NUR DATEIEN MIT GUELTIGEN ENDUNGEN VERWENDEN
+ ending=`echo $source_list_name | cut -f2 -d.`
+ if [[ "$ending" = f90 || "$ending" = F90 || "$ending" = f || "$ending" = F || "$ending" = c ]]
+ then
+ cp $source_list_name $working_directory/SOURCES_FOR_RUN_$fname
+ source_list="$source_list $source_list_name"
+ fi
+ fi
+ done
+ done
+
+ cd - > /dev/null
+ fi
+
+
+ # MAKEFILE AUF VORHANDENSEIN PRUEFEN UND KOPIEREN
+ # BEI RESTART-LAEUFEN LIEGT ES SCHON IM VERZEICHNIS SOURCES_FOR_RUN...
+ if [[ "$restart_run" != true ]]
+ then
+ [[ "$makefile" = "" ]] && makefile=$source_path/Makefile
+ if [[ ! -f $makefile ]]
+ then
+ printf "\n +++ file \"$makefile\" does not exist"
+ locat=make; exit
+ else
+ cp $makefile SOURCES_FOR_RUN_$fname/Makefile
+ fi
+ fi
+
+ fi # do_compile=true
+
+
+ # FALLS PROGRAMMTEILE UEBERSETZT WERDEN SOLLEN, FOLGEN JETZT EINIGE
+ # UEBERPRUEFUNGEN UND DAS SETZEN DER PRAEPROZESSOR-DIREKTIVEN
+ if [[ $do_compile = true ]]
+ then
+
+ # PRAEPROZESSOR-DIREKTIVEN ZUM SELEKTIVEN AUSWAEHLEN VON CODETEILEN
+ # ZUSAMMENSETZEN
+ # DIREKTIVEN ZUM AKTIVIEREN VON RECHNERSPEZIFISCHEM CODE
+ if [[ $(echo $localhost | cut -c1-3) = ibm ]]
+ then
+ cpp_options="${cpp_options},-D__ibm=__ibm"
+ elif [[ $(echo $localhost | cut -c1-3) = nec ]]
+ then
+ cpp_options="$cpp_options -D__nec"
+ elif [[ $(echo $localhost | cut -c1-2) = lc ]]
+ then
+ cpp_options="$cpp_options -D__lc"
+ else
+ cpp_options="$cpp_options -D__$localhost"
+ fi
+
+ # DIREKTIVEN DIE DURCH OPTION -K BESTIMMT WERDEN (Z.B. PARALLEL)
+ if [[ $(echo $localhost | cut -c1-3) = ibm ]]
+ then
+ [[ -n $cond1 ]] && cpp_options="${cpp_options},-D__$cond1=__$cond1"
+ [[ -n $cond2 ]] && cpp_options="${cpp_options},-D__$cond2=__$cond2"
+ else
+ [[ -n $cond1 ]] && cpp_options="$cpp_options -D__$cond1"
+ [[ -n $cond2 ]] && cpp_options="$cpp_options -D__$cond2"
+ fi
+
+ # DIREKTIVEN DIE SOFTWAREPAKETE AKTIVIEREN (OPTION -p)
+ if [[ -n $package_list ]]
+ then
+ for package in $package_list
+ do
+ if [[ $(echo $localhost | cut -c1-3) = ibm ]]
+ then
+ if [[ $package != "dvrp_graphics+1PE" ]]
+ then
+ cpp_options="${cpp_options},-D__$package=__$package"
+ else
+ cpp_options="${cpp_options},-D__dvrp_graphics=__dvrp_graphics"
+ export use_seperate_pe_for_dvrp_output=true
+ fi
+ else
+ if [[ $package != "dvrp_graphics+1PE" ]]
+ then
+ cpp_options="$cpp_options -D__$package"
+ else
+ cpp_options="$cpp_options -D__dvrp_graphics"
+ export use_seperate_pe_for_dvrp_output=true
+ fi
+ fi
+ done
+ fi
+
+ # DIREKTIVEN DIE DURCH OPTION -D FESTGELEGT SIND
+ if [[ -n $cpp_opts ]]
+ then
+ for popts in $cpp_opts
+ do
+ if [[ $(echo $localhost | cut -c1-3) = ibm ]]
+ then
+ cpp_options="${cpp_options},-D__$popts=__$popts"
+ else
+ cpp_options="$cpp_options -D__$popts"
+ fi
+ done
+ fi
+
+ else
+
+
+ # BEI LOKALEN RECHNUNGEN PRUEFEN, OB EXECUTABLE VORHANDEN
+ if [[ $do_remote = false ]]
+ then
+ if [[ ! -f $executable ]]
+ then
+ printf "\n +++ executable file: $executable"
+ printf "\n does not exist"
+ locat=executable; exit
+ fi
+ fi
+ fi
+
+
+ # JOBMODUS FESTSTELLEN
+ if [[ "$ENVIRONMENT" = BATCH && $localhost != lctit || "$QUEUE" != interactive && $localhost = lctit ]]
+ then
+ jobmo=BATCH
+ else
+ jobmo=INTERACTIVE
+ fi
+
+
+ # HOSTSPEZIFISCHE DEFAULT-COMPILER SETZEN, FALLS NICHT BEREITS
+ # DURCH BENUTZER ANDERWEITIG VEREINBART
+ if [[ "$compiler_name" = "" ]]
+ then
+
+ printf "\n +++ no compiler specified for \"$localhost $cond1 $cond2\""
+ locat=compiler_name; exit
+
+ fi
+
+
+ # COMPILER AUF NECK UEBERSCHREIBEN
+ [[ $localhost = neck ]] && compiler_name=mpif90
+
+
+
+ # TEMPORAEREN KATALOGNAMEN BESTIMMEN
+ kennung=$RANDOM
+ if [[ "$tmp_user_catalog" = "" ]]
+ then
+ if [[ $localhost = ibmb || $localhost = ibmh ]]
+ then
+ tmp_user_catalog=$TMPDIR
+ elif [[ $localhost = nech ]]
+ then
+ tmp_user_catalog=$WRKSHR
+ else
+ tmp_user_catalog=/tmp
+ fi
+ fi
+ TEMPDIR=$tmp_user_catalog/${usern}.$kennung
+
+
+ # KATALOGNAMEN FUER ZWISCHENSPEICHERUNG VON FORTSETZUNGSLAUFDATEIEN
+ # BESTIMMEN
+ if [[ "$tmp_data_catalog" = "" ]]
+ then
+ if [[ $localhost = ibmb || $localhost = ibmh ]]
+ then
+ tmp_data_catalog=$WORK/mrun_restart_data
+ elif [[ $localhost = nech ]]
+ then
+ tmp_data_catalog=$WRKSHR/mrun_restart_data
+ else
+ tmp_data_catalog=/tmp/mrun_restart_data
+ fi
+ fi
+
+
+ # EVENTUELL BEI LOKALEN RECHNUNGEN $-ZEICHEN IN ENVIRONMENT-VARIABLEN
+ # ERSETZEN
+ if [[ $do_remote = false && $do_compile = true ]]
+ then
+ eval fopts=\"$fopts\"
+ eval lopts=\"$lopts\"
+ fi
+
+
+
+ # COMPILE- UND LINK-OPTIONEN BESTIMMEN
+ fopts="$fopts $netcdf_inc $dvrp_inc"
+ lopts="$lopts $netcdf_lib $dvrp_lib"
+ ROPTS="$ropts"
+ if [[ ( $(echo $host | cut -c1-3) = nec || $(echo $host | cut -c1-3) = ibm || $host = lctit || $host = lcfimm ) && -n $numprocs ]]
+ then
+ XOPT="-X $numprocs"
+ fi
+
+
+
+ # PRUEFEN DER CPU-ZEIT. (CPUMAX WIRD ALS ENV-VARIABLE VOM HAUTPRO-
+ # GRAMM BENOETIGT
+ done=false
+ while [[ $done = false ]]
+ do
+ cputime=$cpumax
+ if (( $cputime == 0 ))
+ then
+ printf "\n +++ cpu-time is undefined"
+ printf "\n >>> Please type CPU-time in seconds as INTEGER:"
+ printf "\n >>> "
+ read cputime 1>/dev/null 2>&1
+ else
+ done=true
+ fi
+ cpumax=$cputime
+ done
+
+ (( minuten = cputime / 60 ))
+ (( sekunden = cputime - minuten * 60 ))
+
+
+ # PRUEFEN DER KERNSPEICHERANFORDERUNG
+ if [[ $do_batch = true ]]
+ then
+ done=false
+ while [[ $done = false ]]
+ do
+ if (( memory == 0 ))
+ then
+ printf "\n +++ memory demand is undefined"
+ printf "\n >>> Please type memory in MByte per process as INTEGER:"
+ printf "\n >>> "
+ read memory 1>/dev/null 2>&1
+ else
+ done=true
+ fi
+ done
+ fi
+
+
+ # PRUEFEN, OB FUER REMOTE-RECHNUNGEN EIN BENUTZERNAME ANGEGEBEN WURDE
+ if [[ $do_remote = true && -z $remote_username ]]
+ then
+ while [[ -z $remote_username ]]
+ do
+ printf "\n +++ username on remote host \"$host\" is undefined"
+ printf "\n >>> Please type username:"
+ printf "\n >>> "
+ read remote_username
+ done
+ mc="$mc -u$remote_username"
+ fi
+
+###########################################################################
+# HEADER-AUSGABE
+###########################################################################
+
+
+ calltime=$(date)
+ printf "\n"
+# [[ $silent = false ]] && clear
+ printf "#--------------------------------------------------------------# \n"
+ printf "| $version$calltime | \n"
+ printf "| | \n"
+ spalte1="called on:"; spalte2=$localhost_realname
+ printf "| $spalte1$spalte2 | \n"
+ if [[ $local_compile = false ]]
+ then
+ if [[ $do_remote = true ]]
+ then
+ spalte1="execution on:"; spalte2="$host (username: $remote_username)"
+ else
+ spalte1="execution on:"; spalte2="$host ($localhost_realname)"
+ fi
+ else
+ spalte1="compiling test only!"; spalte2=""
+ fi
+ printf "| $spalte1$spalte2 | \n"
+ if [[ -n $numprocs ]]
+ then
+ spalte1="number of PEs:"; spalte2=$numprocs
+ printf "| $spalte1$spalte2 | \n"
+ fi
+ if [[ -n $tasks_per_node ]]
+ then
+ spalte1="tasks per node:"; spalte2="$tasks_per_node (number of nodes: $nodes)"
+ printf "| $spalte1$spalte2 | \n"
+ fi
+ if [[ $threads_per_task != 1 ]]
+ then
+ spalte1="threads per task:"; spalte2="$threads_per_task"
+ printf "| $spalte1$spalte2 | \n"
+ fi
+ printf "| | \n"
+ if [[ $do_compile = true ]]
+ then
+ spalte1=cpp-directives:; spalte2=$cpp_options
+ printf "| $spalte1$spalte2 | \n"
+ zeile=$(echo "$cpp_options" | cut -c41-)
+ while [[ "$zeile" != "" ]]
+ do
+ spalte1=""
+ spalte2=$zeile
+ printf "| $spalte1$spalte2 | \n"
+ zeile=$(echo "$zeile" | cut -c41-)
+ done
+
+ spalte1=compiler-options:; spalte2="$fopts"
+ printf "| $spalte1$spalte2 | \n"
+ zeile=$(echo "$fopts" | cut -c41-)
+ while [[ "$zeile" != "" ]]
+ do
+ spalte1=""
+ spalte2=$zeile
+ printf "| $spalte1$spalte2 | \n"
+ zeile=$(echo "$zeile" | cut -c41-)
+ done
+
+ spalte1=linker-options:; spalte2=$lopts
+ printf "| $spalte1$spalte2 | \n"
+ zeile=$(echo "$lopts" | cut -c41-)
+ while [[ "$zeile" != "" ]]
+ do
+ spalte1=""
+ spalte2=$zeile
+ printf "| $spalte1$spalte2 | \n"
+ zeile=$(echo "$zeile" | cut -c41-)
+ done
+
+ spalte1="main program":; spalte2=$mainprog
+ printf "| $spalte1$spalte2 | \n"
+ else
+ spalte1=executable:; spalte2=$executable
+ printf "| $spalte1$spalte2 | \n"
+ fi
+ printf "| | \n"
+ spalte1="base name of files":; spalte2=$fname
+ printf "| $spalte1$spalte2 | \n"
+ if [[ $fname != $afname ]]
+ then
+ spalte1="base name of input files":; spalte2=$afname
+ printf "| $spalte1$spalte2 | \n"
+ fi
+ spalte1="INPUT control list":; spalte2=$input_list
+ printf "| $spalte1$spalte2 | \n"
+ spalte1="OUTPUT control list":; spalte2=$output_list
+ printf "| $spalte1$spalte2 | \n"
+
+ if [[ $do_batch = true || "$LOADLBATCH" = yes ]]
+ then
+ spalte1="memory demand / PE":; spalte2="$memory MB"
+ printf "| $spalte1$spalte2 | \n"
+ spalte1=CPU-time:; spalte2="$minuten:$sekunden"
+ printf "| $spalte1$spalte2 | \n"
+ fi
+
+ if [[ $do_compile = true ]]
+ then
+ printf "| | \n"
+ printf "| Files to be compiled: | \n"
+ zeile=$source_list
+ while [[ "$zeile" != "" ]]
+ do
+ spalte3=$zeile
+ printf "| $spalte3 | \n"
+ zeile=$(echo "$zeile" | cut -c61-)
+ done
+ fi
+ printf "#--------------------------------------------------------------#"
+
+
+
+ # BEDINGTE AUSGABE DER DATEIVERBINDUNGEN
+ if [[ $do_trace = true ]]
+ then
+ (( i = 0 ))
+ while (( i < iin ))
+ do
+ (( i = i + 1 ))
+ if (( i == 1 ))
+ then
+ printf "\n\n >>> INPUT-file assignments:\n"
+ fi
+ printf "\n ${localin[$i]} : ${absnamein[$i]}"
+ done
+ (( i = 0 ))
+ while (( i < iout ))
+ do
+ (( i = i + 1 ))
+ if (( i == 1 ))
+ then
+ printf "\n\n >>> OUTPUT-file assignments:\n"
+ fi
+ printf "\n ${localout[$i]} : ${pathout[$i]}"
+ done
+ (( i = 0 ))
+ while (( i < iic ))
+ do
+ (( i = i + 1 ))
+ if (( i == 1 ))
+ then
+ printf "\n\n >>> INPUT-commands:\n"
+ fi
+ printf "\n ${in_command[$i]}"
+ done
+ (( i = 0 ))
+ while (( i < ioc ))
+ do
+ (( i = i + 1 ))
+ if (( i == 1 ))
+ then
+ printf "\n\n >>> OUTPUT-commands:\n"
+ fi
+ printf "\n ${out_command[$i]}"
+ done
+ fi
+
+
+ # ABFRAGEN BEI AUFRUF AUF LOKALER MASCHINE
+ if [[ $remotecall = false && $silent = false && $jobmo != BATCH ]]
+ then
+ antwort=dummy
+ printf "\n\n"
+ while [[ "$antwort" != y && "$antwort" != Y && "$antwort" != n && "$antwort" != N ]]
+ do
+ printf " >>> everything o.k. (y/n) ? "
+ read antwort
+ done
+ if [[ $antwort = n || $antwort = N ]]
+ then
+ locat=user_abort; (( iec = 0 )); exit
+ fi
+ if [[ $do_batch = true ]]
+ then
+ printf " >>> batch-job will be created and submitted"
+ else
+ if [[ $local_compile = false ]]
+ then
+ printf " >>> MRUN will now continue to execute on this machine"
+ else
+ printf " >>> a test compilation will now be carried out on this machine"
+ fi
+ fi
+ fi
+
+
+
+
+ # FALLS AUF DIESER MASCHINE GERECHNET WERDEN SOLL, WERDEN JETZT ENTSPRE-
+ # CHENDE AKTIONEN DURCHGEFUEHRT
+ if [[ $do_batch = false ]]
+ then
+
+
+ # TEMPORAEREN KATALOG ERZEUGEN
+ mkdir -p $TEMPDIR
+ chmod go+rx $TEMPDIR
+ tmpcreate=true
+
+
+ # SAEMTLICHE QUELLTEXT-DATEIEN BZW. AUSFUEHRBARES PROGRAMM IN
+ # TEMPORAERES VERZEICHNIS KOPIEREN
+ if [[ $do_compile = true ]]
+ then
+
+ # ON NEC, COMPILATION IS DONE ON HOST CROSS VIA CROSS COMPILING
+ # CREATE A TEMPORARY DIRECTORY ON THAT MACHINE (HOME MOUNTED VIA NFS)
+ if [[ $localhost = nech ]]
+ then
+ TEMPDIR_COMPILE=$HOME/work/${usern}.$kennung
+ if mkdir -p $TEMPDIR_COMPILE
+ then
+ printf "\n *** \"$TEMPDIR_COMPILE\" "
+ printf "\n is generated as temporary directory for cross compiling\n"
+ else
+ printf "\n +++ creating directory \"$TEMPDIR_COMPILE\" "
+ printf "\n needed for cross compilation failed"
+ locat=compile
+ exit
+ fi
+ else
+ TEMPDIR_COMPILE=$TEMPDIR
+ fi
+
+
+ # PFADNAMEN FUER DAS MAKE-DEPOSITORY ERMITTELN
+ line=""
+ grep "%depository_path" $config_file > tmp_mrun
+ while read line
+ do
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ if [[ "$(echo $line | cut -d" " -s -f3)" = "" ]]
+ then
+ global_depository_path=`echo $line | cut -d" " -s -f2`
+ fi
+ fi
+ done < tmp_mrun
+
+ line=""
+ grep " $localhost" $config_file | grep "%depository_path" > tmp_mrun
+ while read line
+ do
+ if [[ "$line" != "" && $(echo $line | cut -c1) != "#" ]]
+ then
+ local_depository_path=`echo $line | cut -d" " -s -f2`
+ fi
+ done < tmp_mrun
+
+ if [[ "$local_depository_path" = "" ]]
+ then
+ if [[ "$global_depository_path" != "" ]]
+ then
+ local_depository_path=$global_depository_path
+ else
+ printf "\n\n +++ no depository path found in configuration file"
+ printf "\n for local host \"$localhost\" "
+ printf "\n please set \"\%depository_path\" in configuration file\n"
+ locat=config_file; exit
+ fi
+ fi
+ eval local_depository_path=$local_depository_path
+
+ basename=`print $mainprog | cut -f1 -d"."`
+ eval make_depository=${local_depository_path}/${basename}_current_version.tar
+ if [[ ! -f $make_depository ]]
+ then
+ printf "\n"
+ printf "\n *** WARNING: make depository \"$make_depository\" not found"
+ printf "\n \"make\" will fail, if the Makefile or other source files are missing\n"
+ else
+ cp $make_depository $TEMPDIR_COMPILE
+ cd $TEMPDIR_COMPILE
+ tar -xf $make_depository > /dev/null 2>&1
+ cd - > /dev/null
+ fi
+
+ cp SOURCES_FOR_RUN_$fname/* $TEMPDIR_COMPILE
+
+ # FALLS USER-INTERFACE VORHANDEN UND AUF DATEI MIT ANDEREM NAMEN
+ # ALS user_interface.f90 LIEGT, DIESEN GEAENDERTEN NAMEN INS
+ # MAKEFILE EINTRAGEN
+ cd $TEMPDIR_COMPILE
+ interface_file=`grep -l "END SUBROUTINE user_parin" $source_list`
+ if [[ "$interface_file" != "" ]]
+ then
+ interface_file=`echo $interface_file | cut -d"." -f1`
+ mv Makefile Makefile_old
+ sed "s/user_interface/$interface_file/g" Makefile_old > Makefile
+ fi
+ cd - > /dev/null
+ else
+ cp $executable ${TEMPDIR}/a.out
+ fi
+
+
+ # WECHSEL IN TEMPORAEREN KATALOG
+ cd $TEMPDIR
+ printf "\n *** changed to temporary directory: $TEMPDIR"
+
+
+ # OUTPUT-DATEI-VERBINDUNGEN AUF TEMPORAERER DATEI ABLEGEN
+ # DIESE DATEI KANN VON SPAETER AUFZURUFENDEN BENUTZERPROZEDUREN GELESEN
+ # WERDEN, UM ZU LOKALEN DATEINAMEN GEHOERENDE PERMANENTE NAMEN ZU
+ # ERMITTELN
+ (( i = 0 ))
+ while (( i < iout ))
+ do
+ (( i = i + 1 ))
+ if [[ "${actionout[$i]}" = tr || "${actionout[$i]}" = tra || "${actionout[$i]}" = trpe ]]
+ then
+ printf "${localout[$i]} ${actionout[$i]}\n${pathout[$i]}\n${localhost}_${fname}${endout[$i]}\n" >> OUTPUT_FILE_CONNECTIONS
+ else
+ printf "${localout[$i]} ${actionout[$i]}\n${pathout[$i]}\n${frelout[$i]}\n" >> OUTPUT_FILE_CONNECTIONS
+ fi
+ done
+
+
+ # EVTL. UEBERSETZUNGSAKTIONEN STARTEN
+ if [[ $do_compile = true ]]
+ then
+
+
+ # COMPILING WITH MAKE (ON NEC COMPILER IS CALLED ON HOST CROSS)
+ printf "\n\n\n *** compilation starts \n$striche\n"
+ printf " *** compilation with make using following options:\n"
+ printf " compilername: $compiler_name\n"
+ printf " options: $fopts\n"
+ printf " preprocessor-directives: $cpp_options \n"
+ printf " linker-options: $lopts \n"
+ printf " source code files: $source_list \n"
+
+ if [[ $localhost = nech ]]
+ then
+ ssh 136.172.44.192 -l $usern ". /SX/opt/etc/initsx.sh; cd \$HOME/work/${usern}.$kennung; sxmake -f Makefile PROG=a.out F90=$compiler_name COPT=\"$cpp_options\" F90FLAGS=\"$fopts\" LDFLAGS=\"$lopts\" "
+ cp $TEMPDIR_COMPILE/a.out .
+ [[ $? != 0 ]] && compile_error=true
+ rm -rf $TEMPDIR_COMPILE
+ else
+ [[ $localhost = lctit ]] && export LM_LICENSE_FILE=27050@tggls
+ make -f Makefile PROG=a.out F90=$compiler_name COPT="$cpp_options" F90FLAGS="$fopts" LDFLAGS="$lopts"
+ fi
+
+ if [[ $? != 0 || "$compile_error" = true || "$module_compile_error" = true ]]
+ then
+ printf "\n +++ error occured while compiling or linking"
+ locat=compile
+ exit
+ else
+ printf "$striche\n *** compilation finished \n"
+ fi
+ fi
+
+
+ # FALLS NUR TESTWEISE KOMPILIERT WERDEN SOLLTE, IST MRUN JETZT FERTIG
+ if [[ $local_compile = true ]]
+ then
+ cd $HOME
+ rm -rf $TEMPDIR
+ locat=local_compile; exit
+ fi
+
+
+ # BEREITSTELLEN DER INPUT-DATEIEN
+ # SCHLEIFE UEBER ALLE VOM BENUTZER ANGEGEBENEN DATEIEN
+ (( i = 0 ))
+ while (( i < iin ))
+ do
+ (( i = i + 1 ))
+ if (( i == 1 ))
+ then
+ printf "\n\n *** providing INPUT-files:\n$striche"
+ fi
+
+
+ # OPTIONALE DATEIEN BEI NICHTVORHANDENSEIN UEBERGEHEN
+ if [[ "${transin[$i]}" = unavailable ]]
+ then
+ if [[ "${extin[$i]}" = "" || "${extin[$i]}" = " " ]]
+ then
+ printf "\n +++ WARNING: input file \"${pathin[$i]}/${afname}${endin[$i]}\" "
+ printf "\n is not available!"
+ else
+ printf "\n +++ WARNING: input file \"${pathin[$i]}/${afname}${endin[$i]}.${extin[$i]}\" "
+ printf "\n is not available!"
+ fi
+ continue
+ fi
+
+ # PRUEFEN, OB EINZELDATEI ODER DATEI PRO PROZESSOR
+ files_for_pes=false; datentyp=file
+ if [[ "${actionin[$i]}" = pe && -n $numprocs ]]
+ then
+ files_for_pes=true; datentyp=directory
+ actionin[$i]=""
+ elif [[ "${actionin[$i]}" = pe && ! -n $numprocs ]]
+ then
+ actionin[$i]=""
+ elif [[ "${actionin[$i]}" = arpe && -n $numprocs ]]
+ then
+ files_for_pes=true; datentyp=directory
+ actionin[$i]="ar"
+ elif [[ "${actionin[$i]}" = arpe && ! -n $numprocs ]]
+ then
+ actionin[$i]="ar"
+ elif [[ "${actionin[$i]}" = flpe && -n $numprocs ]]
+ then
+ files_for_pes=true; datentyp=directory
+ actionin[$i]="fl"
+ elif [[ "${actionin[$i]}" = flpe && ! -n $numprocs ]]
+ then
+ actionin[$i]="fl"
+ fi
+
+ if [[ $files_for_pes = true ]]
+ then
+ printf "\n >>> INPUT: ${absnamein[$i]}/.... to ${localin[$i]}"
+ else
+ printf "\n >>> INPUT: ${absnamein[$i]} to ${localin[$i]}"
+ fi
+
+ # INPUT-DATEI FUER EINEN FORTSETZUNGSLAUF. ES WIRD GEPRUEFT,
+ # OB DIESE DATEI NOCH AUF DEM TEMPORAEREN DATENKATALOG VORHANDEN
+ # IST. FALLS NICHT, WIRD VERSUCHT, SIE ANSCHLIESSEND VOM ARCHIV-
+ # SERVER ZU HOLEN
+ if [[ "${actionin[$i]}" = fl ]]
+ then
+ printf "\n $datentyp will be fetched from temporary directory \"${tmp_data_catalog}\" !"
+ if [[ $files_for_pes = false ]]
+ then
+ if [[ -f "$tmp_data_catalog/${frelin[$i]}" ]]
+ then
+ ln $tmp_data_catalog/${frelin[$i]} ${localin[$i]}
+ got_tmp[$i]=true
+ elif [[ -f "$WORK/${frelin[$i]}" && $ignore_archive_error = true ]]
+ then
+ printf "\n +++ $datentyp not found in \"$tmp_data_catalog\" !"
+ printf "\n *** trying to use backup copy in \"$WORK\" "
+ cp $WORK/${frelin[$i]} ${localin[$i]}
+ else
+ printf "\n +++ $datentyp not found in \"$tmp_data_catalog\" "
+ printf "\n or \"$tmp_data_catalog\" does not exist!"
+ printf "\n *** trying to get copy from archive"
+ actionin[$i]=ar
+ fi
+ else
+ if [[ -d "$tmp_data_catalog/${frelin[$i]}" ]]
+ then
+ mkdir ${localin[$i]}
+ ln $tmp_data_catalog/${frelin[$i]}/* ${localin[$i]}
+ got_tmp[$i]=true
+ elif [[ -d "$WORK/${frelin[$i]}" && $ignore_archive_error = true ]]
+ then
+ printf "\n +++ $datentyp not found in \"$tmp_data_catalog\" !"
+ printf "\n *** trying to use backup copy in \"$WORK\" "
+ cp -r $WORK/${frelin[$i]} ${localin[$i]}
+ else
+ printf "\n +++ $datentyp not found in \"$tmp_data_catalog\" "
+ printf "\n or \"$tmp_data_catalog\" does not exist!"
+ printf "\n *** trying to get copy from archive"
+ actionin[$i]=ar
+ fi
+ fi
+ fi
+
+
+ # DATEI LIEGT AUF ARCHIV-SERVER
+ if [[ "${actionin[$i]}" = ar ]]
+ then
+
+ if [[ $files_for_pes = false ]]
+ then
+ printf "\n file will be restored from archive-system ($archive_system)!"
+ else
+ printf "\n directory will be restored from archive-system ($archive_system)!"
+ fi
+
+ file_restored=false
+
+ if [[ $archive_system = asterix ]]
+ then
+ do_stagein=true
+ (( stagein_anz = 0 ))
+ while [[ $do_stagein = true ]]
+ do
+ if [[ $files_for_pes = false ]]
+ then
+ stagein -O ${frelin[$i]} > STAGEIN_OUTPUT
+ else
+ stagein -t -O ${frelin[$i]} > STAGEIN_OUTPUT
+ fi
+ cat STAGEIN_OUTPUT
+ if [[ $(grep -c "st.msg:i24" STAGEIN_OUTPUT) != 0 ]]
+ then
+ file_restored=true
+ do_stagein=false
+ else
+ (( stagein_anz = stagein_anz + 1 ))
+ if (( stagein_anz == 10 ))
+ then
+ printf "\n +++ stagein stoped after 10 tries"
+ locat=stage
+ exit
+ fi
+ printf "\n +++ restoring from archive failed, trying again:"
+ sleep 900
+ fi
+ done
+ elif [[ $archive_system = DMF ]]
+ then
+ if [[ $files_for_pes = false ]]
+ then
+ printf "\n +++ restoring of single files impossible with $archive_system !\n"
+ locat=DMF
+ exit
+ else
+ find $ARCHIVE/${frelin[$i]} -type m -print | dmget
+ cp -r $ARCHIVE/${frelin[$i]} $PWD
+ file_restored=true
+ fi
+ elif [[ $archive_system = tivoli ]]
+ then
+ if [[ $files_for_pes = false ]]
+ then
+ if [[ $localhost = ibmh ]]
+ then
+ ssh $usern@hdata.hlrn.de "cp $PERM/${frelin[$i]} $PWD"
+ else
+ ssh $usern@bdata.hlrn.de "cp $PERM/${frelin[$i]} $PWD"
+ fi
+ else
+ (( inode = 0 ))
+ while (( inode < nodes ))
+ do
+ if [[ $localhost = ibmh ]]
+ then
+ ssh $usern@hdata.hlrn.de "cd $PWD; tar xf $PERM/${frelin[$i]}/${frelin[$i]}.node_$inode.tar"
+ else
+ ssh $usern@bdata.hlrn.de "cd $PWD; tar xf $PERM/${frelin[$i]}/${frelin[$i]}.node_$inode.tar"
+ fi
+ (( inode = inode + 1 ))
+ done
+ fi
+ file_restored=true
+ elif [[ $archive_system = ut ]]
+ then
+ if [[ $files_for_pes = false ]]
+ then
+ cp $UT/${frelin[$i]} .
+ else
+ (( inode = 0 ))
+ while (( inode < nodes ))
+ do
+ tar xf $UT/${frelin[$i]}/${frelin[$i]}.node_$inode.tar
+ (( inode = inode + 1 ))
+ done
+ fi
+ file_restored=true
+ else
+ printf "\n +++ archive_system=\"$archive_system\" restore impossible!"
+ locat=rearchive
+ exit
+ fi
+
+ if [[ $file_restored = true ]]
+ then
+
+ # DATEI AUCH AUF TEMPORAERES DATENVERZEICHNIS LEGEN, DAMIT
+ # SIE BEI WEITEREN ZUGRIFFEN NOCH VORHANDEN IST
+ [[ ! -d $tmp_data_catalog ]] && mkdir -p $tmp_data_catalog; chmod g+rx $tmp_data_catalog
+ if [[ $files_for_pes = false ]]
+ then
+ ln -f ${frelin[$i]} $tmp_data_catalog/${frelin[$i]}
+ else
+ mkdir $tmp_data_catalog/${frelin[$i]}
+ ln -f ${frelin[$i]}/* $tmp_data_catalog/${frelin[$i]}
+ fi
+ got_tmp[$i]=true
+
+ # DATEI UNTER LOKALEM NAMEN ZUR VERFUEGUNG STELLEN
+ mv ${frelin[$i]} ${localin[$i]}
+
+ fi
+ fi
+
+
+ # DATEI LIEGT IM VOM BENUTZER ANGEGEBENEN VERZEICHNIS
+ if [[ "${actionin[$i]}" = "" || "${actionin[$i]}" = "di" || "${actionin[$i]}" = "npe" ]]
+ then
+
+ if [[ "${actionin[$i]}" = "npe" && -n $numprocs ]]
+ then
+
+ # DATEI WIRD FUER DIE PROZESSOREN EINES PARALLERECHNERS BEREITGESTELLT
+ printf "\n file will be provided for $numprocs processors"
+ mkdir ${localin[$i]}
+ ival=$numprocs
+ (( ii = 0 ))
+ while (( ii <= ival-1 ))
+ do
+ if (( ii < 10 ))
+ then
+ cp ${absnamein[$i]} ${localin[$i]}/_000$ii
+ elif (( ii < 100 ))
+ then
+ cp ${absnamein[$i]} ${localin[$i]}/_00$ii
+ elif (( ii < 1000 ))
+ then
+ cp ${absnamein[$i]} ${localin[$i]}/_0$ii
+ else
+ cp ${absnamein[$i]} ${localin[$i]}/_$ii
+ fi
+ (( ii = ii + 1 ))
+ done
+
+ else
+
+ if [[ $files_for_pes = true ]]
+ then
+
+ # DIE DEN PROZESSOREN EINES PARALLELRECHNERS ZUGEHOERIGEN
+ # DATEIEN WERDEN BEREITGESTELLT, INDEM ZUERST DER GESAMTE
+ # KATALOGINHALT KOPIERT UND DANN DIE EINZELNEN DATEIEN
+ # PER MOVE UMBENANNT WERDEN
+ printf "\n providing $numprocs files for the respective processors"
+ mkdir ${localin[$i]}
+ cp -r ${absnamein[$i]}/* ${localin[$i]}
+
+ else
+ # BEREITSTELLUNG AUF EINPROZESSORRECHNERN
+ cp ${absnamein[$i]} ${localin[$i]}
+ fi
+ fi
+ fi
+
+ done
+ if (( i != 0 ))
+ then
+ printf "\n$striche\n *** all INPUT-files provided \n"
+ fi
+
+
+ # NAMELIST-DATEI MIT WERTEN VON ENVIRONMENT-VARIABLEN ERZEUGEN (ZU
+ # LESEN VON PALM)
+ cat > ENVPAR << %%END%%
+ &envpar run_identifier = '$fname', host = '$localhost',
+ write_binary = '$write_binary', tasks_per_node = $tasks_per_node,
+ maximum_cpu_time_allowed = ${cpumax}.,
+ revision = '$global_revision' /
+
+%%END%%
+
+
+ # EVENTUELLE INPUT-KOMMANDOS ABARBEITEN
+ (( i = 0 ))
+ while (( i < iic ))
+ do
+ (( i = i + 1 ))
+ if (( i == 1 ))
+ then
+ printf "\n\n *** execution of INPUT-commands:\n$striche"
+ fi
+ printf "\n >>> ${in_command[$i]}"
+ eval ${in_command[$i]}
+ if (( i == iic ))
+ then
+ printf "\n$striche\n"
+ fi
+ done
+
+
+ # VERBLEIBENDE CPU-ZEIT BERECHNEN
+ cpurest=${cpumax}.
+
+
+ # PROGRAMMSTART
+ printf "\n\n *** execution starts in directory\n \"`pwd`\"\n$striche\n"
+ PATH=$PATH:$TEMPDIR
+
+ if [[ "$cond1" = debug || "$cond2" = debug ]]
+ then
+ if [[ "$ENVIRONMENT" = BATCH ]]
+ then
+ printf "\n +++ debug is allowed in interactive mode only"
+ locat=debug
+ exit
+ fi
+ if [[ $localhost = decalpha ]]
+ then
+ dxladebug a.out
+ elif [[ $localhost = ibmb || $localhost = ibmh ]]
+ then
+
+ # SETUP THE IBM MPI ENVIRONMENT
+ export MP_SHARED_MEMORY=yes
+ export AIXTHREADS_SCOPE=S
+ export OMP_NUM_THREADS=$threads_per_task
+ export AUTHSTATE=files
+ export XLFRTEOPTS="nlwidth=132:err_recovery=no" # RECORD-LENGTH OF NAMELIST-OUTPUT
+
+ # FOLLOWING OPTIONS ARE MANDATORY FOR TOTALVIEW
+ export MP_ADAPTER_USE=shared
+ export MP_CPU_USE=multiple
+ export MP_TIMEOUT=1200
+
+ unset MP_TASK_AFFINITY
+
+ # SO FAR, TOTALVIEW NEEDS HOSTFILE MECHANISM FOR EXECUTION
+ #(( ii = 1 ))
+ #while (( ii <= $numprocs ))
+ #do
+ # echo $localhost_realname >> hostfile
+ # (( ii = ii + 1 ))
+ #done
+ #export MP_HOSTFILE=hostfile
+
+ if [[ "$LOADLBATCH" = yes ]]
+ then
+ totalview poe a.out $ROPTS
+ else
+ echo totalview poe -a a.out -procs $numprocs -rmpool 0 -nodes 1 $ROPTS
+ export TVDSVRLAUNCHCMD=ssh
+ totalview poe -a a.out -procs $numprocs -rmpool 0 -nodes 1 $ROPTS
+ fi
+ else
+ printf "\n +++ no debug available on \"$localhost\" "
+ printf "\n or not implemented in mrun so far"
+ locat=debug
+ exit
+ fi
+ else
+ if [[ -n $numprocs ]]
+ then
+
+ # RUNNING THE PROGRAM ON PARALLEL MACHINES
+ if [[ $(echo $host | cut -c1-3) = ibm ]]
+ then
+ # SETUP THE IBM MPI ENVIRONMENT
+ export MP_SHARED_MEMORY=yes
+ export AIXTHREAD_SCOPE=S
+ export OMP_NUM_THREADS=$threads_per_task
+ export XLSMPOPTS="spins=0:yields=0:stack=20000000"
+ export AUTHSTATE=files
+ export XLFRTEOPTS="nlwidth=132:err_recovery=no" # RECORD-LENGTH OF NAMELIST-OUTPUT
+ # export MP_PRINTENV=yes
+
+ # TUNING-VARIABLEN ZUR VERBESSERUNG DER KOMMUNIKATION
+ # ZEIGEN ABER DERZEIT (SEP 04, FEDERATION) KAUM WIRKUNG
+ export MP_WAIT_MODE=poll
+ [[ $node_usage = not_shared ]] && export MP_SINGLE_THREAD=yes
+# export MP_EAGER_LIMIT=65535
+
+# # TESTWEISE FUER TURBOMPI (JAN 05)
+# export MPJ_MTAB=128
+# export MPJ_ALLTOALL=1
+# export MPJ_ALLTOALLV=1
+
+ if [[ "$LOADLBATCH" = yes ]]
+ then
+ printf "\n--- Control: OMP_NUM_THREADS = \"$OMP_NUM_THREADS\" \n"
+ if [[ "$cond1" = hpmcount || "$cond2" = hpmcount ]]
+ then
+ /opt/optibm/HPM_2_4_1/bin/hpmcount a.out $ROPTS
+ else
+ poe ./a.out $ROPTS
+ fi
+ else
+ if [[ $localhost = ibmb || $localhost = ibmh || $localhost = ibms ]]
+ then
+ poe a.out -procs $numprocs -nodes 1 -rmpool 0 $ROPTS
+ elif [[ $localhost = ibmy ]]
+ then
+ if [[ -f $hostfile ]]
+ then
+ cp $hostfile hostfile
+ else
+ (( ii = 1 ))
+ while (( ii <= $numprocs ))
+ do
+ echo $localhost_realname >> hostfile
+ (( ii = ii + 1 ))
+ done
+ fi
+ export MP_HOSTFILE=hostfile
+ ./a.out -procs $tasks_per_node $ROPTS
+ else
+ if [[ "$host_file" = "" ]]
+ then
+ printf "\n +++ no hostfile given in configuration file"
+ locat=config_file
+ exit
+ else
+ eval host_file=$host_file
+ fi
+ export MP_HOSTFILE=$host_file
+ poe a.out -procs $numprocs -tasks_per_node $numprocs $ROPTS
+ fi
+ fi
+ elif [[ $host = nech || $host = neck ]]
+ then
+ (( ii = nodes ))
+ if [[ $ii = 1 ]]
+ then
+ export F_ERRCNT=0 # acceptable number of errors before program is stopped
+ export MPIPROGINF=YES
+ # export F_TRACE=YES|FMT1|FMT2 # output of ftrace informations to job protocol
+ echo "*** execution on single node with mpirun"
+ mpirun -np $numprocs ./a.out $ROPTS
+ else
+ (( i = 0 ))
+ while (( i < ii ))
+ do
+ echo "-h $i -p $tasks_per_node -e ./mpi_exec_shell" >> multinode_config
+ (( i = i + 1 ))
+ done
+
+ echo "#!/bin/sh" > mpi_exec_shell
+ echo " " >> mpi_exec_shell
+ echo "set -u" >> mpi_exec_shell
+ echo "F_ERRCNT=0" >> mpi_exec_shell
+ echo "MPIPROGINV=YES" >> mpi_exec_shell
+ echo "OMP_NUM_THREADS=$threads_per_task" >> mpi_exec_shell
+ echo "cpurest=$cpurest" >> mpi_exec_shell
+ echo "fname=$fname" >> mpi_exec_shell
+ echo "localhost=$localhost" >> mpi_exec_shell
+ echo "return_addres=$return_addres" >> mpi_exec_shell
+ echo "return_username=$return_username" >> mpi_exec_shell
+ echo "tasks_per_node=$tasks_per_node" >> mpi_exec_shell
+ echo "write_binary=$write_binary" >> mpi_exec_shell
+ echo "use_seperate_pe_for_dvrp_output=$use_seperate_pe_for_dvrp_output" >> mpi_exec_shell
+ echo " " >> mpi_exec_shell
+ echo "export F_ERRCNT" >> mpi_exec_shell
+ echo "export MPIPROGINV" >> mpi_exec_shell
+ echo "export OMP_NUM_THREADS" >> mpi_exec_shell
+ echo "export cpurest" >> mpi_exec_shell
+ echo "export fname" >> mpi_exec_shell
+ echo "export localhost" >> mpi_exec_shell
+ echo "export return_addres" >> mpi_exec_shell
+ echo "export return_username" >> mpi_exec_shell
+ echo "export tasks_per_node" >> mpi_exec_shell
+ echo "export write_binary" >> mpi_exec_shell
+ echo "export use_seperate_pe_for_dvrp_output" >> mpi_exec_shell
+ echo " " >> mpi_exec_shell
+ echo "exec ./a.out" >> mpi_exec_shell
+
+ chmod u+x mpi_exec_shell
+ export MPIPROGINF=YES
+ mpirun -f multinode_config &
+ wait
+
+ fi
+ elif [[ $(echo $host | cut -c1-2) = lc && $host != lctit ]]
+ then
+
+ # COPY HOSTFILE FROM SOURCE DIRECTORY OR CREATE IT, IF IT
+ # DOES NOT EXIST
+ if [[ -f $hostfile ]]
+ then
+ cp $hostfile hostfile
+ else
+ (( ii = 1 ))
+ while (( ii <= $numprocs / $threads_per_task ))
+ do
+ echo $localhost_realname >> hostfile
+ (( ii = ii + 1 ))
+ done
+ fi
+ (( ii = $numprocs / $threads_per_task ))
+ eval zeile=\"`head -n $ii hostfile`\"
+ printf "\n *** running on: $zeile"
+ export OMP_NUM_THREADS=$threads_per_task
+ if [[ $threads_per_task != 1 ]]
+ then
+ printf "\n threads per task: $threads_per_task"
+ fi
+ if [[ $run_coupled_model = false ]]
+ then
+ printf "\n\n"
+ mpiexec -machinefile hostfile -n $ii a.out $ROPTS
+ else
+ (( iii = ii / 2 ))
+ printf "\n coupled run ($iii atmosphere, $iii ocean)"
+ printf "\n\n"
+ mpiexec -machinefile hostfile -n $iii -env coupling_mode atmosphere_to_ocean a.out $ROPTS &
+ mpiexec -machinefile hostfile -n $iii -env coupling_mode ocean_to_atmosphere a.out $ROPTS &
+ wait
+ fi
+
+# if [[ $scirocco = true ]]
+# then
+# mpiexec -machinefile hostfile -n $ii a.out $ROPTS
+# else
+# mpirun -machinefile hostfile -np $ii a.out $ROPTS
+# fi
+
+ elif [[ $host = decalpha ]]
+ then
+ dmpirun -np $numprocs a.out $ROPTS
+ elif [[ $host = lctit ]]
+ then
+ export runfile=runfile.$kennung
+
+ echo "cd $PWD" > $runfile
+ echo "export OMP_NUM_THREADS=$OMP_NUM_THREADS" >> $runfile
+ echo "export cpurest=$cpurest" >> $runfile
+ echo "export fname=$fname" >> $runfile
+ echo "export localhost=$localhost" >> $runfile
+ echo "export return_addres=$return_addres" >> $runfile
+ echo "export return_username=$return_username" >> $runfile
+ echo "export tasks_per_node=$tasks_per_node" >> $runfile
+ echo "export write_binary=$write_binary" >> $runfile
+ echo "export use_seperate_pe_for_dvrp_output=$use_seperate_pe_for_dvrp_output" >> $runfile
+ echo "./a.out" >> $runfile
+ chmod u+x $runfile
+
+ if [[ "$QUEUE" = interactive ]]
+ then
+ mpirun -np $numprocs a.out $ROPTS
+ else
+ (( mem_tsubame = $memory / 1024.0 ))
+ echo "Memory for Tsubame for each process in GB:", $mem_tsubame
+# n1ge -fore -g 1S060156 -mpi $numprocs -mem 4 -N palm -q $queue a.out $ROPTS
+ /n1ge/TITECH_GRID/tools/bin/n1ge -fore -g $group_number -mpi ${numprocs}:$tasks_per_node -mem $mem_tsubame -N palm -rt $minuten -q $queue a.out $ROPTS
+ fi
+
+ rm $runfile
+ else
+ mpprun -n $numprocs a.out $ROPTS
+ fi
+ [[ $? != 0 ]] && execution_error=true
+
+
+ # PERFORMANCE-AUSWERTUNG MIT APPRENTICE
+ if [[ "$cond1" = apprentice || "$cond2" = apprentice ]]
+ then
+ apprentice
+ fi
+ else
+ a.out $ROPTS
+ fi
+ fi
+ if [[ $? != 0 || $execution_error = true ]]
+ then
+
+ # ABBRUCH BEI LAUFZEITFEHLER
+# [[ ! ( "$cond1" = debug || "$cond2" = debug ) ]] && cat aout_output*
+ printf "\n +++ runtime error occured"
+ locat=execution
+ exit
+ else
+# [[ ! ( "$cond1" = debug || "$cond2" = debug ) ]] && cat aout_output*
+ printf "\n$striche\n *** execution finished \n"
+ fi
+
+
+
+ # EVENTUELLE OUTPUT-KOMMANDOS ABARBEITEN
+ (( i = 0 ))
+ while (( i < ioc ))
+ do
+ (( i = i + 1 ))
+ if (( i == 1 ))
+ then
+ printf "\n\n *** execution of OUTPUT-commands:\n$striche"
+ fi
+ printf "\n >>> ${out_command[$i]}"
+ eval ${out_command[$i]}
+ if (( i == ioc ))
+ then
+ printf "\n$striche\n"
+ fi
+ done
+
+
+ # EVTL. INHALT DES AKTUELLEN VERZEICHNISSES AUSGEBEN
+ if [[ $do_trace = true ]]
+ then
+ printf "\n\n"
+ ls -al
+ fi
+
+
+
+ # OUTPUT-DATEIEN AN IHRE ZIELORTE KOPIEREN
+ (( i = 0 ))
+ while (( i < iout ))
+ do
+ (( i = i + 1 ))
+ if (( i == 1 ))
+ then
+ printf "\n\n *** saving OUTPUT-files:\n$striche"
+ fi
+
+ # PRUEFEN, OB EINZELDATEI ODER DATEI PRO PROZESSOR
+ files_for_pes=false; filetyp=file
+ if [[ "${actionout[$i]}" = pe && -n $numprocs ]]
+ then
+ files_for_pes=true; filetyp=directory
+ actionout[$i]=""
+ elif [[ "${actionout[$i]}" = pe && ! -n $numprocs ]]
+ then
+ actionout[$i]=""
+ elif [[ "${actionout[$i]}" = arpe && -n $numprocs ]]
+ then
+ files_for_pes=true; filetyp=directory
+ actionout[$i]="ar"
+ elif [[ "${actionout[$i]}" = arpe && ! -n $numprocs ]]
+ then
+ actionout[$i]="ar"
+ elif [[ "${actionout[$i]}" = flpe && -n $numprocs ]]
+ then
+ files_for_pes=true; filetyp=directory
+ actionout[$i]="fl"
+ elif [[ "${actionout[$i]}" = flpe && ! -n $numprocs ]]
+ then
+ actionout[$i]="fl"
+ elif [[ "${actionout[$i]}" = trpe && -n $numprocs ]]
+ then
+ files_for_pes=true; filetyp=directory
+ actionout[$i]="tr"
+ elif [[ "${actionout[$i]}" = trpe && ! -n $numprocs ]]
+ then
+ actionout[$i]="tr"
+ fi
+
+ if [[ ! -f ${localout[$i]} && $files_for_pes = false ]]
+ then
+ printf "\n +++ temporary OUTPUT-file ${localout[$i]} does not exist\n"
+ elif [[ ! -f ${localout[$i]}/_0000 && $files_for_pes = true ]]
+ then
+ printf "\n +++ temporary OUTPUT-file ${localout[$i]}/.... does not exist\n"
+ else
+
+
+ # KOPIEREN PER FTP/SCP (IMMER IM BINAERMODUS, -M: FALLS ZIELKATALOG
+ # NICHT VORHANDEN, WIRD VERSUCHT, IHN ANZULEGEN), ABER NUR BEI
+ # REMOTE-RECHNUNGEN
+ if [[ "${actionout[$i]}" = tr ]]
+ then
+ if [[ $localhost != $fromhost ]]
+ then
+ if [[ $files_for_pes = false ]]
+ then
+ cps=""
+ cst=""
+ else
+ cps=-c
+ cst="/"
+ fi
+ if [[ $localhost = ibmh || $localhost = ibmb || $localhost = nech ]]
+ then
+
+ # TRANSFER IN EIGENSTAENDIGEM JOB
+ # ZUERST KOPIE DER DATEI INS TEMPORAERE DATENVERZEICHNIS
+ [[ ! -d $tmp_data_catalog/TRANSFER ]] && mkdir -p $tmp_data_catalog/TRANSFER
+ file_to_transfer=${fname}_${localout[$i]}_to_transfer_$kennung
+ if [[ $files_for_pes = false ]]
+ then
+ ln -f ${localout[$i]} $tmp_data_catalog/TRANSFER/$file_to_transfer
+ else
+ mkdir $tmp_data_catalog/TRANSFER/$file_to_transfer
+ ln ${localout[$i]}/* $tmp_data_catalog/TRANSFER/$file_to_transfer
+ fi
+
+ echo "set -x" > transfer_${localout[$i]}
+ echo "cd $tmp_data_catalog/TRANSFER" >> transfer_${localout[$i]}
+
+ printf "\n >>> OUTPUT: ${localout[$i]}$cst by SCP in seperate job to"
+ printf "\n ${pathout[$i]}/${localhost}_${fname}${endout[$i]}$cst"
+ printf "\n or higher cycle\n"
+ echo "batch_scp $cps -b -m -u $return_username $return_addres $file_to_transfer \"${pathout[$i]}\" ${localhost}_${fname}${endout[$i]} ${extout[$i]}" >> transfer_${localout[$i]}
+
+ echo "[[ \$? = 0 ]] && rm $file_to_transfer" >> transfer_${localout[$i]}
+
+ if [[ $localhost = nech ]]
+ then
+ subjob -d -c /pf/b/$usern/job_queue -v -q pp -X 0 -m 1000 -t 900 transfer_${localout[$i]}
+ else
+ if [[ "$LOGNAME" = b323013 ]]
+ then
+ subjob -v -q c1 -X 0 -m 1000 -t 900 transfer_${localout[$i]}
+ else
+ subjob -d -v -q c1 -X 0 -m 1000 -t 900 transfer_${localout[$i]}
+ fi
+ fi
+
+ else
+
+ # TRANSFER INNERHALB DIESES JOBS
+ transfer_failed=false
+ printf "\n >>> OUTPUT: ${localout[$i]}$cst by SCP to"
+ printf "\n ${pathout[$i]}/${localhost}_${fname}${endout[$i]}$cst\n"
+ batch_scp $cps -b -m -u $return_username $return_addres ${localout[$i]} "${pathout[$i]}" ${localhost}_${fname}${endout[$i]} ${extout[$i]}
+ [[ $? != 0 ]] && transfer_failed=true
+
+ # BEI FEHLGESCHLAGENEM TRANSFER SICHERUNGSKOPIE AUF
+ # LOKALER MASCHINE ANLEGEN
+ if [[ $transfer_failed = true ]]
+ then
+ printf " +++ transfer failed. Trying to save a copy on the local host under:\n"
+ printf " ${pathout[$i]}/${localhost}_${fname}${endout[$i]}_$kennung\n"
+
+ # ERSTMAL PRUEFEN, OB VERZEICHNIS EXISTIERT. GEGEBENENFALLS
+ # ANLEGEN.
+ eval local_catalog=${pathout[$i]}
+ if [[ ! -d $local_catalog ]]
+ then
+ printf " *** local directory does not exist. Trying to create:\n"
+ printf " $local_catalog \n"
+ mkdir -p $local_catalog
+ fi
+ eval cp ${localout[$i]} ${pathout[$i]}/${localhost}_${fname}${endout[$i]}_$kennung
+ transfer_problems=true
+ fi
+ fi
+ else
+
+ # WERTZUWEISUNG, SO DASS WEITER UNTEN NUR KOPIERT WIRD
+ actionout[$i]=""
+ fi
+ fi
+
+
+ # APPEND PER FTP/SCP (IMMER IM BINAERMODUS, -M: FALLS ZIELKATALOG
+ # NICHT VORHANDEN, WIRD VERSUCHT, IHN ANZULEGEN), ABER NUR BEI
+ # REMOTE-RECHNUNGEN
+ if [[ "${actionout[$i]}" = tra ]]
+ then
+ if [[ $localhost != $fromhost ]]
+ then
+ if [[ $localhost = ibmh || $localhost = ibmb || $localhost = nech ]]
+ then
+
+ # TRANSFER IN EIGENSTAENDIGEM JOB
+ # ZUERST KOPIE DER DATEI INS TEMPORAERE DATENVERZEICHNIS
+ [[ ! -d $tmp_data_catalog/TRANSFER ]] && mkdir -p $tmp_data_catalog/TRANSFER
+ file_to_transfer=${fname}_${localout[$i]}_to_transfer_$kennung
+ ln -f ${localout[$i]} $tmp_data_catalog/TRANSFER/$file_to_transfer
+
+ echo "set -x" > transfer_${localout[$i]}
+ echo "cd $tmp_data_catalog/TRANSFER" >> transfer_${localout[$i]}
+
+ printf "\n >>> OUTPUT: ${localout[$i]} append by SCP in seperate job to"
+ printf "\n ${pathout[$i]}/${localhost}_${fname}${endout[$i]}"
+ printf "\n or higher cycle\n"
+ echo "batch_scp -A -b -m -u $return_username $return_addres $file_to_transfer \"${pathout[$i]}\" ${localhost}_${fname}${endout[$i]} ${extout[$i]}" >> transfer_${localout[$i]}
+
+ echo "[[ \$? = 0 ]] && rm $file_to_transfer" >> transfer_${localout[$i]}
+
+ if [[ $localhost = nech ]]
+ then
+ subjob -d -c /pf/b/$usern/job_queue -v -q pp -X 0 -m 1000 -t 900 transfer_${localout[$i]}
+ else
+ if [[ $LOGNAME = b323013 ]]
+ then
+ subjob -v -q c1 -X 0 -m 1000 -t 900 transfer_${localout[$i]}
+ else
+ subjob -d -v -q c1 -X 0 -m 1000 -t 900 transfer_${localout[$i]}
+ fi
+ fi
+
+ else
+
+ # TRANSFER INNERHALB DIESES JOBS
+ transfer_failed=false
+ printf "\n >>> OUTPUT: ${localout[$i]} append by SCP to"
+ printf "\n ${pathout[$i]}/${localhost}_${fname}${endout[$i]}\n"
+ batch_scp -A -b -m -u $return_username $return_addres ${localout[$i]} "${pathout[$i]}" ${localhost}_${fname}${endout[$i]} ${extout[$i]}
+ [[ $? != 0 ]] && transfer_failed=true
+
+ # BEI FEHLGESCHLAGENEM TRANSFER SICHERUNGSKOPIE AUF
+ # LOKALER MASCHINE ANLEGEN
+ if [[ $transfer_failed = true ]]
+ then
+ printf " +++ transfer failed. Trying to save a copy on the local host under:\n"
+ printf " ${pathout[$i]}/${localhost}_${fname}${endout[$i]}_$kennung\n"
+
+ # ERSTMAL PRUEFEN, OB VERZEICHNIS EXISTIERT. GEGEBENENFALLS
+ # ANLEGEN
+ eval local_catalog=${pathout[$i]}
+ if [[ ! -d $local_catalog ]]
+ then
+ printf " *** local directory does not exist. Trying to create:\n"
+ printf " $local_catalog \n"
+ mkdir -p $local_catalog
+ fi
+
+ eval cp ${localout[$i]} ${pathout[$i]}/${localhost}_${fname}${endout[$i]}_$kennung
+ transfer_problems=true
+ fi
+ fi
+ else
+
+ # WERTZUWEISUNG, SO DASS WEITER UNTEN NUR APPEND AUF
+ # LOKALER MASCHINE DURCHGEFUEHRT WIRD
+ actionout[$i]=a
+ fi
+ fi
+
+
+ # OUTPUT-DATEI FUER EINEN FORTSETZUNGSLAUF. DATEI WIRD PER
+ # LINK AUF DEN TEMPORAEREN DATENKATALOG GELEGT. OPTION -f WIRD
+ # VERWENDET, FALLS DORT NOCH EINE DATEI GLEICHEN NAMENS VORHANDEN
+ # SEIN SOLLTE. ANSCHLIESSEND WIRD SEINE ARCHIVIERUNG ANGESTOSSEN
+ if [[ "${actionout[$i]}" = fl ]]
+ then
+ [[ ! -d $tmp_data_catalog ]] && mkdir -p $tmp_data_catalog
+ chmod g+rx $tmp_data_catalog
+ if [[ $files_for_pes = false ]]
+ then
+ printf "\n >>> OUTPUT: ${localout[$i]} to"
+ printf "\n $tmp_data_catalog/${frelout[$i]} (temporary data catalog)\n"
+ ln -f ${localout[$i]} $tmp_data_catalog/${frelout[$i]}
+ else
+ printf "\n >>> OUTPUT: ${localout[$i]}/.... to"
+ printf "\n $tmp_data_catalog/${frelout[$i]} (temporary data catalog)\n"
+ mkdir $tmp_data_catalog/${frelout[$i]}
+ ln -f ${localout[$i]}/* $tmp_data_catalog/${frelout[$i]}
+ fi
+
+
+ # ARCHIVIERUNGSJOB WIRD ERZEUGT UND ABGESCHICKT
+ if [[ $store_on_archive_system = true ]]
+ then
+
+ if [[ $archive_system = asterix ]]
+ then
+ echo "cd $tmp_data_catalog" >> archive_${frelout[$i]}
+ if [[ $files_for_pes = false ]]
+ then
+ echo "stageout ${frelout[$i]} > STAGE_OUTPUT${i}_$kennung" >> archive_${frelout[$i]}
+ else
+ echo "stageout -t ${frelout[$i]} > STAGE_OUTPUT${i}_$kennung" >> archive_${frelout[$i]}
+ fi
+ echo "cat STAGE_OUTPUT${i}_$kennung" >> archive_${frelout[$i]}
+ echo "if [[ \$(grep -c \"st.msg:150\" STAGE_OUTPUT${i}_$kennung) != 0 ]]" >> archive_${frelout[$i]}
+ echo "then" >> archive_${frelout[$i]}
+ echo " do_stageout=false" >> archive_${frelout[$i]}
+ echo "else" >> archive_${frelout[$i]}
+ echo " echo \" +++ $filetyp ${frelout[$i]} could not be stored on archive-system\" " >> archive_${frelout[$i]}
+ echo " cat /dev/null > ~/job_queue/ARCHIVE_ERROR_$fname" >> archive_${frelout[$i]}
+ echo " cat STAGE_OUTPUT${i}_$kennung > ~/job_queue/archive_${frelout[$i]}_error" >> archive_${frelout[$i]}
+ echo " echo \" *** $filetyp ${frelout[$i]} will be copied to \$WORK as backup\" " >> archive_${frelout[$i]}
+ if [[ $files_for_pes = false ]]
+ then
+ echo " cp ${frelout[$i]} \$WORK" >> archive_${frelout[$i]}
+ else
+ echo " cp -r ${frelout[$i]} \$WORK/${frelout[$i]}" >> archive_${frelout[$i]}
+ fi
+ echo " echo \" *** $filetyp ${frelout[$i]} saved\" " >> archive_${frelout[$i]}
+ echo "fi" >> archive_${frelout[$i]}
+ echo "rm STAGE_OUTPUT${i}_$kennung" >> archive_${frelout[$i]}
+ elif [[ $archive_system = DMF ]]
+ then
+ echo "cd $tmp_data_catalog" >> archive_${frelout[$i]}
+ if [[ $files_for_pes = false ]]
+ then
+ printf "\n +++ archiving of single files impossible with $archive_system !\n"
+ locat=DMF
+ exit
+ else
+ # FUER RECHNER IN JUELICH. DORT KOENNTEN AUCH
+ # EINZELNE DATEIEN GESICHERT WERDEN (SPAETER KORR.)
+ echo "rm -rf \$ARCHIVE/${frelout[$i]}" >> archive_${frelout[$i]}
+ echo "cp -r ${frelout[$i]} \$ARCHIVE" >> archive_${frelout[$i]}
+ fi
+ elif [[ $archive_system = tivoli ]]
+ then
+ echo "cd $tmp_data_catalog" >> archive_${frelout[$i]}
+ if [[ $files_for_pes = false ]]
+ then
+ # EVENTUELL NOCH VORHANDENE DATEI IM ARCHIV LOSCHEN
+ echo "set -x" >> archive_${frelout[$i]}
+ echo "rm -rf \$PERM/${frelout[$i]}" >> archive_${frelout[$i]}
+ echo "cp ${frelout[$i]} \$PERM/${frelout[$i]}" >> archive_${frelout[$i]}
+ else
+
+ echo "set -x" >> archive_${frelout[$i]}
+ echo "rm -rf \$PERM/${frelout[$i]}/*" >> archive_${frelout[$i]}
+ echo "[[ ! -d \$PERM/${frelout[$i]} ]] && mkdir $PERM/${frelout[$i]}" >> archive_${frelout[$i]}
+ cd $tmp_data_catalog
+ all_files=`ls -1 ${frelout[$i]}/*`
+ cd - > /dev/null
+ (( inode = 0 ))
+ (( tp1 = tasks_per_node + 1 ))
+ while (( inode < nodes ))
+ do
+# echo "*** all_files = \"$all_files\" "
+ files=`echo $all_files | cut -d" " -f1-$tasks_per_node`
+ all_files=`echo $all_files | cut -d" " -f$tp1-`
+# echo "*** tasks_per_node = \"$tasks_per_node\" "
+# echo "*** files = \"$files\" "
+# echo "*** all_files = \"$all_files\" "
+ echo "tar cvf \$PERM/${frelout[$i]}/${frelout[$i]}.node_$inode.tar $files" >> archive_${frelout[$i]}
+ echo "dsmc incremental \$PERM/${frelout[$i]}/${frelout[$i]}.node_$inode.tar" >> archive_${frelout[$i]}
+ echo "dsmmigrate \$PERM/${frelout[$i]}/${frelout[$i]}.node_$inode.tar" >> archive_${frelout[$i]}
+ (( inode = inode + 1 ))
+ done
+# echo "rm -rf \$PERM/${frelout[$i]}.tar" >> archive_${frelout[$i]}
+# echo "tar cvf \$PERM/${frelout[$i]}.tar ${frelout[$i]}" >> archive_${frelout[$i]}
+ fi
+ elif [[ $archive_system = ut ]]
+ then
+ echo "cd $tmp_data_catalog" >> archive_${frelout[$i]}
+ if [[ $files_for_pes = false ]]
+ then
+ # EVENTUELL NOCH VORHANDENE DATEI IM ARCHIV LOSCHEN
+ echo "set -x" >> archive_${frelout[$i]}
+ echo "rm -rf \$UT/${frelout[$i]}" >> archive_${frelout[$i]}
+ echo "cp ${frelout[$i]} \$UT/${frelout[$i]}" >> archive_${frelout[$i]}
+ else
+
+ echo "set -x" >> archive_${frelout[$i]}
+ echo "rm -rf \$UT/${frelout[$i]}/*" >> archive_${frelout[$i]}
+ echo "[[ ! -d \$UT/${frelout[$i]} ]] && mkdir $UT/${frelout[$i]}" >> archive_${frelout[$i]}
+ cd $tmp_data_catalog
+ all_files=`ls -1 ${frelout[$i]}/*`
+ cd - > /dev/null
+ (( inode = 0 ))
+ (( tp1 = tasks_per_node + 1 ))
+ while (( inode < nodes ))
+ do
+ files=`echo $all_files | cut -d" " -f1-$tasks_per_node`
+ all_files=`echo $all_files | cut -d" " -f$tp1-`
+ echo "tar cvf \$UT/${frelout[$i]}/${frelout[$i]}.node_$inode.tar $files" >> archive_${frelout[$i]}
+ (( inode = inode + 1 ))
+ done
+ fi
+ elif [[ $archive_system = none ]]
+ then
+ printf " +++ archiving on $localhost not available!\n"
+ fi
+
+ if [[ $archive_system != none ]]
+ then
+ if [[ $localhost = ibmh || $localhost = ibmb ]]
+ then
+# subjob -d -v -q cdata -X 0 -m 1000 -t 43200 archive_${frelout[$i]}
+ subjob -v -q cdata -X 0 -m 1000 -t 43200 archive_${frelout[$i]}
+ elif [[ $localhost = nech ]]
+ then
+ subjob -d -c /pf/b/$usern/job_queue -v -q pp -X 0 -m 1000 -t 7200 archive_${frelout[$i]}
+ fi
+ printf " Archiving of $tmp_data_catalog/${frelout[$i]} initiated (batch job submitted)\n"
+ fi
+ else
+ printf " +++ caution: option -A is switched on. No archiving on $archive_system!\n"
+ fi
+
+
+ # LEERDATEI IM BENUTZERVERZEICHNIS ANLEGEN, DAMIT BEKANNT IST,
+ # WIE DIE HOECHSTE ZYKLUSNUMMER AUF DEM ARCHIV-SYSTEM LAUTET
+ if [[ $files_for_pes = false ]]
+ then
+ cat /dev/null > ${pathout[$i]}
+ else
+ mkdir -p ${pathout[$i]}
+ fi
+
+ fi
+
+
+ # KOPIEREN AUF LOKALER MASCHINE ZUM ARCHIV-SYSTEM
+ # AUSSERDEM MUSS LEERDATEI ANGELEGT WERDEN, DAMIT BEKANNT IST,
+ # WIE DIE HOECHSTE ZYKLUSNUMMER AUF DEM ARCHIV-SYSTEM LAUTET
+ # FALLS IRGENDEINE (VON MEHREREN) ARCHIVIERUNGEN SCHIEF GEHT,
+ # WIRD FLAG GESETZT UND BLEIBT AUCH BEI WEITEREN ORDNUNGS-
+ # GEMAESSEN ARCHIVIERUNGEN GESETZT
+ if [[ "${actionout[$i]}" = ar ]]
+ then
+ if [[ $files_for_pes = false ]]
+ then
+ printf "\n >>> OUTPUT: ${localout[$i]} to"
+ printf "\n ${pathout[$i]}"
+ printf "\n File will be copied to archive-system ($archive_system) !\n"
+ else
+ printf "\n >>> OUTPUT: ${localout[$i]}/_.... to"
+ printf "\n ${pathout[$i]}"
+ printf "\n Directory will be copied to archive-system ($archive_system) !\n"
+ fi
+ mv ${localout[$i]} ${frelout[$i]}
+
+ file_saved=false
+
+ if [[ $archive_system = asterix ]]
+ then
+ do_stageout=true
+ (( stageout_anz = 0 ))
+ while [[ $do_stageout = true ]]
+ do
+ if [[ $files_for_pes = false ]]
+ then
+ stageout ${frelout[$i]} > STAGE_OUTPUT
+ else
+ stageout -t ${frelout[$i]} > STAGE_OUTPUT
+ fi
+ cat STAGE_OUTPUT
+ if [[ $(grep -c "st.msg:150" STAGE_OUTPUT) != 0 ]]
+ then
+ file_saved=true
+ do_stageout=false
+ else
+ if [[ $files_for_pes = false ]]
+ then
+ printf "\n +++ file ${frelout[$i]} could not be saved on archive-system"
+ else
+ printf "\n +++ directory ${frelout[$i]} could not be saved on archive-system"
+ fi
+ (( stageout_anz = stageout_anz + 1 ))
+ if (( stageout_anz == 10 ))
+ then
+ printf "\n +++ stoped after 10 unsuccessful tries!"
+ archive_save=false
+ do_stageout=false
+ else
+ printf "\n *** new try to store on archive after 15 min:"
+ sleep 900
+ fi
+ fi
+ done
+ elif [[ $archive_system = DMF ]]
+ then
+ if [[ $files_for_pes = false ]]
+ then
+ printf "\n +++ archiving of single files impossible on $archive_system!\n"
+ locat=DMF
+ exit
+ else
+ rm -rf $ARCHIVE/${frelout[$i]}
+ cp -r ${frelout[$i]} $ARCHIVE
+ fi
+ file_saved=true
+ elif [[ $archive_system = tivoli ]]
+ then
+ # ARCHIVIERUNG NUR PER BATCH-JOB MOEGLICH
+ # DATEI MUSS ZWISCHENZEITLICH INS TEMPORAERE DATENVERZEICHNIS
+ # GELEGT WERDEN
+ [[ ! -d $tmp_data_catalog ]] && mkdir -p $tmp_data_catalog
+ chmod g+rx $tmp_data_catalog
+ if [[ $files_for_pes = false ]]
+ then
+ ln -f ${frelout[$i]} $tmp_data_catalog/${frelout[$i]}
+ else
+ mkdir $tmp_data_catalog/${frelout[$i]}
+ ln -f ${frelout[$i]}/* $tmp_data_catalog/${frelout[$i]}
+ fi
+
+ # BATCH JOB GENERIEREN UND ABSCHICKEN; DATEI MUSS WIEDER
+ # AUS TEMPORAEREM DATENVERZEICHNIS ENTFERNT WERDEN
+ echo "cd $tmp_data_catalog" > archive_${frelout[$i]}
+ if [[ $files_for_pes = false ]]
+ then
+ # EVENTUELL NOCH VORHANDENE DATEI IM ARCHIV LOSCHEN
+ echo "rm -rf \$PERM/${frelout[$i]}" >> archive_${frelout[$i]}
+ echo "cp ${frelout[$i]} \$PERM/${frelout[$i]}" >> archive_${frelout[$i]}
+ echo "rm -rf ${frelout[$i]}" >> archive_${frelout[$i]}
+ else
+ echo "rm -rf \$PERM/${frelout[$i]}.tar" >> archive_${frelout[$i]}
+ echo "tar cvf \$PERM/${frelout[$i]}.tar ${frelout[$i]}" >> archive_${frelout[$i]}
+ echo "rm -rf ${frelout[$i]}" >> archive_${frelout[$i]}
+ fi
+
+ subjob -v -d -q cdata -X 0 -m 1000 -t 43200 archive_${frelout[$i]}
+ printf " Archiving of $tmp_data_catalog/${frelout[$i]} initiated (batch job submitted)\n"
+ file_saved=true
+
+ elif [[ $archive_system = ut ]]
+ then
+ # ARCHIVIERUNG NUR PER BATCH-JOB MOEGLICH
+ # DATEI MUSS ZWISCHENZEITLICH INS TEMPORAERE DATENVERZEICHNIS
+ # GELEGT WERDEN
+ [[ ! -d $tmp_data_catalog ]] && mkdir -p $tmp_data_catalog
+ chmod g+rx $tmp_data_catalog
+ if [[ $files_for_pes = false ]]
+ then
+ ln -f ${frelout[$i]} $tmp_data_catalog/${frelout[$i]}
+ else
+ mkdir $tmp_data_catalog/${frelout[$i]}
+ ln -f ${frelout[$i]}/* $tmp_data_catalog/${frelout[$i]}
+ fi
+
+ # BATCH JOB GENERIEREN UND ABSCHICKEN; DATEI MUSS WIEDER
+ # AUS TEMPORAEREM DATENVERZEICHNIS ENTFERNT WERDEN
+ echo "cd $tmp_data_catalog" > archive_${frelout[$i]}
+ if [[ $files_for_pes = false ]]
+ then
+ # EVENTUELL NOCH VORHANDENE DATEI IM ARCHIV LOSCHEN
+ echo "rm -rf \$UT/${frelout[$i]}" >> archive_${frelout[$i]}
+ echo "cp ${frelout[$i]} \$UT/${frelout[$i]}" >> archive_${frelout[$i]}
+ echo "rm -rf ${frelout[$i]}" >> archive_${frelout[$i]}
+ else
+ echo "rm -rf \$UT/${frelout[$i]}.tar" >> archive_${frelout[$i]}
+ echo "tar cvf \$UT/${frelout[$i]}.tar ${frelout[$i]}" >> archive_${frelout[$i]}
+ echo "rm -rf ${frelout[$i]}" >> archive_${frelout[$i]}
+ fi
+
+ subjob -v -c /pf/b/$usern/job_queue -d -q pp -X 0 -m 1000 -t 7200 archive_${frelout[$i]}
+ printf " Archiving of $tmp_data_catalog/${frelout[$i]} initiated (batch job submitted)\n"
+ file_saved=true
+
+ else
+ printf "\n +++ archive_system=\"$archive_system\" archiving impossible!"
+ archive_save=false
+ fi
+ if [[ $file_saved = true ]]
+ then
+ if [[ $files_for_pes = false ]]
+ then
+ cat /dev/null > ${pathout[$i]}
+ else
+ mkdir -p ${pathout[$i]}
+ fi
+ fi
+ fi
+
+ # APPEND AUF LOKALER MASCHINE
+ if [[ "${actionout[$i]}" = "a" ]]
+ then
+ printf "\n >>> OUTPUT: ${localout[$i]} append to ${pathout[$i]}\n"
+ cat ${localout[$i]} >> ${pathout[$i]}
+ fi
+
+ # KOPIEREN AUF LOKALER MASCHINE
+ # ES MUSS KOPIERT WERDEN, DA MOVE NICHT UEBER FILESYSTEM HINAUS MOEGLICH
+ if [[ "${actionout[$i]}" = "" && $files_for_pes = false ]]
+ then
+
+ # KOPIEREN AUF EINPROZESSORMASCHINE
+ if [[ "${extout[$i]}" != " " && "${extout[$i]}" != "" ]]
+ then
+ printf "\n >>> OUTPUT: ${localout[$i]} to ${pathout[$i]}.${extout[$i]}\n"
+ cp ${localout[$i]} ${pathout[$i]}.${extout[$i]}
+ else
+ printf "\n >>> OUTPUT: ${localout[$i]} to ${pathout[$i]}\n"
+ cp ${localout[$i]} ${pathout[$i]}
+ fi
+
+ elif [[ "${actionout[$i]}" = "" && $files_for_pes = true ]]
+ then
+
+ # DIE DEN PROZESSOREN EINES PARALLELRECHNERS ZUGEHOERIGEN
+ # DATEIEN WERDEN ERST IN EINEM KATALOG GESAMMELT UND DIESER
+ # WIRD DANN KOPIERT
+ # PER MOVE UMBENANNT WERDEN
+ printf "\n >>> OUTPUT: ${localout[$i]}/_.... to ${pathout[$i]}\n"
+ cp -r ${localout[$i]} ${pathout[$i]}
+
+ fi
+ fi
+ done
+ if (( i != 0 ))
+ then
+ if [[ $transfer_problems = true ]]
+ then
+ printf "\n$striche\n *** OUTPUT-files saved"
+ printf "\n +++ WARNING: some data transfers failed! \n"
+ else
+ printf "\n$striche\n *** all OUTPUT-files saved \n"
+ fi
+ fi
+
+
+ # EVENTUELL FOLGEJOB STARTEN
+ # DATEI CONTINUE_RUN MUSS VOM BENUTZERPROGRAMM AUS ERZEUGT WERDEN
+ if [[ -f CONTINUE_RUN ]]
+ then
+
+ if [[ $archive_save = true ]]
+ then
+
+ # ZUERST IN MRUN-AUFRUF OPTIONEN FUER FORTSETZUNGSLAUF, FUER
+ # STILLES ABARBEITEN (OHNE INTERAKTIVE RUECKFAGEN) UND FUER
+ # BATCH-BETRIEB (NUR WICHTIG, FALLS BATCH AUF LOKALER MASCHINE
+ # DURCHGEFUEHRT WERDEN SOLL) EINFUEGEN, FALLS NICHT BEREITS VOR-
+ # HANDEN
+ [[ $(echo $mc | grep -c "\-C") = 0 ]] && mc="$mc -C"
+ [[ $(echo $mc | grep -c "\-v") = 0 ]] && mc="$mc -v"
+ [[ $(echo $mc | grep -c "\-b") = 0 ]] && mc="$mc -b"
+ if [[ $(echo $mc | grep -c "#") != 0 ]]
+ then
+ mc=`echo $mc | sed 's/#/f/g'`
+ fi
+
+
+ # JOB STARTEN
+ printf "\n\n *** initiating restart-run on \"$return_addres\" using command:\n"
+ echo " $mc"
+ printf "\n$striche\n"
+ if [[ $localhost != $fromhost ]]
+ then
+
+ if [[ $localhost = nech || $localhost = ibmb || $localhost = ibmh || $localhost = ibms || $localhost = lctit ]]
+ then
+ echo "*** ssh will be used to initiate restart-runs!"
+ echo " return_addres=\"$return_addres\" "
+ echo " return_username=\"$return_username\" "
+ if [[ $return_addres = 172.20.25.41 ]]
+ then
+ # WORKAROUND AUF SCIROCCO AM TIT
+ print "PATH=\$PATH:$LOCAL_MRUN_PATH;export PALM_BIN=$LOCAL_MRUN_PATH;cd $LOCAL_PWD; $mc " | ssh $return_addres -l $return_username
+ else
+ ssh $return_addres -l $return_username "PATH=\$PATH:$LOCAL_MRUN_PATH;export PALM_BIN=$LOCAL_MRUN_PATH;cd $LOCAL_PWD; $mc "
+ fi
+ else
+ printf "\n +++ no restart mechanism available for host \"$localhost\" "
+ locat=restart; exit
+ fi
+
+ # WARTEN, DAMIT SICH RESTART JOB IN QUEUE EINREIHEN KANN, BEVOR
+ # DER AKTUELLE JOB ENDET
+ sleep 30
+
+ else
+
+ # BEI RECHNUNGEN AUF LOKALER MASCHINE KANN MRUN DIREKT AUFGE-
+ # RUFEN WERDEN, AUSSER AUF lcfimm
+ cd $LOCAL_PWD
+ if [[ $localhost = lcfimm ]]
+ then
+ ssh $return_addres -l $return_username "PATH=\$PATH:$LOCAL_MRUN_PATH;export PALM_BIN=$LOCAL_MRUN_PATH;cd $LOCAL_PWD; $mc "
+ else
+ eval $mc # ' MUESSEN AUSGEWERTET WERDEN
+ fi
+ cd - > /dev/null
+ fi
+ printf "\n$striche\n *** restart-run initiated \n"
+
+
+ # EVENTUELL INPUT-DATEIEN, DIE VON TEMPORAEREM DATENVERZEICHNIS
+ # GEHOLT WORDEN SIND, LOESCHEN
+ (( i = 0 ))
+ while (( i < iin ))
+ do
+ (( i = i + 1 ))
+ if [[ "${got_tmp[$i]}" = true && $keep_data_from_previous_run = false ]]
+ then
+ rm -r $tmp_data_catalog/${frelin[$i]}
+ fi
+ done
+
+ else
+
+ printf "\n +++ no restart-run possible, since errors occured"
+ printf "\n during the archive process"
+ fi
+
+ fi
+
+
+
+ # EVTL. EMAIL-BENACHRICHTIGUNG UEBER ABGESCHLOSSENEN LAUF
+ if [[ "$email_notification" != "" ]]
+ then
+
+ if [[ $localhost != $fromhost ]]
+ then
+ if [[ -f CONTINUE_RUN ]]
+ then
+ echo "PALM restart run necessary" > email_text
+ echo "description header of actual run:" >> email_text
+ cat CONTINUE_RUN >> email_text
+ echo "mrun-command to restart:" >> email_text
+ echo "$mc" >> email_text
+ else
+ echo "PALM run with base filename \"$fname\" on host \"$localhost\" finished" > email_text
+ fi
+ mail $email_notification < email_text
+ printf "\n *** email notification sent to \"$email_notification\" "
+ fi
+ fi
+
+
+
+ # ALLE ARBEITEN BEENDET. TEMPORAERER KATALOG KANN GELOESCHT WERDEN
+ cd $HOME
+ [[ $delete_temporary_catalog = true ]] && rm -rf $TEMPDIR
+
+ else
+
+
+ # FALLS AUF REMOTE-MASCHINE GERECHNET WERDEN SOLL, WERDEN JETZT ENTSPRE-
+ # CHENDE AKTIONEN DURCHGEFUEHRT
+
+ # MRUN-BEFEHL FUER REMOTE-MASCHINE ZUSAMMENSTELLEN
+ mrun_com="$mrun_script_name -a $afname -c $config_file -d $fname -h $host -H $fromhost -m $memory -t $cpumax -q $queue -R $return_addres -U $return_username -u $remote_username"
+ [[ "$cpp_opts" != "" ]] && mrun_com=${mrun_com}" -D \"$cpp_opts\""
+ [[ "$global_revision" != "" ]] && mrun_com=${mrun_com}" -G \"$global_revision\""
+ [[ $group_number != none ]] && mrun_com=${mrun_com}" -g $group_number"
+ [[ $do_compile = true ]] && mrun_com=${mrun_com}" -s \"$source_list\""
+ [[ "$input_list" != "" ]] && mrun_com=${mrun_com}" -i \"$input_list\""
+ [[ $ignore_archive_error = true ]] && mrun_com=${mrun_com}" -I"
+ [[ $keep_data_from_previous_run = true ]] && mrun_com=${mrun_com}" -k"
+ [[ "$additional_conditions" != "" ]] && mrun_com=${mrun_com}" -K \"$additional_conditions\""
+# [[ "$makefile" != "$source_path/Makefile" ]] && mrun_com=${mrun_com}" -M \"$makefile\""
+ [[ "$output_list" != "" ]] && mrun_com=${mrun_com}" -o \"$output_list\""
+ [[ "$read_from_config" = false ]] && mrun_com=${mrun_com}" -S"
+ [[ $do_trace = true ]] && mrun_com=${mrun_com}" -x"
+ [[ "$numprocs" != "" ]] && mrun_com=${mrun_com}" -X $numprocs"
+ if [[ $use_openmp = true ]]
+ then
+ mrun_com=${mrun_com}" -O"
+ [[ "$tasks_per_node" != "" ]] && mrun_com=${mrun_com}" -T $threads_per_task"
+ else
+ [[ "$tasks_per_node" != "" ]] && mrun_com=${mrun_com}" -T $tasks_per_node"
+ fi
+ [[ $store_on_archive_system = false ]] && mrun_com=${mrun_com}" -A"
+ [[ $package_list != "" ]] && mrun_com=${mrun_com}" -p \"$package_list\""
+ [[ $return_password != "" ]] && mrun_com=${mrun_com}" -P $return_password"
+ [[ $delete_temporary_catalog = false ]] && mrun_com=${mrun_com}" -B"
+ [[ $node_usage != default && "$(echo $node_usage | cut -c1-3)" != "sla" && $node_usage != novice ]] && mrun_com=${mrun_com}" -n $node_usage"
+ [[ $run_coupled_model = true ]] && mrun_com=${mrun_com}" -Y"
+ if [[ $do_remote = true ]]
+ then
+ printf "\n>>>> MRUN-command on execution host:\n>>>> $mrun_com \n"
+ fi
+
+
+ # ZUSAMMENSTELLUNG DES JOBSCRIPTS AUF DATEI jobfile
+ jobfile=jobfile.$RANDOM
+
+
+ # TEMPORAERES VERZEICHNIS GENERIEREN UND NACH DORT WECHSELN
+ echo "mkdir $TEMPDIR" >> $jobfile
+ echo "cd $TEMPDIR" >> $jobfile
+
+
+ # EVENTUELL FEHLERVERFOLGUNG AKTIVIEREN
+ if [[ $do_trace = true ]]
+ then
+ echo "set -x" >> $jobfile
+ else
+ echo "set +vx" >> $jobfile
+ fi
+
+
+ # ABSPEICHERN DER QUELLTEXTE (NUR FALLS UEBERSETZT WERDEN SOLL)
+ # SOWIE GEGEBENENFALLS DES MAKEFILES
+ if [[ $do_compile = true ]]
+ then
+
+ source_catalog=SOURCES_FOR_RUN_$fname
+
+ # UNTERVERZEICHNIS FUER QUELLTEXTE UND MAKEFILE ANLEGEN
+ # MRUN WIRD DIESES VRZEICHNIS UEBER ENVIRONMENT VARIABLE
+ # MITGETEILT (UEBERSTEUERT ANGABE IN KONFIGURATIONSDATEI)
+ echo "mkdir SOURCES_FOR_RUN_$fname" >> $jobfile
+ echo "export SOURCES_COMPLETE=true" >> $jobfile
+ echo "cd SOURCES_FOR_RUN_$fname" >> $jobfile
+
+ for filename in $source_list
+ do
+ # ABDECKZEICHEN VERHINDERN, DASS ERSETZUNGEN ERFOLGEN
+ echo "cat > $filename << \"%END%\"" >> $jobfile
+ cat $source_catalog/$filename >> $jobfile
+ echo " " >> $jobfile
+ echo "%END%" >> $jobfile
+ echo " " >> $jobfile
+ done
+
+ # ABDECKZEICHEN VERHINDERN, DASS ERSETZUNGEN ERFOLGEN
+ echo "cat > Makefile << \"%END%\"" >> $jobfile
+ cat $source_catalog/Makefile >> $jobfile
+ echo " " >> $jobfile
+ echo "%END%" >> $jobfile
+ echo " " >> $jobfile
+
+ echo "cd - > /dev/null" >> $jobfile
+
+ fi
+
+
+ # ABSPEICHERN DER KONFIGURATIONSDATEI
+ # ABDECKZEICHEN VERHINDERN, DASS ERSETZUNGEN ERFOLGEN
+ echo "cat > $config_file << \"%END%\"" >> $jobfile
+ cat $config_file >> $jobfile
+ echo "%END%" >> $jobfile
+ echo " " >> $jobfile
+
+
+ # ABSPEICHERN DER AKTUELLEN MRUN-VERSION
+ # ABDECKZEICHEN VERHINDERN, DASS ERSETZUNGEN ERFOLGEN
+ echo "cat > $mrun_script_name <<\"%END%\"" >> $jobfile
+ cat ${PALM_BIN}/$mrun_script_name >> $jobfile
+ echo "%END%" >> $jobfile
+ if [[ $host = lctit ]]
+ then
+ echo "sed 's/bin\/ksh/home2\/usr5\/mkanda\/pub\/ksh/' < $mrun_script_name > mrun_new" >> $jobfile
+ echo "mv mrun_new $mrun_script_name" >> $jobfile
+ fi
+ echo "chmod u+x $mrun_script_name" >> $jobfile
+ echo "execute_mrun=true" >> $jobfile
+ echo " " >> $jobfile
+
+ # EVTL. BENOETIGTE INPUT-DATEIEN PER FTP HOLEN ODER DEM JOB DIREKT
+ # MITGEBEN UND AUF DEM REMOTE-RECHNER IM BENUTZERVERZEICHNIS ABLEGEN
+ # FALLS DIESES NICHT EXISTIERT, WIRD VERSUCHT, DAS JEWEILS LETZTE
+ # UNTERVERZEICHNIS DES PFADNAMENS ANZULEGEN
+ if [[ $do_remote = true ]]
+ then
+ (( i = 0 ))
+ while (( i < iin ))
+ do
+ (( i = i + 1 ))
+ echo "[[ ! -d ${pathin[$i]} ]] && mkdir -p ${pathin[$i]}" >> $jobfile
+ if [[ "${transin[$i]}" = job ]]
+ then
+ echo "cat > ${remotepathin[$i]} <<\"%END%\"" >> $jobfile
+ eval cat ${pathin[$i]}/${frelin[$i]} >> $jobfile
+ echo " " >> $jobfile
+ echo "%END%" >> $jobfile
+ else
+ echo "batch_scp -b -o -g -s -u $return_username $return_addres ${remotepathin[$i]} \"${pathin[$i]}\" ${frelin[$i]}" >> $jobfile
+ fi
+
+ # UEBERPRUEFEN, OB DATEI ANGELEGT WERDEN KONNTE
+ echo "if [[ \$? = 1 ]]" >> $jobfile
+ echo "then" >> $jobfile
+ echo " echo \" \" " >> $jobfile
+ echo " echo \"+++ file ${remotepathin[$i]} could not be created\" " >> $jobfile
+ echo " echo \" please check, if directory exists on $host!\" " >> $jobfile
+ echo " echo \"+++ MRUN will not be continued\" " >> $jobfile
+ echo " execute_mrun=false" >> $jobfile
+ echo "fi" >> $jobfile
+ done
+ fi
+
+ # ARBEITSKATALOG AUF DER LOKALEN MASCHINE FUER EVENTUELLE
+ # FORTSETZUNGSLAUEFE PER ENV-VARIABLE UEBERGEBEN
+ echo "LOCAL_PWD=$working_directory" >> $jobfile
+ echo "export LOCAL_PWD" >> $jobfile
+
+ # EBENSO LOKALEN MRUN-KATALOG UEBERGEBEN
+ echo "LOCAL_MRUN_PATH=$PALM_BIN" >> $jobfile
+ echo "export LOCAL_MRUN_PATH" >> $jobfile
+
+ # WORKAROUND FUER RIAM-NEC-JOBS WEGEN PROFILE-SCHWIERIGKEITEN
+ if [[ $localhost_realname = "gate" || $localhost = lctit ]]
+ then
+ echo "export PALM_BIN=$PALM_BIN" >> $jobfile
+ fi
+
+ # MRUN AUF ZIELRECHNER AUFRUFEN
+ echo "set -x" >> $jobfile
+ echo "[[ \$execute_mrun = true ]] && ./$mrun_com" >> $jobfile
+
+ echo 'ls -al; echo `pwd`' >> $jobfile
+ echo "cd \$HOME" >> $jobfile
+ echo "rm -rf $TEMPDIR" >> $jobfile
+
+
+
+
+ # JOB PER SUBJOB STARTEN
+ if [[ $silent = false ]]
+ then
+ printf "\n "
+ else
+ printf "\n\n"
+ fi
+
+ subjob $job_on_file -h $host -u $remote_username -g $group_number -q $queue -m $memory -N $node_usage -t $cpumax $XOPT $TOPT $OOPT -n $fname -v $jobfile
+ rm -rf $jobfile
+
+
+ fi # ENDE REMOTE-TEIL
+
+
+
+ # ENDE DER PROZEDUR
Index: /palm/tags/release-3.4a/SCRIPTS/subjob
===================================================================
--- /palm/tags/release-3.4a/SCRIPTS/subjob (revision 141)
+++ /palm/tags/release-3.4a/SCRIPTS/subjob (revision 141)
@@ -0,0 +1,1059 @@
+#!/bin/ksh
+# subjob - Plot-Shellskript Version: @(#)SUBJOB 1.0
+# $Id: subjob 54 2007-03-08 00:00:02Z raasch $
+
+ # Prozedur zum automatischen Generieren von Batch-Jobs, die unter NQS
+ # laufen sollen und deren Ergebnis (Dayfile) zum Job-generierenden
+ # Host zurueckgeschickt werden sollen
+
+
+ # letzte Aenderung:
+ # 29/06/94 - Siggi - Beginn mit Erstellung der Originalversion
+ # 08/07/94 - Siggi - Originalversion abgeschlossen (Version 1.0)
+ # 06/02/98 - Siggi - berte validiert
+ # 27/01/01 - Siggi - ground.yonsei.ac.kr validiert, Jobs zur T3E in Korea
+ # moeglich
+ # 08/02/01 - Siggi - alle subjob-Meldungen ins englische uebersetzt
+ # 25/05/02 - Siggi - Unterstuetzung des LoadLeveler
+ # 30/05/02 - Siggi - Validierung fuer ibm-Rechner in Seoul (nobel) sowie
+ # allgemeine Anpassungen fuer ibm-Rechner
+ # 15/10/02 - Siggi - Neue Default-Jobklasse (p_normal) fuer IBM in Seoul
+ # Ruecktransfer des Jobprotokolls fuer diese
+ # Maschine abgeschaltet
+ # 31/10/02 - Siggi - berni validiert
+ # 06/11/02 - Siggi - Neue Jobklassen auf ibmb und ibmh
+ # 08/11/02 - Siggi - quanero validiert
+ # 11/12/02 - Siggi - Notification fuer Transfer-Jobs abgeschaltet
+ # 23/01/03 - Siggi - hostname nobel changed to nobela
+ # 06/02/03 - Siggi - gregale validated
+ # 12/02/03 - Siggi - orkan and maestro validated
+ # 21/02/03 - Siggi - all nobel nodes in Seoul validated
+ # 12/03/03 - Siggi - nec at DKRZ validated
+ # 13/03/03 - Siggi - new nqs resource variable Memory
+ # 07/04/03 - Siggi - processor request option -c on nech needs tasks per
+ # node
+ # 11/04/03 - Siggi - network on ibms has attribute "shared"
+ # 31/07/03 - Siggi - nqs2 on nech implemented (provisional: -h nech2)
+ # cxxl added to ibmh
+ # 29/08/03 - Siggi - changes in job queues and communication system on
+ # ibms
+ # 24/10/03 - Siggi - using alternate hanni address 130.75.4.2
+ # 30/10/03 - Siggi - nech is not supported any more
+ # 10/11/03 - Siggi - nech2 renamed to nech
+ # 20/11/03 - Siggi - submit command on nech changed from qsub.test to qsub
+ # 29/03/04 - Siggi - ground not supported any more, gfdl3 validated
+ # 31/03/04 - Siggi - new option -N for node usage
+ # 12/04/04 - Siggi - scp2 instead of scp used for transfer from decalpha
+ # due to error in ssh installation (otherwise a prompt
+ # for the password appears)
+ # 23/07/04 - Siggi - changes due to the new berni configuration
+ # (federation switch)
+ # 01/09/04 - Gerald new job-classes on hanni
+ # 08/09/04 - Siggi - hanni IP address changed to 130.75.4.10
+ # 23/11/04 - Siggi - new job class cdata on hanni and berni
+ # 03/12/04 - Siggi - notification on ibm switched of in case of
+ # delete_dayfile = true, node usage in cdev set to
+ # shared
+ # 16/02/05 - Gerald hababai validated
+ # 29/03/05 - Micha - new job class channi on hanni
+ # 11/05/05 - Siggi - ConsumableMemory is now required as resource keyword
+ # on ibms
+ # 24/05/05 - Siggi - Default queue on ibms changed from p_normal_1.3 to
+ # p_normal
+ # 30/06/05 - Siggi - network changed for queue cdev from "us" to "ip"
+ # 12/07/05 - Siggi - in network.mpi on ibmh/ibmb "csss" changed to
+ # "sn_all", new job class cexp
+ # 08/09/05 - Siggi - IP-address of gfdl3 changed
+ # 31/10/05 - Siggi - new job class pp on hurricane, serial jobs on
+ # hurricane (with -X0)
+ # 01/11/05 - Siggi - missing queue for jobs submitted on nech (for nech)
+ # added
+ # 30/12/05 - Siggi - change of IP adresses in subnet 130.75.105
+ # 09/02/06 - Siggi - ibmy admitted
+ # 10/02/06 - Siggi - scp2 changed to /bin/scp on decalpha
+ # 13/04/06 - Siggi - ostria admitted
+ # 18/04/06 - Siggi - new option -O for OpenMP usage
+ # 24/05/06 - Siggi - lctit admitted, ftpjob renamed scpjob
+ # 25/07/06 - Siggi - gfdl5 (ibmy) admitted for submitting jobs
+ # 27/09/06 - Siggi - breg/hreg extended with berni/hanni
+ # 25/10/06 - Siggi - data_limit set to 1.76 GByte on hanni and berni
+ # 28/11/06 - Siggi - levanto admitted
+ # 13/02/07 - Siggi - hpmuk releated code removed
+ # 01/03/07 - Siggi - adjustments for RIAM machines gate and NEC-SX8 (n-sx)
+ # 12/04/07 - Siggi - option -f (filetransfer protocol) removed, scp only
+ # 27/07/07 - Siggi - autan admitted
+ # 03/08/07 - Marcus- lcfimm admitted
+ # 08/10/07 - Siggi - further job classes added for hanni (csoloh...)
+ # 15/10/07 - Siggi - preliminary adjustments for lctit based on Jin's
+ # suggestions
+ # 19/10/07 - Marcus- add new optional argument -g group_number
+ # 19/10/07 - Siggi - a ";" was missing in the last change done by Marcus
+ # 30/10/07 - Marcus- further adjustments for queues on lctit
+
+
+ # VARIABLENVEREINBARUNGEN + DEFAULTWERTE
+ delete_dayfile=false
+ group_number=none
+ locat=normal
+ no_default_queue=none
+ no_submit=false
+ job_catalog="~/job_queue"
+ job_name=none
+ local_user=$LOGNAME
+ node_usage=shared
+ numprocs=1
+ punkte="..........................................................."
+ submcom=qsub
+ queue=default
+ remote_host=none
+ remote_user=""
+ verify=true
+
+ typeset -i cputime=0 memory=0 Memory=0 minuten resttime sekunden stunden
+ typeset -i inumprocs nodes=0 tasks_per_node=0 threads_per_task=1
+ typeset -L20 spalte1
+ typeset -R40 spalte2
+ typeset -L60 spalte3
+
+
+
+ # FEHLERBEHANDLUNG
+ # BEI EXIT:
+ trap 'if [[ $locat != normal ]]
+ then
+ case $locat in
+ (option) printf "\n --> available optios can be displayed"
+ printf " by typing:"
+ printf "\n \"subjob ?\" \n";;
+ (ftpcopy|parameter|scp|verify) printf "\n";;
+ (*) printf "\n +++ unknown error"
+ printf "\n please inform S. Raasch!\n"
+ esac
+ [[ -f $job_to_send ]] && rm $job_to_send
+ printf "\n\n+++ SUBJOB killed \n\n"
+ fi' exit
+
+
+ # BEI TERMINAL-BREAK:
+ trap '[[ -f $job_to_send ]] && rm $job_to_send
+ printf "\n\n+++ SUBJOB killed \n\n"
+ exit
+ ' 2
+
+
+
+
+ # LOKALEN HOSTNAMEN FESTSTELLEN
+ local_host=$(hostname)
+
+
+
+ # HOSTSPEZIFISCHE VARIABLEN VEREINBAREN BZW. PRUEFEN, OB LOKALER HOST
+ # UEBERHAUPT ZULAESSIG IST
+ case $local_host in
+ (atmos) local_addres=172.20.25.35; local_host=lcide;;
+ (autan) local_addres=130.75.105.57; local_host=lcmuk;;
+ (bora) local_addres=130.75.105.103; local_host=lcmuk;;
+ (breg*-en0|berni*-en0) local_addres=130.73.230.10; local_host=ibmb;;
+ (breva) local_addres=130.75.105.98; local_host=lcmuk;;
+ (compute-*.local) local_addres=172.20.4.2; local_host=lcfimm;;
+ (cs*) local_addres=136.172.44.131; local_host=nech;;
+ (elephanta) local_addres=130.75.105.6; local_host=lcmuk;;
+ (fimm.bccs.uib.no) local_addres=172.20.4.2; local_host=lcfimm;;
+ (gallego) local_addres=130.75.105.10; local_host=lcmuk;;
+ (gate|n-sx) local_addres=133.5.178.11; local_host=neck;;
+ (gfdl5) local_addres=165.132.26.58; local_host=ibmy;;
+ (gfdl3.yonsei.ac.kr) local_addres=165.132.26.56; local_host=decalpha;;
+ (gregale) local_addres=130.75.105.109; local_host=lcmuk;;
+ (hababai) local_addres=130.75.105.108; local_host=lcmuk;;
+ (hreg*-en0|hanni*-en0) local_addres=130.75.4.10; local_host=ibmh;;
+ (irifi) local_addres=130.75.105.104; local_host=lcmuk;;
+ (levanto) local_addres=130.75.105.45; local_host=lcmuk;;
+ (maestro) local_addres=130.75.105.2; local_host=lcmuk;;
+ (nobel*) local_addres=150.183.5.101; local_host=ibms;;
+ (orkan) local_addres=130.75.105.3; local_host=lcmuk;;
+ (ostria) local_addres=130.75.105.106; local_host=lcmuk;;
+ (quanero) local_addres=130.75.105.107; local_host=lcmuk;;
+ (scirocco) local_addres=172.20.25.41; local_host=lcmuk;;
+ (sun1|sun2) local_addres=130.75.6.1; local_host=unics;;
+ (tgg*) local_addres=172.17.75.161; local_host=lctit;;
+ (vorias) local_addres=172.20.25.43; local_host=lcmuk;;
+ (*) printf "\n +++ \"$local_host\" unknown";
+ printf "\n please inform S. Raasch!";
+ locat=parameter; exit;;
+ esac
+
+
+
+ # REMOTE HOST DEFAULTMAESSIG = LOCAL HOST SETZEN
+ remote_host=$local_host
+
+
+
+
+ # PROZEDUROPTIONEN EINLESEN
+ while getopts :c:dDg:h:m:n:N:O:q:t:T:u:vX: option
+ do
+ case $option in
+ (c) job_catalog=$OPTARG;;
+ (d) delete_dayfile=true;;
+ (D) no_submit=true;;
+ (g) group_number=$OPTARG;;
+ (h) remote_host=$OPTARG;;
+ (m) memory=$OPTARG;;
+ (n) job_name=$OPTARG;;
+ (N) node_usage=$OPTARG;;
+ (O) threads_per_task=$OPTARG;;
+ (q) no_default_queue=$OPTARG;;
+ (t) cputime=$OPTARG;;
+ (T) tasks_per_node=$OPTARG;;
+ (u) remote_user=$OPTARG;;
+ (v) verify=false;;
+ (X) numprocs=$OPTARG;;
+ (\?) printf "\n +++ Option $OPTARG unknown \n";
+ locat=option; exit;;
+ esac
+ done
+
+
+ # JOBDATEINAMEN ALS NAECHSTES ARGUMENT HOLEN
+ shift OPTIND-1; file_to_send=$1
+
+
+ # KURZE AUFRUFBESCHREIBUNG WIRD HIER AUSGEGEBEN
+ if [ "$1" = "?" ]
+ then
+ (printf "\n *** subjob can be called as follows:\n"
+ printf "\n subjob -c.. -d -D -h.. -m.. -q.. -t.. -u.. -v \n"
+ printf "\n Description of available options:\n"
+ printf "\n Option Description Default-Value"
+ printf "\n -c job-input- and output-catalog ~/job_queue"
+ printf "\n -d no job-protocol will be created ---"
+ printf "\n -D only the job-file will be created ---"
+ printf "\n -h execution host, available hosts: $remote_host"
+ printf "\n ibm, ibmb, ibmh, ibms, ibmy, lcmuk,"
+ printf "\n lctit, nech, neck, unics"
+ printf "\n -m memory demand per process in MByte ---"
+ printf "\n -n jobname "
+ printf "\n -O threads per task (for OpenMP usage) 1"
+ printf "\n -q job-queue to be used default"
+ printf "\n -t allowed cpu-time in seconds ---"
+ printf "\n -T tasks per node (on parallel hosts) ---"
+ printf "\n -u username on execution host from .netrc"
+ printf "\n -v no prompt for confirmation ---"
+ printf "\n -X # of processors (on parallel hosts) 1"
+ printf "\n "
+ printf "\n The only possible positional parameter is :"
+ printf "\n The complete NQS-job must be provided here."
+ printf "\n =? creates this outline\n\n") | more
+ exit
+ fi
+
+
+
+ # PRUEFEN, OB JOBDATEI ANGEGEBEN WURDE UND OB SIE AUCH EXISTIERT
+ if [[ "$file_to_send" = "" ]]
+ then
+ printf "\n +++ job-file missing"
+ locat=parameter; exit
+ else
+ if [[ -f $file_to_send ]]
+ then
+ true
+ else
+ printf "\n +++ job-file: "
+ printf "\n $file_to_send"
+ printf "\n does not exist"
+ locat=parameter; exit
+ fi
+ fi
+
+
+
+ # FALLS KEIN JOBNAME ANGEGEBEN WURDE, WIRD JOBNAME = JOBDATEINAME
+ # GESETZT. VORAUSSETZUNG: JOBDATEINAME BEINHALTET KEINE PFADE
+ if [[ $job_name = none ]]
+ then
+ job_name=$file_to_send
+ fi
+ if [[ $(echo $job_name | grep -c "/") != 0 ]]
+ then
+ printf "\n +++ job-file name: "
+ printf "\n $job_name"
+ printf "\n must not contain \"/\"-characters"
+ locat=parameter; exit
+ fi
+
+
+
+
+ # HOSTSPEZIFISCHE GROESSEN VEREINBAREN BZW. ABBRUCH BEI UNZULAESSIGEM HOST
+ # ODER WENN HOST NICHT ANGEGEBEN WURDE
+ if [[ $remote_host = none ]]
+ then
+ printf "\n +++ host missing"
+ locat=option; exit
+ else
+ case $remote_host in
+ (ibm) queue=p690_standard; remote_addres=134.76.99.81; submcom=/usr/lpp/LoadL/full/bin/llsubmit;;
+ (ibmb) queue=cpar; remote_addres=130.73.230.10; submcom=/usr/lpp/LoadL/full/bin/llsubmit;;
+ (ibmh) queue=cpar; remote_addres=130.75.4.10; submcom=/usr/lpp/LoadL/full/bin/llsubmit;;
+ (ibms) queue=p_normal; remote_addres=150.183.5.101; submcom=/usr/lpp/LoadL/full/bin/llsubmit;;
+ (ibmy) queue=parallel; remote_addres=165.132.26.58; submcom=/usr/lpp/LoadL/full/bin/llsubmit;;
+ (lcfimm) remote_addres=172.20.4.2; submcom=/opt/torque/bin/qsub;;
+ (lctit) queue=lctit; remote_addres=172.17.75.161; submcom=/n1ge/TITECH_GRID/tools/bin/n1ge;;
+ (nech) qsubmem=memsz_job; qsubtime=cputim_job; remote_addres=136.172.44.147; submcom="/usr/local/bin/qsub";;
+ (neck) qsubmem=memsz_job; qsubtime=cputim_job; remote_addres=133.5.178.11; submcom="/usr/bin/nqsII/qsub";;
+ (vpp) qsubmem=m; qsubtime=t; queue=vpp; remote_addres=130.75.4.130;;
+ (unics) qsubmem=d; qsubtime=t; queue=unics; remote_addres=130.75.6.1;;
+ (*) printf "\n +++ hostname \"$remote_host\" not allowed";
+ locat=parameter; exit;;
+ esac
+ fi
+
+
+ # EVTL. PRUEFEN, OB ANGEGEBENE QUEUE ZULAESSIG IST
+ if [[ $no_default_queue != none ]]
+ then
+ error=false
+ ndq=$no_default_queue
+ case $remote_host in
+ (ibm) case $ndq in
+ (p690_express|p690_standard|p690_long) error=false;;
+ (*) error=true;;
+ esac;;
+ (ibmb) case $ndq in
+ (cdata|cdev|cexp|c1|cshare|csolo|cspec) error=false;;
+ (*) error=true;;
+ esac;;
+ (ibmh) case $ndq in
+ (cdata|cdev|cexp|channi|cxxl|c1|cshare|csolo|csoloh3h|csoloh6h|csoloh12h|csoloh1d|csoloh2d|cspec) error=false;;
+ (*) error=true;;
+ esac;;
+ (ibms) case $ndq in
+ (express|normal|p_express|p_normal|p_normal_1.3|p_normal_1.7|grand) error=false;;
+ (*) error=true;;
+ esac;;
+ (ibmy) case $ndq in
+ (parallel) error=false;;
+ (*) error=true;;
+ esac;;
+ (lctit) case $ndq in
+ (novice|sla1|sla2|sla3|RAM64GB|RAM128GB) error=false;;
+ (*) error=true;;
+ esac;;
+ (t3eb) case $ndq in
+ (berte|p50|p100|p392|forfree|p25himem) error=false;;
+ (*) error=true;;
+ esac;;
+ (t3eh) case $ndq in
+ (para_t3e|em|k|l|lm|comp_t3e|c|p|ht) error=false;;
+ (*) error=true;;
+ esac;;
+ (t3ej2|t3ej5) case $ndq in
+ (low|normal|high) error=false;;
+ (*) error=true;;
+ esac;;
+ (t3es) case $ndq in
+ (batch|serial-4|pe4|p48|pe16|pe32|pe64|pe128) error=false;;
+ (*) error=true;;
+ esac;;
+ (unics) case $ndq in
+ (unics|ht) error=false;;
+ (*) error=true;;
+ esac;;
+ esac
+ if [[ $error = true ]]
+ then
+ printf "\n +++ queue \"$no_default_queue\" on host \"$remote_host\" not allowed"
+ locat=parameter; exit
+ else
+ queue=$no_default_queue
+ fi
+ fi
+
+
+
+ # KNOTENNUTZUNG IN ENTWICKLERQUEUE MUSS SHARED SEIN
+ if [[ $node_usage != shared && $queue = cdev ]]
+ then
+ node_usage=shared
+ fi
+
+
+
+ # PRUEFEN DER CPU-ZEIT, ZEIT NACH STUNDEN, MINUTEN UND SEKUNDEN
+ # AUFTEILEN
+ done=false
+ while [[ $done = false ]]
+ do
+ if (( $cputime <= 0 ))
+ then
+ printf "\n +++ wrong cpu-time or cpu-time missing"
+ printf "\n >>> Please type cpu-time in seconds as INTEGER:"
+ printf "\n >>> "
+ read cputime 1>/dev/null 2>&1
+ else
+ done=true
+ fi
+ done
+ if [[ $remote_host = nech ]]
+ then
+ if (( tasks_per_node != 0 ))
+ then
+ (( cputime = cputime * tasks_per_node ))
+ elif [[ $numprocs != 0 ]]
+ then
+ (( cputime = cputime * numprocs ))
+ fi
+ fi
+ (( stunden = cputime / 3600 ))
+ (( resttime = cputime - stunden * 3600 ))
+ (( minuten = resttime / 60 ))
+ (( sekunden = resttime - minuten * 60 ))
+ timestring=${stunden}:${minuten}:${sekunden}
+
+
+
+ # PRUEFEN DER KERNSPEICHERANFORDERUNG
+ done=false
+ while [[ $done = false ]]
+ do
+ if (( memory <= 0 ))
+ then
+ printf "\n +++ wrong memory demand or memory demand missing"
+ printf "\n >>> Please type memory in MByte per process as INTEGER:"
+ printf "\n >>> "
+ read memory 1>/dev/null 2>&1
+ else
+ done=true
+ fi
+ done
+
+ if [[ $remote_host = nech || $remote_host = neck ]]
+ then
+ if (( tasks_per_node != 0 ))
+ then
+ (( Memory = memory * tasks_per_node / 1000 ))
+ elif [[ $numprocs != 0 ]]
+ then
+ (( Memory = memory * numprocs / 1000 ))
+ else
+ (( Memory = memory / 1000 ))
+ fi
+ fi
+
+
+ # SPEICHERBERECHNUNG BEI OPENMP-NUTZUNG
+ if [[ $(echo $remote_host | cut -c1-3) = ibm ]]
+ then
+ (( memory = memory * threads_per_task ))
+ fi
+
+
+ # BERECHNUNG DER ANZAHL DER ZU VERWENDENDEN KNOTEN
+ if (( tasks_per_node != 0 ))
+ then
+ (( nodes = numprocs / ( tasks_per_node * threads_per_task ) ))
+ fi
+
+
+
+ # HEADER-AUSGABE
+ if [[ $verify = true ]]
+ then
+ printf "\n\n"
+ printf "#--------------------------------------------------------------# \n"
+ spalte1=SUBJOB;spalte2=$(date)
+ printf "| $spalte1$spalte2 | \n"
+ printf "| | \n"
+ printf "| values of parameters/options: | \n"
+ spalte1=local_host$punkte; spalte2=$punkte$local_host
+ printf "| $spalte1$spalte2 | \n"
+ spalte1=remote_host$punkte; spalte2=$punkte$remote_host
+ printf "| $spalte1$spalte2 | \n"
+ spalte1=queue$punkte; spalte2=$punkte$queue
+ printf "| $spalte1$spalte2 | \n"
+ spalte1=memory$punkte; spalte2="$punkte$memory mb"
+ printf "| $spalte1$spalte2 | \n"
+ spalte1=cputime$punkte; spalte2="$punkte$cputime sec"
+ printf "| $spalte1$spalte2 | \n"
+ spalte1=job_name$punkte; spalte2="$punkte$job_name"
+ printf "| $spalte1$spalte2 | \n"
+ printf "#--------------------------------------------------------------# \n\n"
+
+
+ # KONTROLLABFRAGE, OB ALLES O.K.
+ antwort="dummy"
+ while [[ $antwort != y && $antwort != Y && $antwort != n && $antwort != N ]]
+ do
+ read antwort?" >>> continue (y/n) ? "
+ done
+ if [[ $antwort = n || $antwort = N ]]
+ then
+ locat=verify; exit
+ fi
+ printf "\n"
+ fi
+
+
+
+ # ZUFALLSKENNUNG GENERIEREN UND JOBNAMEN AUF ZIELRECHNER BESTIMMEN
+ kennung=$RANDOM
+ job_on_remhost=${job_name}_${kennung}_$local_host
+ job_to_send=job_to_send_$kennung
+ if [[ $delete_dayfile = false ]]
+ then
+ remote_dayfile=${local_host}_${job_name}_result_$kennung
+ local_dayfile=${remote_host}_${job_name}
+ else
+ remote_dayfile=/dev/null
+ if [[ $(echo $remote_host | cut -c1-3) = ibm ]]
+ then
+ notification='# @ notification = never'
+ fi
+ fi
+
+
+
+ # QSUB- ODER LL-KOMMANDOS BZW. SKRIPTE GENERIEREN
+ if [[ $(echo $remote_host | cut -c1-3) = ibm && $numprocs != 0 ]]
+ then
+
+ if [[ $remote_host = ibmy ]]
+ then
+ consumable_memory=""
+ else
+ consumable_memory="ConsumableMemory($memory mb)"
+ fi
+ if [[ $queue = cdev ]]
+ then
+ data_limit="# @ data_limit = 1.76gb"
+ network_to_use="# @ network.mpi = sn_all,shared,ip"
+ else
+ if [[ $remote_host = ibms ]]
+ then
+ network_to_use="# @ network.mpi = csss,shared,us"
+ elif [[ $remote_host = ibmy ]]
+ then
+ network_to_use=""
+ else
+ network_to_use="# @ network.mpi = sn_all,shared,us"
+ data_limit="# @ data_limit = 1.76gb"
+ fi
+ fi
+
+ cat > $job_to_send << %%END%%
+#!/bin/ksh
+
+# @ job_type = parallel
+# @ job_name = palm
+# @ wall_clock_limit = ${timestring},$timestring
+# @ resources = ConsumableCpus($threads_per_task) $consumable_memory
+# @ output = $remote_dayfile
+# @ error = $remote_dayfile
+# @ image_size = 50
+# @ class = $queue
+# @ environment = OMP_NUM_THREADS=$threads_per_task; MP_SHARED_MEMORY=yes
+$network_to_use
+$data_limit
+$notification
+
+%%END%%
+
+ if (( nodes > 0 ))
+ then
+
+ cat >> $job_to_send << %%END%%
+# @ node = $nodes
+# @ tasks_per_node = $tasks_per_node
+# @ node_usage = $node_usage
+# @ queue
+
+%%END%%
+
+ else
+
+ if [[ $remote_host != ibmy ]]
+ then
+
+ cat >> $job_to_send << %%END%%
+# @ blocking = unlimited
+# @ total_tasks = $numprocs
+# @ node_usage = $node_usage
+# @ queue
+
+%%END%%
+
+ else
+
+ cat >> $job_to_send << %%END%%
+# @ node = 1
+# @ total_tasks = $numprocs
+# @ queue
+
+%%END%%
+
+ fi
+
+ fi
+
+ elif [[ $(echo $remote_host | cut -c1-3) = ibm && $numprocs = 0 ]]
+ then
+
+ cat > $job_to_send << %%END%%
+#!/bin/ksh
+
+# @ job_type = serial
+# @ node_usage = $node_usage
+# @ job_name = palm
+# @ wall_clock_limit = ${timestring},$timestring
+# @ resources = ConsumableCpus(1) ConsumableMemory(1 gb)
+# @ output = $remote_dayfile
+# @ error = $remote_dayfile
+# @ class = $queue
+$notification
+
+# @ queue
+
+%%END%%
+
+ elif [[ $remote_host = lcfimm ]]
+ then
+
+ if [[ $numprocs != 0 ]]
+ then
+ cat > $job_to_send << %%END%%
+#!/bin/ksh
+#PBS -N $job_name
+#PBS -A nersc
+#PBS -l walltime=$timestring
+#PBS -l nodes=${nodes}:ppn=$tasks_per_node
+#PBS -l pmem=${memory}mb
+#PBS -m abe
+#PBS -M igore@nersc.no
+#PBS -o $remote_dayfile
+#PBS -j oe
+mpd &
+
+%%END%%
+
+ else
+ cat > $job_to_send << %%END%%
+#!/bin/ksh
+#PBS -N $job_name
+#PBS -A nersc
+#PBS -l walltime=$timestring
+#PBS -l ncpus=1
+#PBS -l pmem=${memory}mb
+#PBS -m abe
+#PBS -M igore@nersc.no
+#PBS -o $remote_dayfile
+#PBS -j oe
+
+%%END%%
+
+ fi
+
+ elif [[ $remote_host = nech ]]
+ then
+
+ if (( nodes > 1 ))
+ then
+ cat > $job_to_send << %%END%%
+#!/bin/ksh
+#PBS -l cpunum_prc=$tasks_per_node,cputim_job=$cputime
+#PBS -l ${qsubmem}=${Memory}gb
+#PBS -b $nodes
+#PBS -o $remote_dayfile
+#PBS -N palm
+#PBS -j o
+#PBS -T mpisx
+
+%%END%%
+
+ elif [[ $numprocs != 0 ]]
+ then
+ cat > $job_to_send << %%END%%
+#!/bin/ksh
+#PBS -l cpunum_prc=$tasks_per_node,cputim_job=$cputime
+#PBS -l ${qsubmem}=${Memory}gb
+#PBS -o $remote_dayfile
+#PBS -N palm
+#PBS -j o
+
+%%END%%
+
+ else
+ cat > $job_to_send << %%END%%
+#!/bin/ksh
+#PBS -l ${qsubmem}=${Memory}gb,${qsubtime}=$cputime
+#PBS -o $remote_dayfile
+#PBS -j o
+
+%%END%%
+
+ fi
+
+ elif [[ $remote_host = neck ]]
+ then
+
+ if (( nodes > 1 ))
+ then
+ cat > $job_to_send << %%END%%
+#!/bin/ksh
+#PBS -l cpunum_prc=$tasks_per_node,cputim_job=$cputime
+#PBS -l ${qsubmem}=${Memory}gb
+#PBS -b $nodes
+#PBS -o $remote_dayfile
+#PBS -N palm
+#PBS -j o
+#PBS -T mpisx
+
+%%END%%
+
+ elif [[ $numprocs != 0 ]]
+ then
+ cat > $job_to_send << %%END%%
+#!/bin/ksh
+#PBS -q ${queue}
+#PBS -l cpunum_prc=$tasks_per_node,cputim_job=$cputime
+#PBS -l ${qsubmem}=${Memory}gb
+#PBS -o $remote_dayfile
+#PBS -N palm
+#PBS -j o
+#PBS -T mpisx
+
+%%END%%
+
+ else
+ cat > $job_to_send << %%END%%
+#!/bin/ksh
+#PBS -l ${qsubmem}=${Memory}gb,${qsubtime}=$cputime
+#PBS -o $remote_dayfile
+#PBS -j o
+
+%%END%%
+
+ fi
+
+ elif [[ $remote_host = lctit ]]
+ then
+ cat > $job_to_send << %%END%%
+#!/bin/bash
+#$ -S /bin/bash
+cd $job_catalog
+export PATH=$PALM_BIN:\$PATH
+echo \$PATH
+
+%%END%%
+
+ # OPTIONEN FUER SUBMIT-KOMMANDO ZUSAMMENSTELLEN
+ # submcom="$submcom -N $job_name -sgeout $remote_dayfile -q default"
+ submcom="$submcom -g $group_number -N $job_name -rt 4320 -sgeout $remote_dayfile -q $node_usage "
+
+ else
+
+ cat > $job_to_send << %%END%%
+# @\$-q ${queue}
+# @\$-l${qsubtime} $timestring
+# @\$-l${qsubmem} ${memory}mb
+# @\$-o $remote_dayfile
+# @\$-eo
+
+%%END%%
+
+ fi
+
+
+ # BEI RECHNUNG AUF REMOTE-MASCHINEN RUECKTRANSFER DES DAYFILES PER TRAP
+ # BEI EXIT VERANLASSEN
+ # VEKTORRECHNER MUSS EIGENEN JOB STARTEN, DA DORT NOHUP NICHT FUNKTIONIERT
+ # AUF IBM IN SEOUL IST RUECKTRANSFER ZUR ZEIT GENERELL NICHT MOEGLICH
+ if [[ $delete_dayfile = false && $remote_host != $local_host ]]
+ then
+ echo "set +vx" >> $job_to_send
+ echo "trap '" >> $job_to_send
+ echo "set +vx" >> $job_to_send
+ if [[ $(echo $remote_host | cut -c1-3) = ibm || $(echo $remote_host | cut -c1-3) = nec || $remote_host = lctit ]]
+ then
+ if [[ $remote_host = ibmb || $remote_host = ibmh ]]
+ then
+ return_queue=c1
+ elif [[ $remote_host = ibms ]]
+ then
+ return_queue=p_normal
+ elif [[ $remote_host = ibmy ]]
+ then
+ return_queue=serial
+ elif [[ $remote_host = lctit ]]
+ then
+ return_queue=sla3
+ elif [[ $remote_host = neck ]]
+ then
+ return_queue=S
+ else
+ return_queue=unknown
+ fi
+
+ if [[ $(echo $remote_host | cut -c1-3) = ibm ]]
+ then
+
+ echo "echo \"#!/bin/ksh\" >> scpjob.$kennung" >> $job_to_send
+ echo "echo \"# @ job_type = serial\" >> scpjob.$kennung" >> $job_to_send
+ echo "echo \"# @ job_name = transfer\" >> scpjob.$kennung" >> $job_to_send
+ echo "echo \"# @ resources = ConsumableCpus(1) ConsumableMemory(1 gb)\" >> scpjob.$kennung" >> $job_to_send
+ echo "echo \"# @ wall_clock_limit = 00:10:00,00:10:00\" >> scpjob.$kennung " >> $job_to_send
+ echo "echo \"# @ output = job_queue/last_job_transfer_protocol\" >> scpjob.$kennung" >> $job_to_send
+ echo "echo \"# @ error = job_queue/last_job_transfer_protocol\" >> scpjob.$kennung" >> $job_to_send
+ echo "echo \"# @ class = $return_queue\" >> scpjob.$kennung" >> $job_to_send
+ echo "echo \"# @ image_size = 10\" >> scpjob.$kennung" >> $job_to_send
+ echo "echo \"# @ notification = never\" >> scpjob.$kennung" >> $job_to_send
+
+ echo "echo \"# @ queue\" >> scpjob.$kennung" >> $job_to_send
+ echo "echo \" \" >> scpjob.$kennung" >> $job_to_send
+
+ echo "echo \"set -x\" >> scpjob.$kennung" >> $job_to_send
+ echo "echo \"batch_scp -d -w 10 -u $local_user $local_addres ${job_catalog}/$remote_dayfile \\\"$job_catalog\\\" $local_dayfile\" >> scpjob.$kennung" >> $job_to_send
+ echo "echo \"exit\" >> scpjob.$kennung" >> $job_to_send
+
+ elif [[ $remote_host = nech ]]
+ then
+ echo "cd /pf/b/${remote_user}/job_queue" >> $job_to_send
+ echo "cat > scpjob.$kennung << %%END%%" >> $job_to_send
+ echo "#PBS -l ${qsubmem}=1GB,${qsubtime}=100" >> $job_to_send
+ echo "#PBS -o last_job_transfer_protocol" >> $job_to_send
+ echo "#PBS -j o" >> $job_to_send
+ echo " " >> $job_to_send
+ echo "set -x" >> $job_to_send
+ echo "cd /pf/b/${remote_user}/job_queue" >> $job_to_send
+ echo "batch_scp -d -w 10 -u $local_user $local_addres $remote_dayfile \"$job_catalog\" $local_dayfile" >> $job_to_send
+ echo "[[ \"\$for_subjob_to_do\" != \"\" ]] && eval \$for_subjob_to_do" >> $job_to_send
+ echo "%%END%%" >> $job_to_send
+
+ elif [[ $remote_host = neck ]]
+ then
+ echo "cat > scpjob.$kennung << %%END%%" >> $job_to_send
+ echo "#PBS -q $return_queue" >> $job_to_send
+ echo "#PBS -l ${qsubmem}=1GB,${qsubtime}=100" >> $job_to_send
+ echo "#PBS -o last_job_transfer_protocol" >> $job_to_send
+ echo "#PBS -j o" >> $job_to_send
+ echo " " >> $job_to_send
+ echo "set -x" >> $job_to_send
+ echo "batch_scp -d -w 10 -u $local_user $local_addres $remote_dayfile \"$job_catalog\" $local_dayfile" >> $job_to_send
+ echo "[[ \"\$for_subjob_to_do\" != \"\" ]] && eval \$for_subjob_to_do" >> $job_to_send
+ echo "%%END%%" >> $job_to_send
+
+ elif [[ $remote_host = lctit ]]
+ then
+ echo "cat > scpjob.$kennung << %%END%%" >> $job_to_send
+ echo "set -x" >> $job_to_send
+ echo "PATH=\$PATH:$job_catalog/../pub" >> $job_to_send
+ echo "cd $job_catalog" >> $job_to_send
+ echo "batch_scp -d -w 10 -u $local_user $local_addres $remote_dayfile \"$job_catalog\" $local_dayfile" >> $job_to_send
+ echo "[[ \"\$for_subjob_to_do\" != \"\" ]] && eval \$for_subjob_to_do" >> $job_to_send
+ echo "%%END%%" >> $job_to_send
+
+ else
+
+ echo "cat > scpjob.$kennung << %%END%%" >> $job_to_send
+ echo "# @\\\$-q $return_queue" >> $job_to_send
+ echo "# @\\\$-l${qsubtime} 10" >> $job_to_send
+ echo "# @\\\$-l${qsubmem} 10mb" >> $job_to_send
+ if [[ $remote_host = t3ej2 || $remote_host = t3ej5 || $remote_host = t3es ]]
+ then
+ echo "# @\$-l mpp_p=0" >> $job_to_send
+ fi
+ echo '# @\$-lF 10mb' >> $job_to_send
+# echo '# @\$-o /dev/null' >> $job_to_send
+ echo '# @\$-o job_queue/last_job_transfer_protocol' >> $job_to_send
+ echo '# @\\\$-eo' >> $job_to_send
+ echo " " >> $job_to_send
+ if [[ $remote_host = t3ej2 || $remote_host = t3ej5 ]]
+ then
+ echo "set +vx" >> $job_to_send
+ echo ". .profile" >> $job_to_send
+ fi
+ echo "set -x" >> $job_to_send
+ echo "batch_scp -d -w 10 -u $local_user $local_addres ${job_catalog}/$remote_dayfile \"$job_catalog\" $local_dayfile > /dev/null" >> $job_to_send
+ echo "[[ \"\$for_subjob_to_do\" != \"\" ]] && eval \$for_subjob_to_do" >> $job_to_send
+ echo "%%END%%" >> $job_to_send
+ fi
+
+ if [[ $(echo $remote_host | cut -c1-3) = ibm ]]
+ then
+ echo "llsubmit scpjob.$kennung" >> $job_to_send
+ elif [[ $remote_host = lctit ]]
+ then
+ echo "chmod u+x scpjob.$kennung" >> $job_to_send
+ echo "rm -rf ${job_catalog}/last_job_transfer_protocol" >> $job_to_send
+ echo "n1ge -N jobtransfer -q $return_queue -sgeout ${job_catalog}/last_job_transfer_protocol scpjob.$kennung" >> $job_to_send
+ echo "sleep 10" >> $job_to_send
+ elif [[ $remote_host = t3eb || $remote_host = t3eh || $remote_host = t3ej2 || $remote_host = t3ej5 ]]
+ then
+ echo "qsub -J n scpjob.$kennung" >> $job_to_send
+ elif [[ $remote_host = t3es ]]
+ then
+ echo "qsub -J n -s /bin/ksh scpjob.$kennung" >> $job_to_send
+ else
+ echo "qsub scpjob.$kennung" >> $job_to_send
+ fi
+ echo "rm scpjob.$kennung" >> $job_to_send
+ if [[ $remote_host = nech ]]
+ then
+ echo "cd -" >> $job_to_send
+ fi
+ else
+# echo "ftpcopy -d $local_addres ${job_catalog}/$remote_dayfile \"$job_catalog\" $local_dayfile" >> $job_to_send
+ echo "nohup ftpcopy -d -w 15 $local_addres ${job_catalog}/$remote_dayfile \"$job_catalog\" $local_dayfile > /dev/null &" >> $job_to_send
+ fi
+ echo "set -x" >> $job_to_send
+ echo " ' exit" >> $job_to_send
+ echo "set -x" >> $job_to_send
+ fi
+
+
+
+ # EIGENTLICHE JOB-DATEI AN QSUB-KOMMANDOS ANHAENGEN
+ cat $file_to_send >> $job_to_send
+
+ if [[ $remote_host = ibm ]]
+ then
+ echo " " >> $job_to_send
+ echo "exit" >> $job_to_send
+ fi
+ if [[ $remote_host = lctit ]]
+ then
+ echo " " >> $job_to_send
+ echo "rm ~/job_queue/$job_on_remhost" >> $job_to_send
+ fi
+
+
+
+ # USER-NAME AUF ZIELRECHNER AUS .NETRC-DATEI ERMITTELN
+ if [[ -z $remote_user ]]
+ then
+ if [[ $remote_host = t3eb || $remote_host = t3eh || $remote_host = t3ej2 || $remote_host = t3ej5 || $remote_host = t3es || $remote_host = vpp ]]
+ then
+ grep $remote_addres ~/.netrc | read dum dum dum remote_user dum dum
+ fi
+ fi
+
+
+
+ # JOB AUF ZIELRECHNER TRANSFERIEREN BZW. INS JOBVERZEICHNIS KOPIEREN
+ if [[ $no_submit = false ]]
+ then
+ if [[ $remote_host != $local_host ]]
+ then
+ [[ $verify = true ]] && printf "\n >>> transfering job to \"$remote_host\"..."
+ if [[ $remote_host = ibms || $remote_host = ibmy ]] # ssh on ibms cannot handle "~/"
+ then
+ job_catalog_save=$job_catalog
+ job_catalog=job_queue
+ elif [[ $remote_host = nech ]]
+ then
+ job_catalog_save=$job_catalog
+ job_catalog=/hpf/b/${remote_user}/job_queue
+ fi
+ if [[ $local_host = decalpha ]]
+ then
+ # VERWENDUNG VON SCP AUF DECALPHA FRAGT FEHLERHAFTERWEISE
+ # PASSWORT AB
+ /bin/scp $job_to_send ${remote_user}@${remote_addres}:${job_catalog}/$job_on_remhost
+ elif [[ $remote_host = nech ]]
+ then
+ # DATEIEN KOENNEN NUR UEBER DEN ARCHIVE-SERVER DES DKRZ
+ # TRANSFERIERT WERDEN
+ scp $job_to_send ${remote_user}@136.172.44.205:${job_catalog}/$job_on_remhost
+ else
+ scp $job_to_send ${remote_user}@${remote_addres}:${job_catalog}/$job_on_remhost
+ fi
+ if [[ $? = 1 ]]
+ then
+ locat=scp; exit
+ fi
+ if [[ $remote_host = ibms ]]
+ then
+ job_catalog=$job_catalog_save
+ fi
+ [[ $verify = true ]] && printf "\n >>> finished\n"
+ else
+ eval job_catalog=$job_catalog
+ cp $job_to_send ${job_catalog}/$job_on_remhost
+ fi
+
+
+
+ # NQS- BZW. LOADLEVELER-JOB STARTEN
+ if [[ $remote_host != $local_host ]]
+ then
+ [[ $verify = true ]] && printf "\n >>> submitting job using \"qsub\"...\n"
+ if [[ $remote_host != lctit ]]
+ then
+ ssh $remote_addres -l $remote_user "cd $job_catalog; $submcom $job_on_remhost; rm $job_on_remhost"
+ else
+ # TIT ERLAUBT NUR DIE AUSFÃœHRUNG GANZ BESTIMMTER KOMMANDOS
+ # MIT SSH, DESHALB AUFRUF PER PIPE
+ # UEBERGANGSWEISE CHECK, OB N1GE ENVIRONMENT WIRKLICH VERFUEGBAR
+ print "cd $job_catalog; chmod u+x $job_on_remhost" | ssh $remote_addres -l $remote_user > /dev/null 2>&1
+ echo "first try" > send_protocol
+ while [[ $(cat send_protocol | grep -c "Forwarding to N1GE") = 0 ]]
+ do
+ if [[ $(cat send_protocol | grep -c "first try") = 1 ]]
+ then
+ printf "\n trying to submit job to TIT cluster..."
+ else
+ printf "\n +++ failed ... trying to submit again ..."
+ fi
+ print "cd $job_catalog; $submcom $job_on_remhost" | ssh $remote_addres -l $remote_user > send_protocol 2>&1
+ cat send_protocol
+ done
+ sleep 10
+ print "cd $job_catalog; rm $job_on_remhost" | ssh $remote_addres -l $remote_user > /dev/null 2>&1
+ echo "$submcom $job_on_remhost"
+ rm send_protocol
+ fi
+
+ [[ $verify = true ]] && printf " >>> o.k.\n"
+ else
+ cd $job_catalog
+ if [[ $(echo $local_host | cut -c1-3) = ibm ]]
+ then
+ eval $submcom $job_on_remhost
+ elif [[ $local_host = lcfimm ]]
+ then
+ eval $submcom $job_on_remhost
+ echo "$submcom $job_on_remhost"
+ chmod u+x $job_on_remhost
+ elif [[ $local_host = lctit ]]
+ then
+ eval $submcom $job_on_remhost
+ echo "$submcom $job_on_remhost"
+ chmod u+x $job_on_remhost
+ elif [[ $local_host = nech ]]
+ then
+ if [[ $queue = default ]]
+ then
+ eval $submcom $job_on_remhost
+ else
+ eval $submcom -q $queue $job_on_remhost
+ fi
+ else
+ qsub $job_on_remhost
+ fi
+ # JOBFILE DARF AUF LCTIT NICHT GELOESCHT WERDEN!! GESCHIEHT ERST AM JOBENDE
+ [[ $local_host != lctit ]] && rm $job_on_remhost
+ cd - > /dev/null
+ fi
+ fi
+
+
+
+ # ABSCHLUSSARBEITEN
+
+ if [[ $no_submit = false ]]
+ then
+ rm $job_to_send
+ fi
+ [[ $verify = true ]] && printf "\n\n *** SUBJOB finished \n\n"
Index: /palm/tags/release-3.4a/SOURCE/CURRENT_MODIFICATIONS
===================================================================
--- /palm/tags/release-3.4a/SOURCE/CURRENT_MODIFICATIONS (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/CURRENT_MODIFICATIONS (revision 141)
@@ -0,0 +1,14 @@
+New:
+---
+
+
+
+Changed:
+-------
+
+
+
+Errors:
+------
+
+
Index: /palm/tags/release-3.4a/SOURCE/Makefile
===================================================================
--- /palm/tags/release-3.4a/SOURCE/Makefile (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/Makefile (revision 141)
@@ -0,0 +1,245 @@
+#------------------------------------------------------------------------------!
+# WARNING: don't write filenames with extension .f90 in this header!!!!
+#
+# Actual revisions:
+# -----------------
+# +plant_canopy_model
+#
+# +surface_coupler
+#
+# Former revisions:
+# -----------------
+# $Id$
+#
+# 96 2007-06-04 08:07:41Z raasch
+# +eqn_state_seawater, init_ocean
+#
+# 82 2007-04-16 15:40:52Z raasch
+# +local_flush
+#
+# 58 2007-03-09 14:27:38Z raasch
+# default suffixes removed from the suffix list to avoid calling of m2c in
+# case of .mod files
+# +wall_fluxes, +particle_boundary_conds
+#
+# RCS Log replace by Id keyword, revision history cleaned up
+#
+# Revision 1.13 2006/08/04 14:45:31 raasch
+# +data_output_ptseries
+#
+# Revision 1.1 2002/06/11 13:42:20 raasch
+# Initial revision
+#
+#
+# Description:
+# ------------
+# Makefile for the parallelized LES model (PALM) to be used by the
+# shellscript "mrun"
+#------------------------------------------------------------------------------!
+
+PROG = palm
+
+RCS = advec_particles.f90 advec_s_bc.f90 advec_s_pw.f90 advec_s_up.f90 \
+ advec_s_ups.f90 advec_u_pw.f90 advec_u_up.f90 advec_u_ups.f90 \
+ advec_v_pw.f90 advec_v_up.f90 advec_v_ups.f90 advec_w_pw.f90 \
+ advec_w_up.f90 advec_w_ups.f90 asselin_filter.f90 average_3d_data.f90 \
+ boundary_conds.f90 buoyancy.f90 calc_liquid_water_content.f90 \
+ calc_precipitation.f90 calc_radiation.f90 calc_spectra.f90 \
+ check_for_restart.f90 check_open.f90 check_parameters.f90 \
+ close_file.f90 compute_vpt.f90 coriolis.f90 cpu_log.f90 \
+ cpu_statistics.f90 data_log.f90 data_output_dvrp.f90 \
+ data_output_profiles.f90 data_output_ptseries.f90 \
+ data_output_spectra.f90 data_output_tseries.f90 data_output_2d.f90 \
+ data_output_3d.f90 diffusion_e.f90 diffusion_s.f90 diffusion_u.f90 \
+ diffusion_v.f90 diffusion_w.f90 diffusivities.f90 disturb_field.f90 \
+ disturb_heatflux.f90 eqn_state_seawater.f90 exchange_horiz.f90 exchange_horiz_2d.f90 \
+ fft_xy.f90 flow_statistics.f90 global_min_max.f90 header.f90 \
+ impact_of_latent_heat.f90 init_1d_model.f90 init_3d_model.f90 \
+ init_advec.f90 init_cloud_physics.f90 init_dvrp.f90 init_grid.f90 \
+ init_ocean.f90 init_particles.f90 init_pegrid.f90 init_pt_anomaly.f90 \
+ init_rankine.f90 init_slope.f90 interaction_droplets_ptq.f90 \
+ local_flush.f90 local_getenv.f90 local_stop.f90 local_system.f90 local_tremain.f90 \
+ local_tremain_ini.f90 modules.f90 netcdf.f90 package_parin.f90 \
+ palm.f90 parin.f90 particle_boundary_conds.f90 \
+ plant_canopy_model.f90 poisfft.f90 \
+ poisfft_hybrid.f90 poismg.f90 prandtl_fluxes.f90 pres.f90 print_1d.f90 \
+ production_e.f90 prognostic_equations.f90 random_function.f90 \
+ random_gauss.f90 read_3d_binary.f90 read_var_list.f90 run_control.f90 \
+ singleton.f90 sor.f90 spline_x.f90 spline_y.f90 spline_z.f90 \
+ sum_up_3d_data.f90 surface_coupler.f90 swap_timelevel.f90 \
+ temperton_fft.f90 time_integration.f90 time_to_string.f90 timestep.f90 \
+ timestep_scheme_steering.f90 transpose.f90 user_interface.f90 \
+ wall_fluxes.f90 write_3d_binary.f90 write_compressed.f90 \
+ write_var_list.f90
+
+OBJS = advec_particles.o advec_s_bc.o advec_s_pw.o advec_s_up.o \
+ advec_s_ups.o advec_u_pw.o advec_u_up.o advec_u_ups.o \
+ advec_v_pw.o advec_v_up.o advec_v_ups.o advec_w_pw.o \
+ advec_w_up.o advec_w_ups.o asselin_filter.o average_3d_data.o \
+ boundary_conds.o buoyancy.o calc_liquid_water_content.o \
+ calc_precipitation.o calc_radiation.o calc_spectra.o \
+ check_for_restart.o check_open.o check_parameters.o close_file.o \
+ compute_vpt.o coriolis.o cpu_log.o cpu_statistics.o data_log.o \
+ data_output_dvrp.o data_output_profiles.o data_output_ptseries.o \
+ data_output_spectra.o data_output_tseries.o data_output_2d.o \
+ data_output_3d.o diffusion_e.o diffusion_s.o diffusion_u.o \
+ diffusion_v.o diffusion_w.o diffusivities.o disturb_field.o \
+ disturb_heatflux.o eqn_state_seawater.o exchange_horiz.o exchange_horiz_2d.o fft_xy.o \
+ flow_statistics.o global_min_max.o header.o impact_of_latent_heat.o \
+ init_1d_model.o init_3d_model.o init_advec.o init_cloud_physics.o \
+ init_dvrp.o init_grid.o init_ocean.o init_particles.o init_pegrid.o \
+ init_pt_anomaly.o init_rankine.o init_slope.o \
+ interaction_droplets_ptq.o local_flush.o local_getenv.o local_stop.o \
+ local_system.o local_tremain.o local_tremain_ini.o modules.o netcdf.o \
+ package_parin.o palm.o parin.o particle_boundary_conds.o \
+ plant_canopy_model.o poisfft.o \
+ poisfft_hybrid.o poismg.o prandtl_fluxes.o pres.o print_1d.o \
+ production_e.o prognostic_equations.o random_function.o random_gauss.o \
+ read_3d_binary.o read_var_list.o run_control.o singleton.o sor.o \
+ spline_x.o spline_y.o spline_z.o sum_up_3d_data.o surface_coupler.o \
+ swap_timelevel.o temperton_fft.o time_integration.o time_to_string.o \
+ timestep.o timestep_scheme_steering.o transpose.o user_interface.o \
+ wall_fluxes.o write_3d_binary.o write_compressed.o write_var_list.o
+
+CC = cc
+CFLAGS = -O
+
+F90 =
+COPT =
+F90FLAGS =
+LDFLAGS =
+
+
+.SUFFIXES:
+.SUFFIXES: .o .f90
+
+
+all: $(PROG)
+
+$(PROG): $(OBJS)
+ $(F90) -o $(PROG) $(OBJS) $(LDFLAGS)
+
+clean:
+ rm -f $(PROG) $(OBJS) *.mod *.i *.lst
+
+.f90.o:
+ $(F90) $(F90FLAGS) $(COPT) -c $<
+
+
+
+advec_particles.o: modules.o random_function.o
+advec_s_bc.o: modules.o
+advec_s_pw.o: modules.o
+advec_s_up.o: modules.o
+advec_s_ups.o: modules.o
+advec_u_pw.o: modules.o
+advec_u_up.o: modules.o
+advec_u_ups.o: modules.o
+advec_v_pw.o: modules.o
+advec_v_up.o: modules.o
+advec_v_ups.o: modules.o
+advec_w_pw.o: modules.o
+advec_w_up.o: modules.o
+advec_w_ups.o: modules.o
+asselin_filter.o: modules.o
+average_3d_data.o: modules.o
+boundary_conds.o: modules.o
+buoyancy.o: modules.o
+calc_liquid_water_content.o: modules.o
+calc_precipitation.o: modules.o
+calc_radiation.o: modules.o
+calc_spectra.o: modules.o fft_xy.o
+check_for_restart.o: modules.o
+check_open.o: modules.o
+check_parameters.o: modules.o
+close_file.o: modules.o
+compute_vpt.o: modules.o
+coriolis.o: modules.o
+cpu_log.o: modules.o
+cpu_statistics.o: modules.o
+data_log.o: modules.o
+data_output_dvrp.o: modules.o
+data_output_profiles.o: modules.o
+data_output_ptseries.o: modules.o
+data_output_spectra.o: modules.o
+data_output_tseries.o: modules.o
+data_output_2d.o: modules.o
+data_output_3d.o: modules.o
+diffusion_e.o: modules.o
+diffusion_s.o: modules.o
+diffusion_u.o: modules.o wall_fluxes.o
+diffusion_v.o: modules.o wall_fluxes.o
+diffusion_w.o: modules.o wall_fluxes.o
+diffusivities.o: modules.o
+disturb_field.o: modules.o random_function.o
+disturb_heatflux.o: modules.o
+eqn_state_seawater.o: modules.o
+exchange_horiz.o: modules.o
+exchange_horiz_2d.o: modules.o
+fft_xy.o: modules.o singleton.o temperton_fft.o
+flow_statistics.o: modules.o
+global_min_max.o: modules.o
+header.o: modules.o
+impact_of_latent_heat.o: modules.o
+init_1d_model.o: modules.o
+init_3d_model.o: modules.o random_function.o
+init_advec.o: modules.o
+init_cloud_physics.o: modules.o
+init_dvrp.o: modules.o
+init_grid.o: modules.o
+init_ocean.o: modules.o eqn_state_seawater.o
+init_particles.o: modules.o random_function.o
+init_pegrid.o: modules.o fft_xy.o poisfft.o poisfft_hybrid.o
+init_pt_anomaly.o: modules.o
+init_rankine.o: modules.o
+init_slope.o: modules.o
+interaction_droplets_ptq.o: modules.o
+local_getenv.o: modules.o
+local_stop.o: modules.o
+local_tremain.o: modules.o
+local_tremain_ini.o: modules.o
+modules.o: modules.f90
+netcdf.o: modules.o
+package_parin.o: modules.o
+palm.o: modules.o
+parin.o: modules.o
+particle_boundary_conds.o: modules.o
+plant_canopy_model.o: modules.o
+poisfft.o: modules.o fft_xy.o
+poisfft_hybrid.o: modules.o fft_xy.o
+poismg.o: modules.o
+prandtl_fluxes.o: modules.o
+pres.o: modules.o poisfft.o poisfft_hybrid.o
+print_1d.o: modules.o
+production_e.o: modules.o wall_fluxes.o
+prognostic_equations.o: modules.o advec_s_pw.o advec_s_up.o advec_u_pw.o \
+ advec_u_up.o advec_v_pw.o advec_v_up.o advec_w_pw.o advec_w_up.o \
+ buoyancy.o calc_precipitation.o calc_radiation.o coriolis.o \
+ diffusion_e.o diffusion_s.o diffusion_u.o diffusion_v.o diffusion_w.o \
+ eqn_state_seawater.o impact_of_latent_heat.o \
+ plant_canopy_model.o production_e.o \
+ user_interface.o
+random_gauss.o: random_function.o
+read_3d_binary.o: modules.o random_function.o
+read_var_list.o: modules.o
+run_control.o: modules.o
+singleton.o: singleton.f90
+sor.o: modules.o
+spline_x.o: modules.o
+spline_y.o: modules.o
+spline_z.o: modules.o
+sum_up_3d_data.o: modules.o
+surface_coupler.o: modules.o
+swap_timelevel.o: modules.o
+temperton_fft.o: modules.o
+time_integration.o: modules.o prognostic_equations.o user_interface.o \
+ interaction_droplets_ptq.o
+timestep.o: modules.o
+timestep_scheme_steering.o: modules.o
+transpose.o: modules.o
+user_interface.o: modules.o user_interface.f90
+wall_fluxes.o: modules.o
+write_3d_binary.o: modules.o random_function.o
+write_compressed.o: modules.o
+write_var_list.o: modules.o
+
Index: /palm/tags/release-3.4a/SOURCE/advec_particles.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/advec_particles.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/advec_particles.f90 (revision 141)
@@ -0,0 +1,3941 @@
+ SUBROUTINE advec_particles
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+! TEST: PRINT statements on unit 9 (commented out)
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 119 2007-10-17 10:27:13Z raasch
+! Sorting of particles is controlled by dt_sort_particles and moved from
+! the SGS timestep loop after the end of this loop.
+! Bugfix: pleft/pright changed to pnorth/psouth in sendrecv of particle tail
+! numbers along y
+! Small bugfixes in the SGS part
+!
+! 106 2007-08-16 14:30:26Z raasch
+! remaining variables iran changed to iran_part
+!
+! 95 2007-06-02 16:48:38Z raasch
+! hydro_press renamed hyp
+!
+! 75 2007-03-22 09:54:05Z raasch
+! Particle reflection at vertical walls implemented in new subroutine
+! particle_boundary_conds,
+! vertical walls are regarded in the SGS model,
+! + user_advec_particles, particles-package is now part of the defaut code,
+! array arguments in sendrecv calls have to refer to first element (1) due to
+! mpich (mpiI) interface requirements,
+! 2nd+3rd argument removed from exchange horiz
+!
+! 16 2007-02-15 13:16:47Z raasch
+! Bugfix: wrong if-clause from revision 1.32
+!
+! r4 | raasch | 2007-02-13 12:33:16 +0100 (Tue, 13 Feb 2007)
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.32 2007/02/11 12:48:20 raasch
+! Allways the lower level k is used for interpolation
+! Bugfix: new particles are released only if end_time_prel > simulated_time
+! Bugfix: transfer of particles when x < -0.5*dx (0.0 before), etc.,
+! index i,j used instead of cartesian (x,y) coordinate to check for
+! transfer because this failed under very rare conditions
+! Bugfix: calculation of number of particles with same radius as the current
+! particle (cloud droplet code)
+!
+! Revision 1.31 2006/08/17 09:21:01 raasch
+! Two more compilation errors removed from the last revision
+!
+! Revision 1.30 2006/08/17 09:11:17 raasch
+! Two compilation errors removed from the last revision
+!
+! Revision 1.29 2006/08/04 14:05:01 raasch
+! Subgrid scale velocities are (optionally) included for calculating the
+! particle advection, new counters trlp_count_sum, etc. for accumulating
+! the number of particles exchanged between the subdomains during all
+! sub-timesteps (if sgs velocities are included), +3d-arrays de_dx/y/z,
+! izuf renamed iran, output of particle time series
+!
+! Revision 1.1 1999/11/25 16:16:06 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Particle advection
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE cloud_parameters
+ USE constants
+ USE control_parameters
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE netcdf_control
+ USE particle_attributes
+ USE pegrid
+ USE random_function_mod
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: agp, deleted_particles, deleted_tails, i, ie, ii, inc, is, j, &
+ jj, js, k, kk, kw, m, n, nc, nn, num_gp, psi, tlength, &
+ trlp_count, trlp_count_sum, trlp_count_recv, &
+ trlp_count_recv_sum, trlpt_count, trlpt_count_recv, &
+ trnp_count, trnp_count_sum, trnp_count_recv, &
+ trnp_count_recv_sum, trnpt_count, trnpt_count_recv, &
+ trrp_count, trrp_count_sum, trrp_count_recv, &
+ trrp_count_recv_sum, trrpt_count, trrpt_count_recv, &
+ trsp_count, trsp_count_sum, trsp_count_recv, &
+ trsp_count_recv_sum, trspt_count, trspt_count_recv, nd
+
+ INTEGER :: gp_outside_of_building(1:8)
+
+ LOGICAL :: dt_3d_reached, dt_3d_reached_l, prt_position
+
+ REAL :: aa, arg, bb, cc, dd, delta_r, dens_ratio, de_dt, de_dt_min, &
+ de_dx_int, de_dx_int_l, de_dx_int_u, de_dy_int, de_dy_int_l, &
+ de_dy_int_u, de_dz_int, de_dz_int_l, de_dz_int_u, diss_int, &
+ diss_int_l, diss_int_u, distance, dt_gap, dt_particle, &
+ dt_particle_m, d_radius, d_sum, e_a, e_int, e_int_l, e_int_u, &
+ e_mean_int, e_s, exp_arg, exp_term, fs_int, gg, &
+ lagr_timescale, mean_r, new_r, p_int, pt_int, pt_int_l, &
+ pt_int_u, q_int, q_int_l, q_int_u, ql_int, ql_int_l, ql_int_u, &
+ random_gauss, sl_r3, sl_r4, s_r3, s_r4, t_int, u_int, u_int_l, &
+ u_int_u, vv_int, v_int, v_int_l, v_int_u, w_int, w_int_l, &
+ w_int_u, x, y
+
+ REAL, DIMENSION(1:30) :: de_dxi, de_dyi, de_dzi, dissi, d_gp_pl, ei
+
+ REAL :: location(1:30,1:3)
+
+ REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) :: de_dx, de_dy, de_dz
+
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: trlpt, trnpt, trrpt, trspt
+
+ TYPE(particle_type) :: tmp_particle
+
+ TYPE(particle_type), DIMENSION(:), ALLOCATABLE :: trlp, trnp, trrp, trsp
+
+
+ CALL cpu_log( log_point(25), 'advec_particles', 'start' )
+
+! IF ( number_of_particles /= number_of_tails ) THEN
+! WRITE (9,*) '--- advec_particles: #1'
+! WRITE (9,*) ' #of p=',number_of_particles,' #of t=',number_of_tails
+! CALL local_flush( 9 )
+! ENDIF
+!
+!-- Write particle data on file for later analysis.
+!-- This has to be done here (before particles are advected) in order
+!-- to allow correct output in case of dt_write_particle_data = dt_prel =
+!-- particle_maximum_age. Otherwise (if output is done at the end of this
+!-- subroutine), the relevant particles would have been already deleted.
+!-- The MOD function allows for changes in the output interval with restart
+!-- runs.
+!-- Attention: change version number for unit 85 (in routine check_open)
+!-- whenever the output format for this unit is changed!
+ time_write_particle_data = time_write_particle_data + dt_3d
+ IF ( time_write_particle_data >= dt_write_particle_data ) THEN
+
+ CALL cpu_log( log_point_s(40), 'advec_part_io', 'start' )
+ CALL check_open( 85 )
+ WRITE ( 85 ) simulated_time, maximum_number_of_particles, &
+ number_of_particles
+ WRITE ( 85 ) particles
+ WRITE ( 85 ) maximum_number_of_tailpoints, maximum_number_of_tails, &
+ number_of_tails
+ WRITE ( 85 ) particle_tail_coordinates
+ CALL close_file( 85 )
+
+ IF ( netcdf_output ) CALL output_particles_netcdf
+
+ time_write_particle_data = MOD( time_write_particle_data, &
+ MAX( dt_write_particle_data, dt_3d ) )
+ CALL cpu_log( log_point_s(40), 'advec_part_io', 'stop' )
+ ENDIF
+
+!
+!-- Calculate exponential term used in case of particle inertia for each
+!-- of the particle groups
+ CALL cpu_log( log_point_s(41), 'advec_part_exp', 'start' )
+ DO m = 1, number_of_particle_groups
+ IF ( particle_groups(m)%density_ratio /= 0.0 ) THEN
+ particle_groups(m)%exp_arg = &
+ 4.5 * particle_groups(m)%density_ratio * &
+ molecular_viscosity / ( particle_groups(m)%radius )**2
+ particle_groups(m)%exp_term = EXP( -particle_groups(m)%exp_arg * &
+ dt_3d )
+ ENDIF
+ ENDDO
+ CALL cpu_log( log_point_s(41), 'advec_part_exp', 'stop' )
+
+! WRITE ( 9, * ) '*** advec_particles: ##0.3'
+! CALL local_flush( 9 )
+! nd = 0
+! DO n = 1, number_of_particles
+! IF ( .NOT. particle_mask(n) ) nd = nd + 1
+! ENDDO
+! IF ( nd /= deleted_particles ) THEN
+! WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+
+!
+!-- Particle (droplet) growth by condensation/evaporation and collision
+ IF ( cloud_droplets ) THEN
+
+!
+!-- Reset summation arrays
+ ql_c = 0.0; ql_v = 0.0; ql_vp = 0.0
+
+!
+!-- Particle growth by condensation/evaporation
+ CALL cpu_log( log_point_s(42), 'advec_part_cond', 'start' )
+ DO n = 1, number_of_particles
+!
+!-- Interpolate temperature and humidity.
+!-- First determine left, south, and bottom index of the arrays.
+ i = particles(n)%x * ddx
+ j = particles(n)%y * ddy
+ k = ( particles(n)%z + 0.5 * dz ) / dz ! only exact if equidistant
+
+ x = particles(n)%x - i * dx
+ y = particles(n)%y - j * dy
+ aa = x**2 + y**2
+ bb = ( dx - x )**2 + y**2
+ cc = x**2 + ( dy - y )**2
+ dd = ( dx - x )**2 + ( dy - y )**2
+ gg = aa + bb + cc + dd
+
+ pt_int_l = ( ( gg - aa ) * pt(k,j,i) + ( gg - bb ) * pt(k,j,i+1) &
+ + ( gg - cc ) * pt(k,j+1,i) + ( gg - dd ) * pt(k,j+1,i+1) &
+ ) / ( 3.0 * gg )
+
+ pt_int_u = ( ( gg-aa ) * pt(k+1,j,i) + ( gg-bb ) * pt(k+1,j,i+1) &
+ + ( gg-cc ) * pt(k+1,j+1,i) + ( gg-dd ) * pt(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg )
+
+ pt_int = pt_int_l + ( particles(n)%z - zu(k) ) / dz * &
+ ( pt_int_u - pt_int_l )
+
+ q_int_l = ( ( gg - aa ) * q(k,j,i) + ( gg - bb ) * q(k,j,i+1) &
+ + ( gg - cc ) * q(k,j+1,i) + ( gg - dd ) * q(k,j+1,i+1) &
+ ) / ( 3.0 * gg )
+
+ q_int_u = ( ( gg-aa ) * q(k+1,j,i) + ( gg-bb ) * q(k+1,j,i+1) &
+ + ( gg-cc ) * q(k+1,j+1,i) + ( gg-dd ) * q(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg )
+
+ q_int = q_int_l + ( particles(n)%z - zu(k) ) / dz * &
+ ( q_int_u - q_int_l )
+
+ ql_int_l = ( ( gg - aa ) * ql(k,j,i) + ( gg - bb ) * ql(k,j,i+1) &
+ + ( gg - cc ) * ql(k,j+1,i) + ( gg - dd ) * ql(k,j+1,i+1) &
+ ) / ( 3.0 * gg )
+
+ ql_int_u = ( ( gg-aa ) * ql(k+1,j,i) + ( gg-bb ) * ql(k+1,j,i+1) &
+ + ( gg-cc ) * ql(k+1,j+1,i) + ( gg-dd ) * ql(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg )
+
+ ql_int = ql_int_l + ( particles(n)%z - zu(k) ) / dz * &
+ ( ql_int_u - ql_int_l )
+
+!
+!-- Calculate real temperature and saturation vapor pressure
+ p_int = hyp(k) + ( particles(n)%z - zu(k) ) / dz * ( hyp(k+1)-hyp(k) )
+ t_int = pt_int * ( p_int / 100000.0 )**0.286
+
+ e_s = 611.0 * EXP( l_d_rv * ( 3.6609E-3 - 1.0 / t_int ) )
+
+!
+!-- Current vapor pressure
+ e_a = q_int * p_int / ( 0.378 * q_int + 0.622 )
+
+!
+!-- Change in radius by condensation/evaporation
+!-- ATTENTION: this is only an approximation for large radii
+ arg = particles(n)%radius**2 + 2.0 * dt_3d * &
+ ( e_a / e_s - 1.0 ) / &
+ ( ( l_d_rv / t_int - 1.0 ) * l_v * rho_l / t_int / &
+ thermal_conductivity_l + &
+ rho_l * r_v * t_int / diff_coeff_l / e_s )
+ IF ( arg < 1.0E-14 ) THEN
+ new_r = 1.0E-7
+ ELSE
+ new_r = SQRT( arg )
+ ENDIF
+
+ delta_r = new_r - particles(n)%radius
+
+! NOTE: this is the correct formula (indipendent of radius).
+! nevertheless, it give wrong results for large timesteps
+! d_radius = 1.0 / particles(n)%radius
+! delta_r = d_radius * ( e_a / e_s - 1.0 - 3.3E-7 / t_int * d_radius + &
+! b_cond * d_radius**3 ) / &
+! ( ( l_d_rv / t_int - 1.0 ) * l_v * rho_l / t_int / &
+! thermal_conductivity_l + &
+! rho_l * r_v * t_int / diff_coeff_l / e_s ) * dt_3d
+
+! new_r = particles(n)%radius + delta_r
+! IF ( new_r < 1.0E-7 ) new_r = 1.0E-7
+
+!
+!-- Sum up the change in volume of liquid water for the respective grid
+!-- volume (this is needed later on for calculating the release of
+!-- latent heat)
+ i = ( particles(n)%x + 0.5 * dx ) * ddx
+ j = ( particles(n)%y + 0.5 * dy ) * ddy
+ k = particles(n)%z / dz + 1 ! only exact if equidistant
+
+ ql_c(k,j,i) = ql_c(k,j,i) + particles(n)%weight_factor * &
+ rho_l * 1.33333333 * pi * &
+ ( new_r**3 - particles(n)%radius**3 ) / &
+ ( rho_surface * dx * dy * dz )
+ IF ( ql_c(k,j,i) > 100.0 ) THEN
+ print*,'+++ advec_particles k=',k,' j=',j,' i=',i, &
+ ' ql_c=',ql_c(k,j,i), ' part(',n,')%wf=', &
+ particles(n)%weight_factor,' delta_r=',delta_r
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ STOP
+#endif
+ ENDIF
+
+!
+!-- Change the droplet radius
+ IF ( ( new_r - particles(n)%radius ) < 0.0 .AND. new_r < 0.0 ) &
+ THEN
+ print*,'+++ advec_particles #1 k=',k,' j=',j,' i=',i, &
+ ' e_s=',e_s, ' e_a=',e_a,' t_int=',t_int, &
+ ' d_radius=',d_radius,' delta_r=',delta_r,&
+ ' particle_radius=',particles(n)%radius
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ STOP
+#endif
+ ENDIF
+ particles(n)%radius = new_r
+
+!
+!-- Sum up the total volume of liquid water (needed below for
+!-- re-calculating the weighting factors)
+ ql_v(k,j,i) = ql_v(k,j,i) + particles(n)%weight_factor * &
+ particles(n)%radius**3
+ ENDDO
+ CALL cpu_log( log_point_s(42), 'advec_part_cond', 'stop' )
+
+!
+!-- Particle growth by collision
+ CALL cpu_log( log_point_s(43), 'advec_part_coll', 'start' )
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+!
+!-- Collision requires at least two particles in the box
+ IF ( prt_count(k,j,i) > 1 ) THEN
+!
+!-- First, sort particles within the gridbox by their size,
+!-- using Shell's method (see Numerical Recipes)
+!-- NOTE: In case of using particle tails, the re-sorting of
+!-- ---- tails would have to be included here!
+ psi = prt_start_index(k,j,i) - 1
+ inc = 1
+ DO WHILE ( inc <= prt_count(k,j,i) )
+ inc = 3 * inc + 1
+ ENDDO
+
+ DO WHILE ( inc > 1 )
+ inc = inc / 3
+ DO is = inc+1, prt_count(k,j,i)
+ tmp_particle = particles(psi+is)
+ js = is
+ DO WHILE ( particles(psi+js-inc)%radius > &
+ tmp_particle%radius )
+ particles(psi+js) = particles(psi+js-inc)
+ js = js - inc
+ IF ( js <= inc ) EXIT
+ ENDDO
+ particles(psi+js) = tmp_particle
+ ENDDO
+ ENDDO
+
+!
+!-- Calculate the mean radius of all those particles which
+!-- are of smaller or equal size than the current particle
+!-- and use this radius for calculating the collision efficiency
+ psi = prt_start_index(k,j,i)
+ s_r3 = 0.0
+ s_r4 = 0.0
+ DO n = psi, psi+prt_count(k,j,i)-1
+!
+!-- There may be some particles of size equal to the
+!-- current particle but with larger index
+ sl_r3 = 0.0
+ sl_r4 = 0.0
+ DO is = n, psi+prt_count(k,j,i)-2
+ IF ( particles(is+1)%radius == &
+ particles(is)%radius ) THEN
+ sl_r3 = sl_r3 + particles(is+1)%radius**3
+ sl_r4 = sl_r4 + particles(is+1)%radius**4
+ ELSE
+ EXIT
+ ENDIF
+ ENDDO
+
+ IF ( ( s_r3 + sl_r3 ) > 0.0 ) THEN
+
+ mean_r = ( s_r4 + sl_r4 ) / ( s_r3 + sl_r3 )
+
+ CALL collision_efficiency( mean_r, &
+ particles(n)%radius, &
+ effective_coll_efficiency )
+
+ ELSE
+ effective_coll_efficiency = 0.0
+ ENDIF
+
+!
+!-- Contribution of the current particle to the next one
+ s_r3 = s_r3 + particles(n)%radius**3
+ s_r4 = s_r4 + particles(n)%radius**4
+
+ IF ( effective_coll_efficiency > 1.0 .OR. &
+ effective_coll_efficiency < 0.0 ) &
+ THEN
+ print*,'+++ advec_particles collision_efficiency ', &
+ 'out of range:', effective_coll_efficiency
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ STOP
+#endif
+ ENDIF
+
+!
+!-- Interpolation of ...
+ ii = particles(n)%x * ddx
+ jj = particles(n)%y * ddy
+ kk = ( particles(n)%z + 0.5 * dz ) / dz
+
+ x = particles(n)%x - ii * dx
+ y = particles(n)%y - jj * dy
+ aa = x**2 + y**2
+ bb = ( dx - x )**2 + y**2
+ cc = x**2 + ( dy - y )**2
+ dd = ( dx - x )**2 + ( dy - y )**2
+ gg = aa + bb + cc + dd
+
+ ql_int_l = ( ( gg-aa ) * ql(kk,jj,ii) + ( gg-bb ) * &
+ ql(kk,jj,ii+1) &
+ + ( gg-cc ) * ql(kk,jj+1,ii) + ( gg-dd ) * &
+ ql(kk,jj+1,ii+1) &
+ ) / ( 3.0 * gg )
+
+ ql_int_u = ( ( gg-aa ) * ql(kk+1,jj,ii) + ( gg-bb ) * &
+ ql(kk+1,jj,ii+1) &
+ + ( gg-cc ) * ql(kk+1,jj+1,ii) + ( gg-dd ) * &
+ ql(kk+1,jj+1,ii+1) &
+ ) / ( 3.0 * gg )
+
+ ql_int = ql_int_l + ( particles(n)%z - zu(kk) ) / dz * &
+ ( ql_int_u - ql_int_l )
+
+!
+!-- Interpolate u velocity-component
+ ii = ( particles(n)%x + 0.5 * dx ) * ddx
+ jj = particles(n)%y * ddy
+ kk = ( particles(n)%z + 0.5 * dz ) / dz ! only if eq.dist
+
+ IF ( ( particles(n)%z - zu(kk) ) > ( 0.5*dz ) ) kk = kk+1
+
+ x = particles(n)%x + ( 0.5 - ii ) * dx
+ y = particles(n)%y - jj * dy
+ aa = x**2 + y**2
+ bb = ( dx - x )**2 + y**2
+ cc = x**2 + ( dy - y )**2
+ dd = ( dx - x )**2 + ( dy - y )**2
+ gg = aa + bb + cc + dd
+
+ u_int_l = ( ( gg-aa ) * u(kk,jj,ii) + ( gg-bb ) * &
+ u(kk,jj,ii+1) &
+ + ( gg-cc ) * u(kk,jj+1,ii) + ( gg-dd ) * &
+ u(kk,jj+1,ii+1) &
+ ) / ( 3.0 * gg ) - u_gtrans
+ IF ( kk+1 == nzt+1 ) THEN
+ u_int = u_int_l
+ ELSE
+ u_int_u = ( ( gg-aa ) * u(kk+1,jj,ii) + ( gg-bb ) * &
+ u(kk+1,jj,ii+1) &
+ + ( gg-cc ) * u(kk+1,jj+1,ii) + ( gg-dd ) * &
+ u(kk+1,jj+1,ii+1) &
+ ) / ( 3.0 * gg ) - u_gtrans
+ u_int = u_int_l + ( particles(n)%z - zu(kk) ) / dz * &
+ ( u_int_u - u_int_l )
+ ENDIF
+
+!
+!-- Same procedure for interpolation of the v velocity-compo-
+!-- nent (adopt index k from u velocity-component)
+ ii = particles(n)%x * ddx
+ jj = ( particles(n)%y + 0.5 * dy ) * ddy
+
+ x = particles(n)%x - ii * dx
+ y = particles(n)%y + ( 0.5 - jj ) * dy
+ aa = x**2 + y**2
+ bb = ( dx - x )**2 + y**2
+ cc = x**2 + ( dy - y )**2
+ dd = ( dx - x )**2 + ( dy - y )**2
+ gg = aa + bb + cc + dd
+
+ v_int_l = ( ( gg-aa ) * v(kk,jj,ii) + ( gg-bb ) * &
+ v(kk,jj,ii+1) &
+ + ( gg-cc ) * v(kk,jj+1,ii) + ( gg-dd ) * &
+ v(kk,jj+1,ii+1) &
+ ) / ( 3.0 * gg ) - v_gtrans
+ IF ( kk+1 == nzt+1 ) THEN
+ v_int = v_int_l
+ ELSE
+ v_int_u = ( ( gg-aa ) * v(kk+1,jj,ii) + ( gg-bb ) * &
+ v(kk+1,jj,ii+1) &
+ + ( gg-cc ) * v(kk+1,jj+1,ii) + ( gg-dd ) * &
+ v(kk+1,jj+1,ii+1) &
+ ) / ( 3.0 * gg ) - v_gtrans
+ v_int = v_int_l + ( particles(n)%z - zu(kk) ) / dz * &
+ ( v_int_u - v_int_l )
+ ENDIF
+
+!
+!-- Same procedure for interpolation of the w velocity-compo-
+!-- nent (adopt index i from v velocity-component)
+ jj = particles(n)%y * ddy
+ kk = particles(n)%z / dz
+
+ x = particles(n)%x - ii * dx
+ y = particles(n)%y - jj * dy
+ aa = x**2 + y**2
+ bb = ( dx - x )**2 + y**2
+ cc = x**2 + ( dy - y )**2
+ dd = ( dx - x )**2 + ( dy - y )**2
+ gg = aa + bb + cc + dd
+
+ w_int_l = ( ( gg-aa ) * w(kk,jj,ii) + ( gg-bb ) * &
+ w(kk,jj,ii+1) &
+ + ( gg-cc ) * w(kk,jj+1,ii) + ( gg-dd ) * &
+ w(kk,jj+1,ii+1) &
+ ) / ( 3.0 * gg )
+ IF ( kk+1 == nzt+1 ) THEN
+ w_int = w_int_l
+ ELSE
+ w_int_u = ( ( gg-aa ) * w(kk+1,jj,ii) + ( gg-bb ) * &
+ w(kk+1,jj,ii+1) &
+ + ( gg-cc ) * w(kk+1,jj+1,ii) + ( gg-dd ) * &
+ w(kk+1,jj+1,ii+1) &
+ ) / ( 3.0 * gg )
+ w_int = w_int_l + ( particles(n)%z - zw(kk) ) / dz * &
+ ( w_int_u - w_int_l )
+ ENDIF
+
+!
+!-- Change in radius due to collision
+ delta_r = effective_coll_efficiency * &
+ ql_int * rho_surface / ( 1.0 - ql_int ) * &
+ 0.25 / rho_l * &
+ SQRT( ( u_int - particles(n)%speed_x )**2 + &
+ ( v_int - particles(n)%speed_y )**2 + &
+ ( w_int - particles(n)%speed_z )**2 &
+ ) * dt_3d
+
+ particles(n)%radius = particles(n)%radius + delta_r
+
+ ql_vp(k,j,i) = ql_vp(k,j,i) + particles(n)%radius**3
+
+ ENDDO
+
+ ENDIF
+
+!
+!-- Re-calculate the weighting factor (total liquid water content
+!-- must be conserved during collision)
+ IF ( ql_vp(k,j,i) /= 0.0 ) THEN
+
+ ql_vp(k,j,i) = ql_v(k,j,i) / ql_vp(k,j,i)
+!
+!-- Re-assign this weighting factor to the particles of the
+!-- current gridbox
+ psi = prt_start_index(k,j,i)
+ DO n = psi, psi + prt_count(k,j,i)-1
+ particles(n)%weight_factor = ql_vp(k,j,i)
+ ENDDO
+
+ ENDIF
+
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CALL cpu_log( log_point_s(43), 'advec_part_coll', 'stop' )
+
+ ENDIF
+
+
+!
+!-- Particle advection.
+!-- In case of including the SGS velocities, the LES timestep has probably
+!-- to be split into several smaller timesteps because of the Lagrangian
+!-- timescale condition. Because the number of timesteps to be carried out is
+!-- not known at the beginning, these steps are carried out in an infinite loop
+!-- with exit condition.
+!
+!-- If SGS velocities are used, gradients of the TKE have to be calculated and
+!-- boundary conditions have to be set first. Also, horizontally averaged
+!-- profiles of the SGS TKE and the resolved-scale velocity variances are
+!-- needed.
+ IF ( use_sgs_for_particles ) THEN
+
+!
+!-- TKE gradient along x and y
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb, nzt+1
+
+ IF ( k <= nzb_s_inner(j,i-1) .AND. &
+ k > nzb_s_inner(j,i) .AND. &
+ k > nzb_s_inner(j,i+1) ) THEN
+ de_dx(k,j,i) = 2.0 * sgs_wfu_part * &
+ ( e(k,j,i+1) - e(k,j,i) ) * ddx
+ ELSEIF ( k > nzb_s_inner(j,i-1) .AND. &
+ k > nzb_s_inner(j,i) .AND. &
+ k <= nzb_s_inner(j,i+1) ) THEN
+ de_dx(k,j,i) = 2.0 * sgs_wfu_part * &
+ ( e(k,j,i) - e(k,j,i-1) ) * ddx
+ ELSEIF ( k < nzb_s_inner(j,i) .AND. k < nzb_s_inner(j,i+1) ) &
+ THEN
+ de_dx(k,j,i) = 0.0
+ ELSEIF ( k < nzb_s_inner(j,i-1) .AND. k < nzb_s_inner(j,i) ) &
+ THEN
+ de_dx(k,j,i) = 0.0
+ ELSE
+ de_dx(k,j,i) = sgs_wfu_part * &
+ ( e(k,j,i+1) - e(k,j,i-1) ) * ddx
+ ENDIF
+
+ IF ( k <= nzb_s_inner(j-1,i) .AND. &
+ k > nzb_s_inner(j,i) .AND. &
+ k > nzb_s_inner(j+1,i) ) THEN
+ de_dy(k,j,i) = 2.0 * sgs_wfv_part * &
+ ( e(k,j+1,i) - e(k,j,i) ) * ddy
+ ELSEIF ( k > nzb_s_inner(j-1,i) .AND. &
+ k > nzb_s_inner(j,i) .AND. &
+ k <= nzb_s_inner(j+1,i) ) THEN
+ de_dy(k,j,i) = 2.0 * sgs_wfv_part * &
+ ( e(k,j,i) - e(k,j-1,i) ) * ddy
+ ELSEIF ( k < nzb_s_inner(j,i) .AND. k < nzb_s_inner(j+1,i) ) &
+ THEN
+ de_dy(k,j,i) = 0.0
+ ELSEIF ( k < nzb_s_inner(j-1,i) .AND. k < nzb_s_inner(j,i) ) &
+ THEN
+ de_dy(k,j,i) = 0.0
+ ELSE
+ de_dy(k,j,i) = sgs_wfv_part * &
+ ( e(k,j+1,i) - e(k,j-1,i) ) * ddy
+ ENDIF
+
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- TKE gradient along z, including bottom and top boundary conditions
+ DO i = nxl, nxr
+ DO j = nys, nyn
+
+ DO k = nzb_s_inner(j,i)+2, nzt-1
+ de_dz(k,j,i) = 2.0 * sgs_wfw_part * &
+ ( e(k+1,j,i) - e(k-1,j,i) ) / ( zu(k+1)-zu(k-1) )
+ ENDDO
+
+ k = nzb_s_inner(j,i)
+ de_dz(nzb:k,j,i) = 0.0
+ de_dz(k+1,j,i) = 2.0 * sgs_wfw_part * ( e(k+2,j,i) - e(k+1,j,i) ) &
+ / ( zu(k+2) - zu(k+1) )
+ de_dz(nzt,j,i) = 0.0
+ de_dz(nzt+1,j,i) = 0.0
+ ENDDO
+ ENDDO
+
+!
+!-- Lateral boundary conditions
+ CALL exchange_horiz( de_dx )
+ CALL exchange_horiz( de_dy )
+ CALL exchange_horiz( de_dz )
+ CALL exchange_horiz( diss )
+
+!
+!-- Calculate the horizontally averaged profiles of SGS TKE and resolved
+!-- velocity variances (they may have been already calculated in routine
+!-- flow_statistics).
+ IF ( .NOT. flow_statistics_called ) THEN
+!
+!-- First calculate horizontally averaged profiles of the horizontal
+!-- velocities.
+ sums_l(:,1,0) = 0.0
+ sums_l(:,2,0) = 0.0
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_outer(j,i), nzt+1
+ sums_l(k,1,0) = sums_l(k,1,0) + u(k,j,i)
+ sums_l(k,2,0) = sums_l(k,2,0) + v(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+#if defined( __parallel )
+!
+!-- Compute total sum from local sums
+ CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), nzt+2-nzb, &
+ MPI_REAL, MPI_SUM, comm2d, ierr )
+ CALL MPI_ALLREDUCE( sums_l(nzb,2,0), sums(nzb,2), nzt+2-nzb, &
+ MPI_REAL, MPI_SUM, comm2d, ierr )
+#else
+ sums(:,1) = sums_l(:,1,0)
+ sums(:,2) = sums_l(:,2,0)
+#endif
+
+!
+!-- Final values are obtained by division by the total number of grid
+!-- points used for the summation.
+ hom(:,1,1,0) = sums(:,1) / ngp_2dh_outer(:,0) ! u
+ hom(:,1,2,0) = sums(:,2) / ngp_2dh_outer(:,0) ! v
+
+!
+!-- Now calculate the profiles of SGS TKE and the resolved-scale
+!-- velocity variances
+ sums_l(:,8,0) = 0.0
+ sums_l(:,30,0) = 0.0
+ sums_l(:,31,0) = 0.0
+ sums_l(:,32,0) = 0.0
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_outer(j,i), nzt+1
+ sums_l(k,8,0) = sums_l(k,8,0) + e(k,j,i)
+ sums_l(k,30,0) = sums_l(k,30,0) + &
+ ( u(k,j,i) - hom(k,1,1,0) )**2
+ sums_l(k,31,0) = sums_l(k,31,0) + &
+ ( v(k,j,i) - hom(k,1,2,0) )**2
+ sums_l(k,32,0) = sums_l(k,32,0) + w(k,j,i)**2
+ ENDDO
+ ENDDO
+ ENDDO
+
+#if defined( __parallel )
+!
+!-- Compute total sum from local sums
+ CALL MPI_ALLREDUCE( sums_l(nzb,8,0), sums(nzb,8), nzt+2-nzb, &
+ MPI_REAL, MPI_SUM, comm2d, ierr )
+ CALL MPI_ALLREDUCE( sums_l(nzb,30,0), sums(nzb,30), nzt+2-nzb, &
+ MPI_REAL, MPI_SUM, comm2d, ierr )
+ CALL MPI_ALLREDUCE( sums_l(nzb,31,0), sums(nzb,31), nzt+2-nzb, &
+ MPI_REAL, MPI_SUM, comm2d, ierr )
+ CALL MPI_ALLREDUCE( sums_l(nzb,32,0), sums(nzb,32), nzt+2-nzb, &
+ MPI_REAL, MPI_SUM, comm2d, ierr )
+
+#else
+ sums(:,8) = sums_l(:,8,0)
+ sums(:,30) = sums_l(:,30,0)
+ sums(:,31) = sums_l(:,31,0)
+ sums(:,32) = sums_l(:,32,0)
+#endif
+
+!
+!-- Final values are obtained by division by the total number of grid
+!-- points used for the summation.
+ hom(:,1,8,0) = sums(:,8) / ngp_2dh_outer(:,0) ! e
+ hom(:,1,30,0) = sums(:,30) / ngp_2dh_outer(:,0) ! u*2
+ hom(:,1,31,0) = sums(:,31) / ngp_2dh_outer(:,0) ! v*2
+ hom(:,1,32,0) = sums(:,32) / ngp_2dh_outer(:,0) ! w*2
+
+ ENDIF
+
+ ENDIF
+
+!
+!-- Initialize variables used for accumulating the number of particles
+!-- exchanged between the subdomains during all sub-timesteps (if sgs
+!-- velocities are included). These data are output further below on the
+!-- particle statistics file.
+ trlp_count_sum = 0
+ trlp_count_recv_sum = 0
+ trrp_count_sum = 0
+ trrp_count_recv_sum = 0
+ trsp_count_sum = 0
+ trsp_count_recv_sum = 0
+ trnp_count_sum = 0
+ trnp_count_recv_sum = 0
+
+!
+!-- Initialize the variable storing the total time that a particle has advanced
+!-- within the timestep procedure
+ particles(1:number_of_particles)%dt_sum = 0.0
+
+!
+!-- Timestep loop.
+!-- This loop has to be repeated until the advection time of every particle
+!-- (in the total domain!) has reached the LES timestep (dt_3d)
+ DO
+
+ CALL cpu_log( log_point_s(44), 'advec_part_advec', 'start' )
+
+!
+!-- Initialize the switch used for the loop exit condition checked at the
+!-- end of this loop.
+!-- If at least one particle has failed to reach the LES timestep, this
+!-- switch will be set false.
+ dt_3d_reached_l = .TRUE.
+
+!
+!-- Initialize variables for the (sub-) timestep, i.e. for marking those
+!-- particles to be deleted after the timestep
+ particle_mask = .TRUE.
+ deleted_particles = 0
+ trlp_count_recv = 0
+ trnp_count_recv = 0
+ trrp_count_recv = 0
+ trsp_count_recv = 0
+ IF ( use_particle_tails ) THEN
+ tail_mask = .TRUE.
+ deleted_tails = 0
+ ENDIF
+
+
+ DO n = 1, number_of_particles
+!
+!-- Move particles only if the LES timestep has not (approximately) been
+!-- reached
+ IF ( ( dt_3d - particles(n)%dt_sum ) < 1E-8 ) CYCLE
+
+!
+!-- Interpolate u velocity-component, determine left, front, bottom
+!-- index of u-array
+ i = ( particles(n)%x + 0.5 * dx ) * ddx
+ j = particles(n)%y * ddy
+ k = ( particles(n)%z + 0.5 * dz ) / dz ! only exact if equidistant
+
+!
+!-- Interpolation of the velocity components in the xy-plane
+ x = particles(n)%x + ( 0.5 - i ) * dx
+ y = particles(n)%y - j * dy
+ aa = x**2 + y**2
+ bb = ( dx - x )**2 + y**2
+ cc = x**2 + ( dy - y )**2
+ dd = ( dx - x )**2 + ( dy - y )**2
+ gg = aa + bb + cc + dd
+
+ u_int_l = ( ( gg - aa ) * u(k,j,i) + ( gg - bb ) * u(k,j,i+1) &
+ + ( gg - cc ) * u(k,j+1,i) + ( gg - dd ) * u(k,j+1,i+1) &
+ ) / ( 3.0 * gg ) - u_gtrans
+ IF ( k+1 == nzt+1 ) THEN
+ u_int = u_int_l
+ ELSE
+ u_int_u = ( ( gg-aa ) * u(k+1,j,i) + ( gg-bb ) * u(k+1,j,i+1) &
+ + ( gg-cc ) * u(k+1,j+1,i) + ( gg-dd ) * u(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg ) - u_gtrans
+ u_int = u_int_l + ( particles(n)%z - zu(k) ) / dz * &
+ ( u_int_u - u_int_l )
+ ENDIF
+
+!
+!-- Same procedure for interpolation of the v velocity-component (adopt
+!-- index k from u velocity-component)
+ i = particles(n)%x * ddx
+ j = ( particles(n)%y + 0.5 * dy ) * ddy
+
+ x = particles(n)%x - i * dx
+ y = particles(n)%y + ( 0.5 - j ) * dy
+ aa = x**2 + y**2
+ bb = ( dx - x )**2 + y**2
+ cc = x**2 + ( dy - y )**2
+ dd = ( dx - x )**2 + ( dy - y )**2
+ gg = aa + bb + cc + dd
+
+ v_int_l = ( ( gg - aa ) * v(k,j,i) + ( gg - bb ) * v(k,j,i+1) &
+ + ( gg - cc ) * v(k,j+1,i) + ( gg - dd ) * v(k,j+1,i+1) &
+ ) / ( 3.0 * gg ) - v_gtrans
+ IF ( k+1 == nzt+1 ) THEN
+ v_int = v_int_l
+ ELSE
+ v_int_u = ( ( gg-aa ) * v(k+1,j,i) + ( gg-bb ) * v(k+1,j,i+1) &
+ + ( gg-cc ) * v(k+1,j+1,i) + ( gg-dd ) * v(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg ) - v_gtrans
+ v_int = v_int_l + ( particles(n)%z - zu(k) ) / dz * &
+ ( v_int_u - v_int_l )
+ ENDIF
+
+!
+!-- Same procedure for interpolation of the w velocity-component (adopt
+!-- index i from v velocity-component)
+ IF ( vertical_particle_advection ) THEN
+ j = particles(n)%y * ddy
+ k = particles(n)%z / dz
+
+ x = particles(n)%x - i * dx
+ y = particles(n)%y - j * dy
+ aa = x**2 + y**2
+ bb = ( dx - x )**2 + y**2
+ cc = x**2 + ( dy - y )**2
+ dd = ( dx - x )**2 + ( dy - y )**2
+ gg = aa + bb + cc + dd
+
+ w_int_l = ( ( gg - aa ) * w(k,j,i) + ( gg - bb ) * w(k,j,i+1) &
+ + ( gg - cc ) * w(k,j+1,i) + ( gg - dd ) * w(k,j+1,i+1) &
+ ) / ( 3.0 * gg )
+ IF ( k+1 == nzt+1 ) THEN
+ w_int = w_int_l
+ ELSE
+ w_int_u = ( ( gg-aa ) * w(k+1,j,i) + &
+ ( gg-bb ) * w(k+1,j,i+1) + &
+ ( gg-cc ) * w(k+1,j+1,i) + &
+ ( gg-dd ) * w(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg )
+ w_int = w_int_l + ( particles(n)%z - zw(k) ) / dz * &
+ ( w_int_u - w_int_l )
+ ENDIF
+ ELSE
+ w_int = 0.0
+ ENDIF
+
+!
+!-- Interpolate and calculate quantities needed for calculating the SGS
+!-- velocities
+ IF ( use_sgs_for_particles ) THEN
+!
+!-- Interpolate TKE
+ i = particles(n)%x * ddx
+ j = particles(n)%y * ddy
+ k = ( particles(n)%z + 0.5 * dz ) / dz ! only exact if eq.dist
+
+ IF ( topography == 'flat' ) THEN
+
+ x = particles(n)%x - i * dx
+ y = particles(n)%y - j * dy
+ aa = x**2 + y**2
+ bb = ( dx - x )**2 + y**2
+ cc = x**2 + ( dy - y )**2
+ dd = ( dx - x )**2 + ( dy - y )**2
+ gg = aa + bb + cc + dd
+
+ e_int_l = ( ( gg-aa ) * e(k,j,i) + ( gg-bb ) * e(k,j,i+1) &
+ + ( gg-cc ) * e(k,j+1,i) + ( gg-dd ) * e(k,j+1,i+1) &
+ ) / ( 3.0 * gg )
+
+ IF ( k+1 == nzt+1 ) THEN
+ e_int = e_int_l
+ ELSE
+ e_int_u = ( ( gg - aa ) * e(k+1,j,i) + &
+ ( gg - bb ) * e(k+1,j,i+1) + &
+ ( gg - cc ) * e(k+1,j+1,i) + &
+ ( gg - dd ) * e(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg )
+ e_int = e_int_l + ( particles(n)%z - zu(k) ) / dz * &
+ ( e_int_u - e_int_l )
+ ENDIF
+
+!
+!-- Interpolate the TKE gradient along x (adopt incides i,j,k and
+!-- all position variables from above (TKE))
+ de_dx_int_l = ( ( gg - aa ) * de_dx(k,j,i) + &
+ ( gg - bb ) * de_dx(k,j,i+1) + &
+ ( gg - cc ) * de_dx(k,j+1,i) + &
+ ( gg - dd ) * de_dx(k,j+1,i+1) &
+ ) / ( 3.0 * gg )
+
+ IF ( ( k+1 == nzt+1 ) .OR. ( k == nzb ) ) THEN
+ de_dx_int = de_dx_int_l
+ ELSE
+ de_dx_int_u = ( ( gg - aa ) * de_dx(k+1,j,i) + &
+ ( gg - bb ) * de_dx(k+1,j,i+1) + &
+ ( gg - cc ) * de_dx(k+1,j+1,i) + &
+ ( gg - dd ) * de_dx(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg )
+ de_dx_int = de_dx_int_l + ( particles(n)%z - zu(k) ) / dz * &
+ ( de_dx_int_u - de_dx_int_l )
+ ENDIF
+
+!
+!-- Interpolate the TKE gradient along y
+ de_dy_int_l = ( ( gg - aa ) * de_dy(k,j,i) + &
+ ( gg - bb ) * de_dy(k,j,i+1) + &
+ ( gg - cc ) * de_dy(k,j+1,i) + &
+ ( gg - dd ) * de_dy(k,j+1,i+1) &
+ ) / ( 3.0 * gg )
+ IF ( ( k+1 == nzt+1 ) .OR. ( k == nzb ) ) THEN
+ de_dy_int = de_dy_int_l
+ ELSE
+ de_dy_int_u = ( ( gg - aa ) * de_dy(k+1,j,i) + &
+ ( gg - bb ) * de_dy(k+1,j,i+1) + &
+ ( gg - cc ) * de_dy(k+1,j+1,i) + &
+ ( gg - dd ) * de_dy(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg )
+ de_dy_int = de_dy_int_l + ( particles(n)%z - zu(k) ) / dz * &
+ ( de_dy_int_u - de_dy_int_l )
+ ENDIF
+
+!
+!-- Interpolate the TKE gradient along z
+ IF ( particles(n)%z < 0.5 * dz ) THEN
+ de_dz_int = 0.0
+ ELSE
+ de_dz_int_l = ( ( gg - aa ) * de_dz(k,j,i) + &
+ ( gg - bb ) * de_dz(k,j,i+1) + &
+ ( gg - cc ) * de_dz(k,j+1,i) + &
+ ( gg - dd ) * de_dz(k,j+1,i+1) &
+ ) / ( 3.0 * gg )
+
+ IF ( ( k+1 == nzt+1 ) .OR. ( k == nzb ) ) THEN
+ de_dz_int = de_dz_int_l
+ ELSE
+ de_dz_int_u = ( ( gg - aa ) * de_dz(k+1,j,i) + &
+ ( gg - bb ) * de_dz(k+1,j,i+1) + &
+ ( gg - cc ) * de_dz(k+1,j+1,i) + &
+ ( gg - dd ) * de_dz(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg )
+ de_dz_int = de_dz_int_l + ( particles(n)%z - zu(k) ) / dz * &
+ ( de_dz_int_u - de_dz_int_l )
+ ENDIF
+ ENDIF
+
+!
+!-- Interpolate the dissipation of TKE
+ diss_int_l = ( ( gg - aa ) * diss(k,j,i) + &
+ ( gg - bb ) * diss(k,j,i+1) + &
+ ( gg - cc ) * diss(k,j+1,i) + &
+ ( gg - dd ) * diss(k,j+1,i+1) &
+ ) / ( 3.0 * gg )
+
+ IF ( k+1 == nzt+1 ) THEN
+ diss_int = diss_int_l
+ ELSE
+ diss_int_u = ( ( gg - aa ) * diss(k+1,j,i) + &
+ ( gg - bb ) * diss(k+1,j,i+1) + &
+ ( gg - cc ) * diss(k+1,j+1,i) + &
+ ( gg - dd ) * diss(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg )
+ diss_int = diss_int_l + ( particles(n)%z - zu(k) ) / dz * &
+ ( diss_int_u - diss_int_l )
+ ENDIF
+
+ ELSE
+
+!
+!-- In case that there are buildings it has to be determined
+!-- how many of the gridpoints defining the particle box are
+!-- situated within a building
+!-- gp_outside_of_building(1): i,j,k
+!-- gp_outside_of_building(2): i,j+1,k
+!-- gp_outside_of_building(3): i,j,k+1
+!-- gp_outside_of_building(4): i,j+1,k+1
+!-- gp_outside_of_building(5): i+1,j,k
+!-- gp_outside_of_building(6): i+1,j+1,k
+!-- gp_outside_of_building(7): i+1,j,k+1
+!-- gp_outside_of_building(8): i+1,j+1,k+1
+
+ gp_outside_of_building = 0
+ location = 0.0
+ num_gp = 0
+
+ IF ( k > nzb_s_inner(j,i) .OR. nzb_s_inner(j,i) == 0 ) THEN
+ num_gp = num_gp + 1
+ gp_outside_of_building(1) = 1
+ location(num_gp,1) = i * dx
+ location(num_gp,2) = j * dy
+ location(num_gp,3) = k * dz - 0.5 * dz
+ ei(num_gp) = e(k,j,i)
+ dissi(num_gp) = diss(k,j,i)
+ de_dxi(num_gp) = de_dx(k,j,i)
+ de_dyi(num_gp) = de_dy(k,j,i)
+ de_dzi(num_gp) = de_dz(k,j,i)
+ ENDIF
+
+ IF ( k > nzb_s_inner(j+1,i) .OR. nzb_s_inner(j+1,i) == 0 ) &
+ THEN
+ num_gp = num_gp + 1
+ gp_outside_of_building(2) = 1
+ location(num_gp,1) = i * dx
+ location(num_gp,2) = (j+1) * dy
+ location(num_gp,3) = k * dz - 0.5 * dz
+ ei(num_gp) = e(k,j+1,i)
+ dissi(num_gp) = diss(k,j+1,i)
+ de_dxi(num_gp) = de_dx(k,j+1,i)
+ de_dyi(num_gp) = de_dy(k,j+1,i)
+ de_dzi(num_gp) = de_dz(k,j+1,i)
+ ENDIF
+
+ IF ( k+1 > nzb_s_inner(j,i) .OR. nzb_s_inner(j,i) == 0 ) THEN
+ num_gp = num_gp + 1
+ gp_outside_of_building(3) = 1
+ location(num_gp,1) = i * dx
+ location(num_gp,2) = j * dy
+ location(num_gp,3) = (k+1) * dz - 0.5 * dz
+ ei(num_gp) = e(k+1,j,i)
+ dissi(num_gp) = diss(k+1,j,i)
+ de_dxi(num_gp) = de_dx(k+1,j,i)
+ de_dyi(num_gp) = de_dy(k+1,j,i)
+ de_dzi(num_gp) = de_dz(k+1,j,i)
+ ENDIF
+
+ IF ( k+1 > nzb_s_inner(j+1,i) .OR. nzb_s_inner(j+1,i) == 0 ) &
+ THEN
+ num_gp = num_gp + 1
+ gp_outside_of_building(4) = 1
+ location(num_gp,1) = i * dx
+ location(num_gp,2) = (j+1) * dy
+ location(num_gp,3) = (k+1) * dz - 0.5 * dz
+ ei(num_gp) = e(k+1,j+1,i)
+ dissi(num_gp) = diss(k+1,j+1,i)
+ de_dxi(num_gp) = de_dx(k+1,j+1,i)
+ de_dyi(num_gp) = de_dy(k+1,j+1,i)
+ de_dzi(num_gp) = de_dz(k+1,j+1,i)
+ ENDIF
+
+ IF ( k > nzb_s_inner(j,i+1) .OR. nzb_s_inner(j,i+1) == 0 ) &
+ THEN
+ num_gp = num_gp + 1
+ gp_outside_of_building(5) = 1
+ location(num_gp,1) = (i+1) * dx
+ location(num_gp,2) = j * dy
+ location(num_gp,3) = k * dz - 0.5 * dz
+ ei(num_gp) = e(k,j,i+1)
+ dissi(num_gp) = diss(k,j,i+1)
+ de_dxi(num_gp) = de_dx(k,j,i+1)
+ de_dyi(num_gp) = de_dy(k,j,i+1)
+ de_dzi(num_gp) = de_dz(k,j,i+1)
+ ENDIF
+
+ IF ( k > nzb_s_inner(j+1,i+1) .OR. nzb_s_inner(j+1,i+1) == 0 ) &
+ THEN
+ num_gp = num_gp + 1
+ gp_outside_of_building(6) = 1
+ location(num_gp,1) = (i+1) * dx
+ location(num_gp,2) = (j+1) * dy
+ location(num_gp,3) = k * dz - 0.5 * dz
+ ei(num_gp) = e(k,j+1,i+1)
+ dissi(num_gp) = diss(k,j+1,i+1)
+ de_dxi(num_gp) = de_dx(k,j+1,i+1)
+ de_dyi(num_gp) = de_dy(k,j+1,i+1)
+ de_dzi(num_gp) = de_dz(k,j+1,i+1)
+ ENDIF
+
+ IF ( k+1 > nzb_s_inner(j,i+1) .OR. nzb_s_inner(j,i+1) == 0 ) &
+ THEN
+ num_gp = num_gp + 1
+ gp_outside_of_building(7) = 1
+ location(num_gp,1) = (i+1) * dx
+ location(num_gp,2) = j * dy
+ location(num_gp,3) = (k+1) * dz - 0.5 * dz
+ ei(num_gp) = e(k+1,j,i+1)
+ dissi(num_gp) = diss(k+1,j,i+1)
+ de_dxi(num_gp) = de_dx(k+1,j,i+1)
+ de_dyi(num_gp) = de_dy(k+1,j,i+1)
+ de_dzi(num_gp) = de_dz(k+1,j,i+1)
+ ENDIF
+
+ IF ( k+1 > nzb_s_inner(j+1,i+1) .OR. nzb_s_inner(j+1,i+1) == 0)&
+ THEN
+ num_gp = num_gp + 1
+ gp_outside_of_building(8) = 1
+ location(num_gp,1) = (i+1) * dx
+ location(num_gp,2) = (j+1) * dy
+ location(num_gp,3) = (k+1) * dz - 0.5 * dz
+ ei(num_gp) = e(k+1,j+1,i+1)
+ dissi(num_gp) = diss(k+1,j+1,i+1)
+ de_dxi(num_gp) = de_dx(k+1,j+1,i+1)
+ de_dyi(num_gp) = de_dy(k+1,j+1,i+1)
+ de_dzi(num_gp) = de_dz(k+1,j+1,i+1)
+ ENDIF
+
+!
+!-- If all gridpoints are situated outside of a building, then the
+!-- ordinary interpolation scheme can be used.
+ IF ( num_gp == 8 ) THEN
+
+ x = particles(n)%x - i * dx
+ y = particles(n)%y - j * dy
+ aa = x**2 + y**2
+ bb = ( dx - x )**2 + y**2
+ cc = x**2 + ( dy - y )**2
+ dd = ( dx - x )**2 + ( dy - y )**2
+ gg = aa + bb + cc + dd
+
+ e_int_l = (( gg-aa ) * e(k,j,i) + ( gg-bb ) * e(k,j,i+1) &
+ + ( gg-cc ) * e(k,j+1,i) + ( gg-dd ) * e(k,j+1,i+1)&
+ ) / ( 3.0 * gg )
+
+ IF ( k+1 == nzt+1 ) THEN
+ e_int = e_int_l
+ ELSE
+ e_int_u = ( ( gg - aa ) * e(k+1,j,i) + &
+ ( gg - bb ) * e(k+1,j,i+1) + &
+ ( gg - cc ) * e(k+1,j+1,i) + &
+ ( gg - dd ) * e(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg )
+ e_int = e_int_l + ( particles(n)%z - zu(k) ) / dz * &
+ ( e_int_u - e_int_l )
+ ENDIF
+
+!
+!-- Interpolate the TKE gradient along x (adopt incides i,j,k
+!-- and all position variables from above (TKE))
+ de_dx_int_l = ( ( gg - aa ) * de_dx(k,j,i) + &
+ ( gg - bb ) * de_dx(k,j,i+1) + &
+ ( gg - cc ) * de_dx(k,j+1,i) + &
+ ( gg - dd ) * de_dx(k,j+1,i+1) &
+ ) / ( 3.0 * gg )
+
+ IF ( ( k+1 == nzt+1 ) .OR. ( k == nzb ) ) THEN
+ de_dx_int = de_dx_int_l
+ ELSE
+ de_dx_int_u = ( ( gg - aa ) * de_dx(k+1,j,i) + &
+ ( gg - bb ) * de_dx(k+1,j,i+1) + &
+ ( gg - cc ) * de_dx(k+1,j+1,i) + &
+ ( gg - dd ) * de_dx(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg )
+ de_dx_int = de_dx_int_l + ( particles(n)%z - zu(k) ) / &
+ dz * ( de_dx_int_u - de_dx_int_l )
+ ENDIF
+
+!
+!-- Interpolate the TKE gradient along y
+ de_dy_int_l = ( ( gg - aa ) * de_dy(k,j,i) + &
+ ( gg - bb ) * de_dy(k,j,i+1) + &
+ ( gg - cc ) * de_dy(k,j+1,i) + &
+ ( gg - dd ) * de_dy(k,j+1,i+1) &
+ ) / ( 3.0 * gg )
+ IF ( ( k+1 == nzt+1 ) .OR. ( k == nzb ) ) THEN
+ de_dy_int = de_dy_int_l
+ ELSE
+ de_dy_int_u = ( ( gg - aa ) * de_dy(k+1,j,i) + &
+ ( gg - bb ) * de_dy(k+1,j,i+1) + &
+ ( gg - cc ) * de_dy(k+1,j+1,i) + &
+ ( gg - dd ) * de_dy(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg )
+ de_dy_int = de_dy_int_l + ( particles(n)%z - zu(k) ) / &
+ dz * ( de_dy_int_u - de_dy_int_l )
+ ENDIF
+
+!
+!-- Interpolate the TKE gradient along z
+ IF ( particles(n)%z < 0.5 * dz ) THEN
+ de_dz_int = 0.0
+ ELSE
+ de_dz_int_l = ( ( gg - aa ) * de_dz(k,j,i) + &
+ ( gg - bb ) * de_dz(k,j,i+1) + &
+ ( gg - cc ) * de_dz(k,j+1,i) + &
+ ( gg - dd ) * de_dz(k,j+1,i+1) &
+ ) / ( 3.0 * gg )
+
+ IF ( ( k+1 == nzt+1 ) .OR. ( k == nzb ) ) THEN
+ de_dz_int = de_dz_int_l
+ ELSE
+ de_dz_int_u = ( ( gg - aa ) * de_dz(k+1,j,i) + &
+ ( gg - bb ) * de_dz(k+1,j,i+1) + &
+ ( gg - cc ) * de_dz(k+1,j+1,i) + &
+ ( gg - dd ) * de_dz(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg )
+ de_dz_int = de_dz_int_l + ( particles(n)%z - zu(k) ) /&
+ dz * ( de_dz_int_u - de_dz_int_l )
+ ENDIF
+ ENDIF
+
+!
+!-- Interpolate the dissipation of TKE
+ diss_int_l = ( ( gg - aa ) * diss(k,j,i) + &
+ ( gg - bb ) * diss(k,j,i+1) + &
+ ( gg - cc ) * diss(k,j+1,i) + &
+ ( gg - dd ) * diss(k,j+1,i+1) &
+ ) / ( 3.0 * gg )
+
+ IF ( k+1 == nzt+1 ) THEN
+ diss_int = diss_int_l
+ ELSE
+ diss_int_u = ( ( gg - aa ) * diss(k+1,j,i) + &
+ ( gg - bb ) * diss(k+1,j,i+1) + &
+ ( gg - cc ) * diss(k+1,j+1,i) + &
+ ( gg - dd ) * diss(k+1,j+1,i+1) &
+ ) / ( 3.0 * gg )
+ diss_int = diss_int_l + ( particles(n)%z - zu(k) ) / dz *&
+ ( diss_int_u - diss_int_l )
+ ENDIF
+
+ ELSE
+
+!
+!-- If wall between gridpoint 1 and gridpoint 5, then
+!-- Neumann boundary condition has to be applied
+ IF ( gp_outside_of_building(1) == 1 .AND. &
+ gp_outside_of_building(5) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = i * dx + 0.5 * dx
+ location(num_gp,2) = j * dy
+ location(num_gp,3) = k * dz - 0.5 * dz
+ ei(num_gp) = e(k,j,i)
+ dissi(num_gp) = diss(k,j,i)
+ de_dxi(num_gp) = 0.0
+ de_dyi(num_gp) = de_dy(k,j,i)
+ de_dzi(num_gp) = de_dz(k,j,i)
+ ENDIF
+
+ IF ( gp_outside_of_building(5) == 1 .AND. &
+ gp_outside_of_building(1) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = i * dx + 0.5 * dx
+ location(num_gp,2) = j * dy
+ location(num_gp,3) = k * dz - 0.5 * dz
+ ei(num_gp) = e(k,j,i+1)
+ dissi(num_gp) = diss(k,j,i+1)
+ de_dxi(num_gp) = 0.0
+ de_dyi(num_gp) = de_dy(k,j,i+1)
+ de_dzi(num_gp) = de_dz(k,j,i+1)
+ ENDIF
+
+!
+!-- If wall between gridpoint 5 and gridpoint 6, then
+!-- then Neumann boundary condition has to be applied
+ IF ( gp_outside_of_building(5) == 1 .AND. &
+ gp_outside_of_building(6) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = (i+1) * dx
+ location(num_gp,2) = j * dy + 0.5 * dy
+ location(num_gp,3) = k * dz - 0.5 * dz
+ ei(num_gp) = e(k,j,i+1)
+ dissi(num_gp) = diss(k,j,i+1)
+ de_dxi(num_gp) = de_dx(k,j,i+1)
+ de_dyi(num_gp) = 0.0
+ de_dzi(num_gp) = de_dz(k,j,i+1)
+ ENDIF
+
+ IF ( gp_outside_of_building(6) == 1 .AND. &
+ gp_outside_of_building(5) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = (i+1) * dx
+ location(num_gp,2) = j * dy + 0.5 * dy
+ location(num_gp,3) = k * dz - 0.5 * dz
+ ei(num_gp) = e(k,j+1,i+1)
+ dissi(num_gp) = diss(k,j+1,i+1)
+ de_dxi(num_gp) = de_dx(k,j+1,i+1)
+ de_dyi(num_gp) = 0.0
+ de_dzi(num_gp) = de_dz(k,j+1,i+1)
+ ENDIF
+
+!
+!-- If wall between gridpoint 2 and gridpoint 6, then
+!-- Neumann boundary condition has to be applied
+ IF ( gp_outside_of_building(2) == 1 .AND. &
+ gp_outside_of_building(6) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = i * dx + 0.5 * dx
+ location(num_gp,2) = (j+1) * dy
+ location(num_gp,3) = k * dz - 0.5 * dz
+ ei(num_gp) = e(k,j+1,i)
+ dissi(num_gp) = diss(k,j+1,i)
+ de_dxi(num_gp) = 0.0
+ de_dyi(num_gp) = de_dy(k,j+1,i)
+ de_dzi(num_gp) = de_dz(k,j+1,i)
+ ENDIF
+
+ IF ( gp_outside_of_building(6) == 1 .AND. &
+ gp_outside_of_building(2) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = i * dx + 0.5 * dx
+ location(num_gp,2) = (j+1) * dy
+ location(num_gp,3) = k * dz - 0.5 * dz
+ ei(num_gp) = e(k,j+1,i+1)
+ dissi(num_gp) = diss(k,j+1,i+1)
+ de_dxi(num_gp) = 0.0
+ de_dyi(num_gp) = de_dy(k,j+1,i+1)
+ de_dzi(num_gp) = de_dz(k,j+1,i+1)
+ ENDIF
+
+!
+!-- If wall between gridpoint 1 and gridpoint 2, then
+!-- Neumann boundary condition has to be applied
+ IF ( gp_outside_of_building(1) == 1 .AND. &
+ gp_outside_of_building(2) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = i * dx
+ location(num_gp,2) = j * dy + 0.5 * dy
+ location(num_gp,3) = k * dz - 0.5 * dz
+ ei(num_gp) = e(k,j,i)
+ dissi(num_gp) = diss(k,j,i)
+ de_dxi(num_gp) = de_dx(k,j,i)
+ de_dyi(num_gp) = 0.0
+ de_dzi(num_gp) = de_dz(k,j,i)
+ ENDIF
+
+ IF ( gp_outside_of_building(2) == 1 .AND. &
+ gp_outside_of_building(1) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = i * dx
+ location(num_gp,2) = j * dy + 0.5 * dy
+ location(num_gp,3) = k * dz - 0.5 * dz
+ ei(num_gp) = e(k,j+1,i)
+ dissi(num_gp) = diss(k,j+1,i)
+ de_dxi(num_gp) = de_dx(k,j+1,i)
+ de_dyi(num_gp) = 0.0
+ de_dzi(num_gp) = de_dz(k,j+1,i)
+ ENDIF
+
+!
+!-- If wall between gridpoint 3 and gridpoint 7, then
+!-- Neumann boundary condition has to be applied
+ IF ( gp_outside_of_building(3) == 1 .AND. &
+ gp_outside_of_building(7) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = i * dx + 0.5 * dx
+ location(num_gp,2) = j * dy
+ location(num_gp,3) = k * dz + 0.5 * dz
+ ei(num_gp) = e(k+1,j,i)
+ dissi(num_gp) = diss(k+1,j,i)
+ de_dxi(num_gp) = 0.0
+ de_dyi(num_gp) = de_dy(k+1,j,i)
+ de_dzi(num_gp) = de_dz(k+1,j,i)
+ ENDIF
+
+ IF ( gp_outside_of_building(7) == 1 .AND. &
+ gp_outside_of_building(3) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = i * dx + 0.5 * dx
+ location(num_gp,2) = j * dy
+ location(num_gp,3) = k * dz + 0.5 * dz
+ ei(num_gp) = e(k+1,j,i+1)
+ dissi(num_gp) = diss(k+1,j,i+1)
+ de_dxi(num_gp) = 0.0
+ de_dyi(num_gp) = de_dy(k+1,j,i+1)
+ de_dzi(num_gp) = de_dz(k+1,j,i+1)
+ ENDIF
+
+!
+!-- If wall between gridpoint 7 and gridpoint 8, then
+!-- Neumann boundary condition has to be applied
+ IF ( gp_outside_of_building(7) == 1 .AND. &
+ gp_outside_of_building(8) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = (i+1) * dx
+ location(num_gp,2) = j * dy + 0.5 * dy
+ location(num_gp,3) = k * dz + 0.5 * dz
+ ei(num_gp) = e(k+1,j,i+1)
+ dissi(num_gp) = diss(k+1,j,i+1)
+ de_dxi(num_gp) = de_dx(k+1,j,i+1)
+ de_dyi(num_gp) = 0.0
+ de_dzi(num_gp) = de_dz(k+1,j,i+1)
+ ENDIF
+
+ IF ( gp_outside_of_building(8) == 1 .AND. &
+ gp_outside_of_building(7) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = (i+1) * dx
+ location(num_gp,2) = j * dy + 0.5 * dy
+ location(num_gp,3) = k * dz + 0.5 * dz
+ ei(num_gp) = e(k+1,j+1,i+1)
+ dissi(num_gp) = diss(k+1,j+1,i+1)
+ de_dxi(num_gp) = de_dx(k+1,j+1,i+1)
+ de_dyi(num_gp) = 0.0
+ de_dzi(num_gp) = de_dz(k+1,j+1,i+1)
+ ENDIF
+
+!
+!-- If wall between gridpoint 4 and gridpoint 8, then
+!-- Neumann boundary condition has to be applied
+ IF ( gp_outside_of_building(4) == 1 .AND. &
+ gp_outside_of_building(8) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = i * dx + 0.5 * dx
+ location(num_gp,2) = (j+1) * dy
+ location(num_gp,3) = k * dz + 0.5 * dz
+ ei(num_gp) = e(k+1,j+1,i)
+ dissi(num_gp) = diss(k+1,j+1,i)
+ de_dxi(num_gp) = 0.0
+ de_dyi(num_gp) = de_dy(k+1,j+1,i)
+ de_dzi(num_gp) = de_dz(k+1,j+1,i)
+ ENDIF
+
+ IF ( gp_outside_of_building(8) == 1 .AND. &
+ gp_outside_of_building(4) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = i * dx + 0.5 * dx
+ location(num_gp,2) = (j+1) * dy
+ location(num_gp,3) = k * dz + 0.5 * dz
+ ei(num_gp) = e(k+1,j+1,i+1)
+ dissi(num_gp) = diss(k+1,j+1,i+1)
+ de_dxi(num_gp) = 0.0
+ de_dyi(num_gp) = de_dy(k+1,j+1,i+1)
+ de_dzi(num_gp) = de_dz(k+1,j+1,i+1)
+ ENDIF
+
+!
+!-- If wall between gridpoint 3 and gridpoint 4, then
+!-- Neumann boundary condition has to be applied
+ IF ( gp_outside_of_building(3) == 1 .AND. &
+ gp_outside_of_building(4) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = i * dx
+ location(num_gp,2) = j * dy + 0.5 * dy
+ location(num_gp,3) = k * dz + 0.5 * dz
+ ei(num_gp) = e(k+1,j,i)
+ dissi(num_gp) = diss(k+1,j,i)
+ de_dxi(num_gp) = de_dx(k+1,j,i)
+ de_dyi(num_gp) = 0.0
+ de_dzi(num_gp) = de_dz(k+1,j,i)
+ ENDIF
+
+ IF ( gp_outside_of_building(4) == 1 .AND. &
+ gp_outside_of_building(3) == 0 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = i * dx
+ location(num_gp,2) = j * dy + 0.5 * dy
+ location(num_gp,3) = k * dz + 0.5 * dz
+ ei(num_gp) = e(k+1,j+1,i)
+ dissi(num_gp) = diss(k+1,j+1,i)
+ de_dxi(num_gp) = de_dx(k+1,j+1,i)
+ de_dyi(num_gp) = 0.0
+ de_dzi(num_gp) = de_dz(k+1,j+1,i)
+ ENDIF
+
+!
+!-- If wall between gridpoint 1 and gridpoint 3, then
+!-- Neumann boundary condition has to be applied
+!-- (only one case as only building beneath is possible)
+ IF ( gp_outside_of_building(1) == 0 .AND. &
+ gp_outside_of_building(3) == 1 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = i * dx
+ location(num_gp,2) = j * dy
+ location(num_gp,3) = k * dz
+ ei(num_gp) = e(k+1,j,i)
+ dissi(num_gp) = diss(k+1,j,i)
+ de_dxi(num_gp) = de_dx(k+1,j,i)
+ de_dyi(num_gp) = de_dy(k+1,j,i)
+ de_dzi(num_gp) = 0.0
+ ENDIF
+
+!
+!-- If wall between gridpoint 5 and gridpoint 7, then
+!-- Neumann boundary condition has to be applied
+!-- (only one case as only building beneath is possible)
+ IF ( gp_outside_of_building(5) == 0 .AND. &
+ gp_outside_of_building(7) == 1 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = (i+1) * dx
+ location(num_gp,2) = j * dy
+ location(num_gp,3) = k * dz
+ ei(num_gp) = e(k+1,j,i+1)
+ dissi(num_gp) = diss(k+1,j,i+1)
+ de_dxi(num_gp) = de_dx(k+1,j,i+1)
+ de_dyi(num_gp) = de_dy(k+1,j,i+1)
+ de_dzi(num_gp) = 0.0
+ ENDIF
+
+!
+!-- If wall between gridpoint 2 and gridpoint 4, then
+!-- Neumann boundary condition has to be applied
+!-- (only one case as only building beneath is possible)
+ IF ( gp_outside_of_building(2) == 0 .AND. &
+ gp_outside_of_building(4) == 1 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = i * dx
+ location(num_gp,2) = (j+1) * dy
+ location(num_gp,3) = k * dz
+ ei(num_gp) = e(k+1,j+1,i)
+ dissi(num_gp) = diss(k+1,j+1,i)
+ de_dxi(num_gp) = de_dx(k+1,j+1,i)
+ de_dyi(num_gp) = de_dy(k+1,j+1,i)
+ de_dzi(num_gp) = 0.0
+ ENDIF
+
+!
+!-- If wall between gridpoint 6 and gridpoint 8, then
+!-- Neumann boundary condition has to be applied
+!-- (only one case as only building beneath is possible)
+ IF ( gp_outside_of_building(6) == 0 .AND. &
+ gp_outside_of_building(8) == 1 ) THEN
+ num_gp = num_gp + 1
+ location(num_gp,1) = (i+1) * dx
+ location(num_gp,2) = (j+1) * dy
+ location(num_gp,3) = k * dz
+ ei(num_gp) = e(k+1,j+1,i+1)
+ dissi(num_gp) = diss(k+1,j+1,i+1)
+ de_dxi(num_gp) = de_dx(k+1,j+1,i+1)
+ de_dyi(num_gp) = de_dy(k+1,j+1,i+1)
+ de_dzi(num_gp) = 0.0
+ ENDIF
+
+!
+!-- Carry out the interpolation
+ IF ( num_gp == 1 ) THEN
+!
+!-- If only one of the gridpoints is situated outside of the
+!-- building, it follows that the values at the particle
+!-- location are the same as the gridpoint values
+ e_int = ei(num_gp)
+ diss_int = dissi(num_gp)
+ de_dx_int = de_dxi(num_gp)
+ de_dy_int = de_dyi(num_gp)
+ de_dz_int = de_dzi(num_gp)
+ ELSE IF ( num_gp > 1 ) THEN
+
+ d_sum = 0.0
+!
+!-- Evaluation of the distances between the gridpoints
+!-- contributing to the interpolated values, and the particle
+!-- location
+ DO agp = 1, num_gp
+ d_gp_pl(agp) = ( particles(n)%x-location(agp,1) )**2 &
+ + ( particles(n)%y-location(agp,2) )**2 &
+ + ( particles(n)%z-location(agp,3) )**2
+ d_sum = d_sum + d_gp_pl(agp)
+ ENDDO
+
+!
+!-- Finally the interpolation can be carried out
+ e_int = 0.0
+ diss_int = 0.0
+ de_dx_int = 0.0
+ de_dy_int = 0.0
+ de_dz_int = 0.0
+ DO agp = 1, num_gp
+ e_int = e_int + ( d_sum - d_gp_pl(agp) ) * &
+ ei(agp) / ( (num_gp-1) * d_sum )
+ diss_int = diss_int + ( d_sum - d_gp_pl(agp) ) * &
+ dissi(agp) / ( (num_gp-1) * d_sum )
+ de_dx_int = de_dx_int + ( d_sum - d_gp_pl(agp) ) * &
+ de_dxi(agp) / ( (num_gp-1) * d_sum )
+ de_dy_int = de_dy_int + ( d_sum - d_gp_pl(agp) ) * &
+ de_dyi(agp) / ( (num_gp-1) * d_sum )
+ de_dz_int = de_dz_int + ( d_sum - d_gp_pl(agp) ) * &
+ de_dzi(agp) / ( (num_gp-1) * d_sum )
+ ENDDO
+
+ ENDIF
+
+ ENDIF
+
+ ENDIF
+
+!
+!-- Vertically interpolate the horizontally averaged SGS TKE and
+!-- resolved-scale velocity variances and use the interpolated values
+!-- to calculate the coefficient fs, which is a measure of the ratio
+!-- of the subgrid-scale turbulent kinetic energy to the total amount
+!-- of turbulent kinetic energy.
+ IF ( k == 0 ) THEN
+ e_mean_int = hom(0,1,8,0)
+ ELSE
+ e_mean_int = hom(k,1,8,0) + &
+ ( hom(k+1,1,8,0) - hom(k,1,8,0) ) / &
+ ( zu(k+1) - zu(k) ) * &
+ ( particles(n)%z - zu(k) )
+ ENDIF
+
+ kw = particles(n)%z / dz
+
+ IF ( k == 0 ) THEN
+ aa = hom(k+1,1,30,0) * ( particles(n)%z / &
+ ( 0.5 * ( zu(k+1) - zu(k) ) ) )
+ bb = hom(k+1,1,31,0) * ( particles(n)%z / &
+ ( 0.5 * ( zu(k+1) - zu(k) ) ) )
+ cc = hom(kw+1,1,32,0) * ( particles(n)%z / &
+ ( 1.0 * ( zw(kw+1) - zw(kw) ) ) )
+ ELSE
+ aa = hom(k,1,30,0) + ( hom(k+1,1,30,0) - hom(k,1,30,0) ) * &
+ ( ( particles(n)%z - zu(k) ) / ( zu(k+1) - zu(k) ) )
+ bb = hom(k,1,31,0) + ( hom(k+1,1,31,0) - hom(k,1,31,0) ) * &
+ ( ( particles(n)%z - zu(k) ) / ( zu(k+1) - zu(k) ) )
+ cc = hom(kw,1,32,0) + ( hom(kw+1,1,32,0)-hom(kw,1,32,0) ) *&
+ ( ( particles(n)%z - zw(kw) ) / ( zw(kw+1)-zw(kw) ) )
+ ENDIF
+
+ vv_int = ( 1.0 / 3.0 ) * ( aa + bb + cc )
+
+ fs_int = ( 2.0 / 3.0 ) * e_mean_int / &
+ ( vv_int + ( 2.0 / 3.0 ) * e_mean_int )
+
+!
+!-- Calculate the Lagrangian timescale according to the suggestion of
+!-- Weil et al. (2004).
+ lagr_timescale = ( 4.0 * e_int ) / &
+ ( 3.0 * fs_int * c_0 * diss_int )
+
+!
+!-- Calculate the next particle timestep. dt_gap is the time needed to
+!-- complete the current LES timestep.
+ dt_gap = dt_3d - particles(n)%dt_sum
+ dt_particle = MIN( dt_3d, 0.025 * lagr_timescale, dt_gap )
+
+!
+!-- The particle timestep should not be too small in order to prevent
+!-- the number of particle timesteps of getting too large
+ IF ( dt_particle < dt_min_part .AND. dt_min_part < dt_gap ) &
+ THEN
+ dt_particle = dt_min_part
+ ENDIF
+
+!
+!-- Calculate the SGS velocity components
+ IF ( particles(n)%age == 0.0 ) THEN
+!
+!-- For new particles the SGS components are derived from the SGS
+!-- TKE. Limit the Gaussian random number to the interval
+!-- [-5.0*sigma, 5.0*sigma] in order to prevent the SGS velocities
+!-- from becoming unrealistically large.
+ particles(n)%speed_x_sgs = SQRT( 2.0 * sgs_wfu_part * e_int ) *&
+ ( random_gauss( iran_part, 5.0 ) &
+ - 1.0 )
+ particles(n)%speed_y_sgs = SQRT( 2.0 * sgs_wfv_part * e_int ) *&
+ ( random_gauss( iran_part, 5.0 ) &
+ - 1.0 )
+ particles(n)%speed_z_sgs = SQRT( 2.0 * sgs_wfw_part * e_int ) *&
+ ( random_gauss( iran_part, 5.0 ) &
+ - 1.0 )
+
+ ELSE
+
+!
+!-- Restriction of the size of the new timestep: compared to the
+!-- previous timestep the increase must not exceed 200%
+
+ dt_particle_m = particles(n)%age - particles(n)%age_m
+ IF ( dt_particle > 2.0 * dt_particle_m ) THEN
+ dt_particle = 2.0 * dt_particle_m
+ ENDIF
+
+!
+!-- For old particles the SGS components are correlated with the
+!-- values from the previous timestep. Random numbers have also to
+!-- be limited (see above).
+!-- As negative values for the subgrid TKE are not allowed, the
+!-- change of the subgrid TKE with time cannot be smaller than
+!-- -e_int/dt_particle. This value is used as a lower boundary
+!-- value for the change of TKE
+
+ de_dt_min = - e_int / dt_particle
+
+ de_dt = ( e_int - particles(n)%e_m ) / dt_particle_m
+
+ IF ( de_dt < de_dt_min ) THEN
+ de_dt = de_dt_min
+ ENDIF
+
+ particles(n)%speed_x_sgs = particles(n)%speed_x_sgs - &
+ fs_int * c_0 * diss_int * particles(n)%speed_x_sgs * &
+ dt_particle / ( 4.0 * sgs_wfu_part * e_int ) + &
+ ( 2.0 * sgs_wfu_part * de_dt * &
+ particles(n)%speed_x_sgs / &
+ ( 2.0 * sgs_wfu_part * e_int ) + de_dx_int &
+ ) * dt_particle / 2.0 + &
+ SQRT( fs_int * c_0 * diss_int ) * &
+ ( random_gauss( iran_part, 5.0 ) - 1.0 ) * &
+ SQRT( dt_particle )
+
+ particles(n)%speed_y_sgs = particles(n)%speed_y_sgs - &
+ fs_int * c_0 * diss_int * particles(n)%speed_y_sgs * &
+ dt_particle / ( 4.0 * sgs_wfv_part * e_int ) + &
+ ( 2.0 * sgs_wfv_part * de_dt * &
+ particles(n)%speed_y_sgs / &
+ ( 2.0 * sgs_wfv_part * e_int ) + de_dy_int &
+ ) * dt_particle / 2.0 + &
+ SQRT( fs_int * c_0 * diss_int ) * &
+ ( random_gauss( iran_part, 5.0 ) - 1.0 ) * &
+ SQRT( dt_particle )
+
+ particles(n)%speed_z_sgs = particles(n)%speed_z_sgs - &
+ fs_int * c_0 * diss_int * particles(n)%speed_z_sgs * &
+ dt_particle / ( 4.0 * sgs_wfw_part * e_int ) + &
+ ( 2.0 * sgs_wfw_part * de_dt * &
+ particles(n)%speed_z_sgs / &
+ ( 2.0 * sgs_wfw_part * e_int ) + de_dz_int &
+ ) * dt_particle / 2.0 + &
+ SQRT( fs_int * c_0 * diss_int ) * &
+ ( random_gauss( iran_part, 5.0 ) - 1.0 ) * &
+ SQRT( dt_particle )
+
+ ENDIF
+
+ u_int = u_int + particles(n)%speed_x_sgs
+ v_int = v_int + particles(n)%speed_y_sgs
+ w_int = w_int + particles(n)%speed_z_sgs
+
+!
+!-- Store the SGS TKE of the current timelevel which is needed for
+!-- for calculating the SGS particle velocities at the next timestep
+ particles(n)%e_m = e_int
+
+ ELSE
+!
+!-- If no SGS velocities are used, only the particle timestep has to
+!-- be set
+ dt_particle = dt_3d
+
+ ENDIF
+
+!
+!-- Remember the old age of the particle ( needed to prevent that a
+!-- particle crosses several PEs during one timestep and for the
+!-- evaluation of the subgrid particle velocity fluctuations )
+ particles(n)%age_m = particles(n)%age
+
+
+!
+!-- Particle advection
+ IF ( particle_groups(particles(n)%group)%density_ratio == 0.0 ) THEN
+!
+!-- Pure passive transport (without particle inertia)
+ particles(n)%x = particles(n)%x + u_int * dt_particle
+ particles(n)%y = particles(n)%y + v_int * dt_particle
+ particles(n)%z = particles(n)%z + w_int * dt_particle
+
+ particles(n)%speed_x = u_int
+ particles(n)%speed_y = v_int
+ particles(n)%speed_z = w_int
+
+ ELSE
+!
+!-- Transport of particles with inertia
+ particles(n)%x = particles(n)%x + particles(n)%speed_x * &
+ dt_particle
+ particles(n)%y = particles(n)%y + particles(n)%speed_y * &
+ dt_particle
+ particles(n)%z = particles(n)%z + particles(n)%speed_z * &
+ dt_particle
+
+!
+!-- Update of the particle velocity
+ dens_ratio = particle_groups(particles(n)%group)%density_ratio
+ IF ( cloud_droplets ) THEN
+ exp_arg = 4.5 * dens_ratio * molecular_viscosity / &
+ ( particles(n)%radius )**2 / &
+ ( 1.0 + 0.15 * ( 2.0 * particles(n)%radius * &
+ SQRT( ( u_int - particles(n)%speed_x )**2 + &
+ ( v_int - particles(n)%speed_y )**2 + &
+ ( w_int - particles(n)%speed_z )**2 ) / &
+ molecular_viscosity )**0.687 &
+ )
+ exp_term = EXP( -exp_arg * dt_particle )
+ ELSEIF ( use_sgs_for_particles ) THEN
+ exp_arg = particle_groups(particles(n)%group)%exp_arg
+ exp_term = EXP( -exp_arg * dt_particle )
+ ELSE
+ exp_arg = particle_groups(particles(n)%group)%exp_arg
+ exp_term = particle_groups(particles(n)%group)%exp_term
+ ENDIF
+ particles(n)%speed_x = particles(n)%speed_x * exp_term + &
+ u_int * ( 1.0 - exp_term )
+ particles(n)%speed_y = particles(n)%speed_y * exp_term + &
+ v_int * ( 1.0 - exp_term )
+ particles(n)%speed_z = particles(n)%speed_z * exp_term + &
+ ( w_int - ( 1.0 - dens_ratio ) * g / exp_arg ) &
+ * ( 1.0 - exp_term )
+ ENDIF
+
+!
+!-- Increment the particle age and the total time that the particle
+!-- has advanced within the particle timestep procedure
+ particles(n)%age = particles(n)%age + dt_particle
+ particles(n)%dt_sum = particles(n)%dt_sum + dt_particle
+
+!
+!-- Check whether there is still a particle that has not yet completed
+!-- the total LES timestep
+ IF ( ( dt_3d - particles(n)%dt_sum ) > 1E-8 ) THEN
+ dt_3d_reached_l = .FALSE.
+ ENDIF
+
+ ENDDO ! advection loop
+
+!
+!-- Particle reflection from walls
+ CALL particle_boundary_conds
+
+!
+!-- User-defined actions after the evaluation of the new particle position
+ CALL user_advec_particles
+
+!
+!-- Find out, if all particles on every PE have completed the LES timestep
+!-- and set the switch corespondingly
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( dt_3d_reached_l, dt_3d_reached, 1, MPI_LOGICAL, &
+ MPI_LAND, comm2d, ierr )
+#else
+ dt_3d_reached = dt_3d_reached_l
+#endif
+
+ CALL cpu_log( log_point_s(44), 'advec_part_advec', 'stop' )
+
+!
+!-- Increment time since last release
+ IF ( dt_3d_reached ) time_prel = time_prel + dt_3d
+
+! WRITE ( 9, * ) '*** advec_particles: ##0.4'
+! CALL local_flush( 9 )
+! nd = 0
+! DO n = 1, number_of_particles
+! IF ( .NOT. particle_mask(n) ) nd = nd + 1
+! ENDDO
+! IF ( nd /= deleted_particles ) THEN
+! WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+
+!
+!-- If necessary, release new set of particles
+ IF ( time_prel >= dt_prel .AND. end_time_prel > simulated_time .AND. &
+ dt_3d_reached ) THEN
+
+!
+!-- Check, if particle storage must be extended
+ IF ( number_of_particles + number_of_initial_particles > &
+ maximum_number_of_particles ) THEN
+ IF ( netcdf_output ) THEN
+ PRINT*, '+++ advec_particles: maximum_number_of_particles ', &
+ 'needs to be increased'
+ PRINT*, ' but this is not allowed with ', &
+ 'NetCDF output switched on'
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ CALL local_stop
+#endif
+ ELSE
+! WRITE ( 9, * ) '*** advec_particles: before allocate_prt_memory dt_prel'
+! CALL local_flush( 9 )
+ CALL allocate_prt_memory( number_of_initial_particles )
+! WRITE ( 9, * ) '*** advec_particles: after allocate_prt_memory dt_prel'
+! CALL local_flush( 9 )
+ ENDIF
+ ENDIF
+
+!
+!-- Check, if tail storage must be extended
+ IF ( use_particle_tails ) THEN
+ IF ( number_of_tails + number_of_initial_tails > &
+ maximum_number_of_tails ) THEN
+ IF ( netcdf_output ) THEN
+ PRINT*, '+++ advec_particles: maximum_number_of_tails ', &
+ 'needs to be increased'
+ PRINT*, ' but this is not allowed wi', &
+ 'th NetCDF output switched on'
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ CALL local_stop
+#endif
+ ELSE
+! WRITE ( 9, * ) '*** advec_particles: before allocate_tail_memory dt_prel'
+! CALL local_flush( 9 )
+ CALL allocate_tail_memory( number_of_initial_tails )
+! WRITE ( 9, * ) '*** advec_particles: after allocate_tail_memory dt_prel'
+! CALL local_flush( 9 )
+ ENDIF
+ ENDIF
+ ENDIF
+
+!
+!-- The MOD function allows for changes in the output interval with
+!-- restart runs.
+ time_prel = MOD( time_prel, MAX( dt_prel, dt_3d ) )
+ IF ( number_of_initial_particles /= 0 ) THEN
+ is = number_of_particles+1
+ ie = number_of_particles+number_of_initial_particles
+ particles(is:ie) = initial_particles(1:number_of_initial_particles)
+!
+!-- Add random fluctuation to particle positions. Particles should
+!-- remain in the subdomain.
+ IF ( random_start_position ) THEN
+ DO n = is, ie
+ IF ( psl(particles(n)%group) /= psr(particles(n)%group) ) &
+ THEN
+ particles(n)%x = particles(n)%x + &
+ ( random_function( iran_part ) - 0.5 ) *&
+ pdx(particles(n)%group)
+ IF ( particles(n)%x <= ( nxl - 0.5 ) * dx ) THEN
+ particles(n)%x = ( nxl - 0.4999999999 ) * dx
+ ELSEIF ( particles(n)%x >= ( nxr + 0.5 ) * dx ) THEN
+ particles(n)%x = ( nxr + 0.4999999999 ) * dx
+ ENDIF
+ ENDIF
+ IF ( pss(particles(n)%group) /= psn(particles(n)%group) ) &
+ THEN
+ particles(n)%y = particles(n)%y + &
+ ( random_function( iran_part ) - 0.5 ) *&
+ pdy(particles(n)%group)
+ IF ( particles(n)%y <= ( nys - 0.5 ) * dy ) THEN
+ particles(n)%y = ( nys - 0.4999999999 ) * dy
+ ELSEIF ( particles(n)%y >= ( nyn + 0.5 ) * dy ) THEN
+ particles(n)%y = ( nyn + 0.4999999999 ) * dy
+ ENDIF
+ ENDIF
+ IF ( psb(particles(n)%group) /= pst(particles(n)%group) ) &
+ THEN
+ particles(n)%z = particles(n)%z + &
+ ( random_function( iran_part ) - 0.5 ) *&
+ pdz(particles(n)%group)
+ ENDIF
+ ENDDO
+ ENDIF
+
+!
+!-- Set the beginning of the new particle tails and their age
+ IF ( use_particle_tails ) THEN
+ DO n = is, ie
+!
+!-- New particles which should have a tail, already have got a
+!-- provisional tail id unequal zero (see init_particles)
+ IF ( particles(n)%tail_id /= 0 ) THEN
+ number_of_tails = number_of_tails + 1
+ nn = number_of_tails
+ particles(n)%tail_id = nn ! set the final tail id
+ particle_tail_coordinates(1,1,nn) = particles(n)%x
+ particle_tail_coordinates(1,2,nn) = particles(n)%y
+ particle_tail_coordinates(1,3,nn) = particles(n)%z
+ particle_tail_coordinates(1,4,nn) = particles(n)%color
+ particles(n)%tailpoints = 1
+ IF ( minimum_tailpoint_distance /= 0.0 ) THEN
+ particle_tail_coordinates(2,1,nn) = particles(n)%x
+ particle_tail_coordinates(2,2,nn) = particles(n)%y
+ particle_tail_coordinates(2,3,nn) = particles(n)%z
+ particle_tail_coordinates(2,4,nn) = particles(n)%color
+ particle_tail_coordinates(1:2,5,nn) = 0.0
+ particles(n)%tailpoints = 2
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+! WRITE ( 9, * ) '*** advec_particles: after setting the beginning of new tails'
+! CALL local_flush( 9 )
+
+ number_of_particles = number_of_particles + &
+ number_of_initial_particles
+ ENDIF
+
+ ENDIF
+
+! WRITE ( 9, * ) '*** advec_particles: ##0.5'
+! CALL local_flush( 9 )
+! nd = 0
+! DO n = 1, number_of_particles
+! IF ( .NOT. particle_mask(n) ) nd = nd + 1
+! ENDDO
+! IF ( nd /= deleted_particles ) THEN
+! WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+
+! IF ( number_of_particles /= number_of_tails ) THEN
+! WRITE (9,*) '--- advec_particles: #2'
+! WRITE (9,*) ' #of p=',number_of_particles,' #of t=',number_of_tails
+! CALL local_flush( 9 )
+! ENDIF
+! DO n = 1, number_of_particles
+! IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+! THEN
+! WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+! WRITE (9,*) ' id=',particles(n)%tail_id,' of (',number_of_tails,')'
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+! ENDDO
+
+#if defined( __parallel )
+!
+!-- As soon as one particle has moved beyond the boundary of the domain, it
+!-- is included in the relevant transfer arrays and marked for subsequent
+!-- deletion on this PE.
+!-- First run for crossings in x direction. Find out first the number of
+!-- particles to be transferred and allocate temporary arrays needed to store
+!-- them.
+!-- For a one-dimensional decomposition along y, no transfer is necessary,
+!-- because the particle remains on the PE.
+ trlp_count = 0
+ trlpt_count = 0
+ trrp_count = 0
+ trrpt_count = 0
+ IF ( pdims(1) /= 1 ) THEN
+!
+!-- First calculate the storage necessary for sending and receiving the
+!-- data
+ DO n = 1, number_of_particles
+ i = ( particles(n)%x + 0.5 * dx ) * ddx
+!
+!-- Above calculation does not work for indices less than zero
+ IF ( particles(n)%x < -0.5 * dx ) i = -1
+
+ IF ( i < nxl ) THEN
+ trlp_count = trlp_count + 1
+ IF ( particles(n)%tail_id /= 0 ) trlpt_count = trlpt_count + 1
+ ELSEIF ( i > nxr ) THEN
+ trrp_count = trrp_count + 1
+ IF ( particles(n)%tail_id /= 0 ) trrpt_count = trrpt_count + 1
+ ENDIF
+ ENDDO
+ IF ( trlp_count == 0 ) trlp_count = 1
+ IF ( trlpt_count == 0 ) trlpt_count = 1
+ IF ( trrp_count == 0 ) trrp_count = 1
+ IF ( trrpt_count == 0 ) trrpt_count = 1
+
+ ALLOCATE( trlp(trlp_count), trrp(trrp_count) )
+
+ trlp = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+ 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+ 0.0, 0, 0, 0, 0 )
+ trrp = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+ 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+ 0.0, 0, 0, 0, 0 )
+
+ IF ( use_particle_tails ) THEN
+ ALLOCATE( trlpt(maximum_number_of_tailpoints,5,trlpt_count), &
+ trrpt(maximum_number_of_tailpoints,5,trrpt_count) )
+ tlength = maximum_number_of_tailpoints * 5
+ ENDIF
+
+ trlp_count = 0
+ trlpt_count = 0
+ trrp_count = 0
+ trrpt_count = 0
+
+ ENDIF
+
+! WRITE ( 9, * ) '*** advec_particles: ##1'
+! CALL local_flush( 9 )
+! nd = 0
+! DO n = 1, number_of_particles
+! IF ( .NOT. particle_mask(n) ) nd = nd + 1
+! IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+! THEN
+! WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+! WRITE (9,*) ' id=',particles(n)%tail_id,' of (',number_of_tails,')'
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+! ENDDO
+! IF ( nd /= deleted_particles ) THEN
+! WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+
+ DO n = 1, number_of_particles
+
+ nn = particles(n)%tail_id
+
+ i = ( particles(n)%x + 0.5 * dx ) * ddx
+!
+!-- Above calculation does not work for indices less than zero
+ IF ( particles(n)%x < - 0.5 * dx ) i = -1
+
+ IF ( i < nxl ) THEN
+ IF ( i < 0 ) THEN
+!
+!-- Apply boundary condition along x
+ IF ( ibc_par_lr == 0 ) THEN
+!
+!-- Cyclic condition
+ IF ( pdims(1) == 1 ) THEN
+ particles(n)%x = ( nx + 1 ) * dx + particles(n)%x
+ particles(n)%origin_x = ( nx + 1 ) * dx + &
+ particles(n)%origin_x
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ i = particles(n)%tailpoints
+ particle_tail_coordinates(1:i,1,nn) = ( nx + 1 ) * dx &
+ + particle_tail_coordinates(1:i,1,nn)
+ ENDIF
+ ELSE
+ trlp_count = trlp_count + 1
+ trlp(trlp_count) = particles(n)
+ trlp(trlp_count)%x = ( nx + 1 ) * dx + trlp(trlp_count)%x
+ trlp(trlp_count)%origin_x = trlp(trlp_count)%origin_x + &
+ ( nx + 1 ) * dx
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ trlpt_count = trlpt_count + 1
+ trlpt(:,:,trlpt_count) = &
+ particle_tail_coordinates(:,:,nn)
+ trlpt(:,1,trlpt_count) = ( nx + 1 ) * dx + &
+ trlpt(:,1,trlpt_count)
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+ ENDIF
+
+ ELSEIF ( ibc_par_lr == 1 ) THEN
+!
+!-- Particle absorption
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+
+ ELSEIF ( ibc_par_lr == 2 ) THEN
+!
+!-- Particle reflection
+ particles(n)%x = -particles(n)%x
+ particles(n)%speed_x = -particles(n)%speed_x
+
+ ENDIF
+ ELSE
+!
+!-- Store particle data in the transfer array, which will be send
+!-- to the neighbouring PE
+ trlp_count = trlp_count + 1
+ trlp(trlp_count) = particles(n)
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ trlpt_count = trlpt_count + 1
+ trlpt(:,:,trlpt_count) = particle_tail_coordinates(:,:,nn)
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+ ENDIF
+
+ ELSEIF ( i > nxr ) THEN
+ IF ( i > nx ) THEN
+!
+!-- Apply boundary condition along x
+ IF ( ibc_par_lr == 0 ) THEN
+!
+!-- Cyclic condition
+ IF ( pdims(1) == 1 ) THEN
+ particles(n)%x = particles(n)%x - ( nx + 1 ) * dx
+ particles(n)%origin_x = particles(n)%origin_x - &
+ ( nx + 1 ) * dx
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ i = particles(n)%tailpoints
+ particle_tail_coordinates(1:i,1,nn) = - ( nx+1 ) * dx &
+ + particle_tail_coordinates(1:i,1,nn)
+ ENDIF
+ ELSE
+ trrp_count = trrp_count + 1
+ trrp(trrp_count) = particles(n)
+ trrp(trrp_count)%x = trrp(trrp_count)%x - ( nx + 1 ) * dx
+ trrp(trrp_count)%origin_x = trrp(trrp_count)%origin_x - &
+ ( nx + 1 ) * dx
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ trrpt_count = trrpt_count + 1
+ trrpt(:,:,trrpt_count) = &
+ particle_tail_coordinates(:,:,nn)
+ trrpt(:,1,trrpt_count) = trrpt(:,1,trrpt_count) - &
+ ( nx + 1 ) * dx
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+ ENDIF
+
+ ELSEIF ( ibc_par_lr == 1 ) THEN
+!
+!-- Particle absorption
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+
+ ELSEIF ( ibc_par_lr == 2 ) THEN
+!
+!-- Particle reflection
+ particles(n)%x = 2 * ( nx * dx ) - particles(n)%x
+ particles(n)%speed_x = -particles(n)%speed_x
+
+ ENDIF
+ ELSE
+!
+!-- Store particle data in the transfer array, which will be send
+!-- to the neighbouring PE
+ trrp_count = trrp_count + 1
+ trrp(trrp_count) = particles(n)
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ trrpt_count = trrpt_count + 1
+ trrpt(:,:,trrpt_count) = particle_tail_coordinates(:,:,nn)
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+ ENDIF
+
+ ENDIF
+ ENDDO
+
+! WRITE ( 9, * ) '*** advec_particles: ##2'
+! CALL local_flush( 9 )
+! nd = 0
+! DO n = 1, number_of_particles
+! IF ( .NOT. particle_mask(n) ) nd = nd + 1
+! IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+! THEN
+! WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+! WRITE (9,*) ' id=',particles(n)%tail_id,' of (',number_of_tails,')'
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+! ENDDO
+! IF ( nd /= deleted_particles ) THEN
+! WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+
+!
+!-- Send left boundary, receive right boundary (but first exchange how many
+!-- and check, if particle storage must be extended)
+ IF ( pdims(1) /= 1 ) THEN
+
+ CALL cpu_log( log_point_s(23), 'sendrcv_particles', 'start' )
+ CALL MPI_SENDRECV( trlp_count, 1, MPI_INTEGER, pleft, 0, &
+ trrp_count_recv, 1, MPI_INTEGER, pright, 0, &
+ comm2d, status, ierr )
+
+ IF ( number_of_particles + trrp_count_recv > &
+ maximum_number_of_particles ) &
+ THEN
+ IF ( netcdf_output ) THEN
+ PRINT*, '+++ advec_particles: maximum_number_of_particles ', &
+ 'needs to be increased'
+ PRINT*, ' but this is not allowed with ', &
+ 'NetCDF output switched on'
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+ ELSE
+! WRITE ( 9, * ) '*** advec_particles: before allocate_prt_memory trrp'
+! CALL local_flush( 9 )
+ CALL allocate_prt_memory( trrp_count_recv )
+! WRITE ( 9, * ) '*** advec_particles: after allocate_prt_memory trrp'
+! CALL local_flush( 9 )
+ ENDIF
+ ENDIF
+
+ CALL MPI_SENDRECV( trlp(1)%age, trlp_count, mpi_particle_type, &
+ pleft, 1, particles(number_of_particles+1)%age, &
+ trrp_count_recv, mpi_particle_type, pright, 1, &
+ comm2d, status, ierr )
+
+ IF ( use_particle_tails ) THEN
+
+ CALL MPI_SENDRECV( trlpt_count, 1, MPI_INTEGER, pleft, 0, &
+ trrpt_count_recv, 1, MPI_INTEGER, pright, 0, &
+ comm2d, status, ierr )
+
+ IF ( number_of_tails+trrpt_count_recv > maximum_number_of_tails ) &
+ THEN
+ IF ( netcdf_output ) THEN
+ PRINT*, '+++ advec_particles: maximum_number_of_tails ', &
+ 'needs to be increased'
+ PRINT*, ' but this is not allowed wi', &
+ 'th NetCDF output switched on'
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+ ELSE
+! WRITE ( 9, * ) '*** advec_particles: before allocate_tail_memory trrpt'
+! CALL local_flush( 9 )
+ CALL allocate_tail_memory( trrpt_count_recv )
+! WRITE ( 9, * ) '*** advec_particles: after allocate_tail_memory trrpt'
+! CALL local_flush( 9 )
+ ENDIF
+ ENDIF
+
+ CALL MPI_SENDRECV( trlpt(1,1,1), trlpt_count*tlength, MPI_REAL, &
+ pleft, 1, &
+ particle_tail_coordinates(1,1,number_of_tails+1), &
+ trrpt_count_recv*tlength, MPI_REAL, pright, 1, &
+ comm2d, status, ierr )
+!
+!-- Update the tail ids for the transferred particles
+ nn = number_of_tails
+ DO n = number_of_particles+1, number_of_particles+trrp_count_recv
+ IF ( particles(n)%tail_id /= 0 ) THEN
+ nn = nn + 1
+ particles(n)%tail_id = nn
+ ENDIF
+ ENDDO
+
+ ENDIF
+
+ number_of_particles = number_of_particles + trrp_count_recv
+ number_of_tails = number_of_tails + trrpt_count_recv
+! IF ( number_of_particles /= number_of_tails ) THEN
+! WRITE (9,*) '--- advec_particles: #3'
+! WRITE (9,*) ' #of p=',number_of_particles,' #of t=',number_of_tails
+! CALL local_flush( 9 )
+! ENDIF
+
+!
+!-- Send right boundary, receive left boundary
+ CALL MPI_SENDRECV( trrp_count, 1, MPI_INTEGER, pright, 0, &
+ trlp_count_recv, 1, MPI_INTEGER, pleft, 0, &
+ comm2d, status, ierr )
+
+ IF ( number_of_particles + trlp_count_recv > &
+ maximum_number_of_particles ) &
+ THEN
+ IF ( netcdf_output ) THEN
+ PRINT*, '+++ advec_particles: maximum_number_of_particles ', &
+ 'needs to be increased'
+ PRINT*, ' but this is not allowed with ', &
+ 'NetCDF output switched on'
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+ ELSE
+! WRITE ( 9, * ) '*** advec_particles: before allocate_prt_memory trlp'
+! CALL local_flush( 9 )
+ CALL allocate_prt_memory( trlp_count_recv )
+! WRITE ( 9, * ) '*** advec_particles: after allocate_prt_memory trlp'
+! CALL local_flush( 9 )
+ ENDIF
+ ENDIF
+
+ CALL MPI_SENDRECV( trrp(1)%age, trrp_count, mpi_particle_type, &
+ pright, 1, particles(number_of_particles+1)%age, &
+ trlp_count_recv, mpi_particle_type, pleft, 1, &
+ comm2d, status, ierr )
+
+ IF ( use_particle_tails ) THEN
+
+ CALL MPI_SENDRECV( trrpt_count, 1, MPI_INTEGER, pright, 0, &
+ trlpt_count_recv, 1, MPI_INTEGER, pleft, 0, &
+ comm2d, status, ierr )
+
+ IF ( number_of_tails+trlpt_count_recv > maximum_number_of_tails ) &
+ THEN
+ IF ( netcdf_output ) THEN
+ PRINT*, '+++ advec_particles: maximum_number_of_tails ', &
+ 'needs to be increased'
+ PRINT*, ' but this is not allowed wi', &
+ 'th NetCDF output switched on'
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+ ELSE
+! WRITE ( 9, * ) '*** advec_particles: before allocate_tail_memory trlpt'
+! CALL local_flush( 9 )
+ CALL allocate_tail_memory( trlpt_count_recv )
+! WRITE ( 9, * ) '*** advec_particles: after allocate_tail_memory trlpt'
+! CALL local_flush( 9 )
+ ENDIF
+ ENDIF
+
+ CALL MPI_SENDRECV( trrpt(1,1,1), trrpt_count*tlength, MPI_REAL, &
+ pright, 1, &
+ particle_tail_coordinates(1,1,number_of_tails+1), &
+ trlpt_count_recv*tlength, MPI_REAL, pleft, 1, &
+ comm2d, status, ierr )
+!
+!-- Update the tail ids for the transferred particles
+ nn = number_of_tails
+ DO n = number_of_particles+1, number_of_particles+trlp_count_recv
+ IF ( particles(n)%tail_id /= 0 ) THEN
+ nn = nn + 1
+ particles(n)%tail_id = nn
+ ENDIF
+ ENDDO
+
+ ENDIF
+
+ number_of_particles = number_of_particles + trlp_count_recv
+ number_of_tails = number_of_tails + trlpt_count_recv
+! IF ( number_of_particles /= number_of_tails ) THEN
+! WRITE (9,*) '--- advec_particles: #4'
+! WRITE (9,*) ' #of p=',number_of_particles,' #of t=',number_of_tails
+! CALL local_flush( 9 )
+! ENDIF
+
+ IF ( use_particle_tails ) THEN
+ DEALLOCATE( trlpt, trrpt )
+ ENDIF
+ DEALLOCATE( trlp, trrp )
+
+ CALL cpu_log( log_point_s(23), 'sendrcv_particles', 'pause' )
+
+ ENDIF
+
+! WRITE ( 9, * ) '*** advec_particles: ##3'
+! CALL local_flush( 9 )
+! nd = 0
+! DO n = 1, number_of_particles
+! IF ( .NOT. particle_mask(n) ) nd = nd + 1
+! IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+! THEN
+! WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+! WRITE (9,*) ' id=',particles(n)%tail_id,' of (',number_of_tails,')'
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+! ENDDO
+! IF ( nd /= deleted_particles ) THEN
+! WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+
+!
+!-- Check whether particles have crossed the boundaries in y direction. Note
+!-- that this case can also apply to particles that have just been received
+!-- from the adjacent right or left PE.
+!-- Find out first the number of particles to be transferred and allocate
+!-- temporary arrays needed to store them.
+!-- For a one-dimensional decomposition along x, no transfer is necessary,
+!-- because the particle remains on the PE.
+ trsp_count = 0
+ trspt_count = 0
+ trnp_count = 0
+ trnpt_count = 0
+ IF ( pdims(2) /= 1 ) THEN
+!
+!-- First calculate the storage necessary for sending and receiving the
+!-- data
+ DO n = 1, number_of_particles
+ IF ( particle_mask(n) ) THEN
+ j = ( particles(n)%y + 0.5 * dy ) * ddy
+!
+!-- Above calculation does not work for indices less than zero
+ IF ( particles(n)%y < -0.5 * dy ) j = -1
+
+ IF ( j < nys ) THEN
+ trsp_count = trsp_count + 1
+ IF ( particles(n)%tail_id /= 0 ) trspt_count = trspt_count+1
+ ELSEIF ( j > nyn ) THEN
+ trnp_count = trnp_count + 1
+ IF ( particles(n)%tail_id /= 0 ) trnpt_count = trnpt_count+1
+ ENDIF
+ ENDIF
+ ENDDO
+ IF ( trsp_count == 0 ) trsp_count = 1
+ IF ( trspt_count == 0 ) trspt_count = 1
+ IF ( trnp_count == 0 ) trnp_count = 1
+ IF ( trnpt_count == 0 ) trnpt_count = 1
+
+ ALLOCATE( trsp(trsp_count), trnp(trnp_count) )
+
+ trsp = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+ 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+ 0.0, 0, 0, 0, 0 )
+ trnp = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+ 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+ 0.0, 0, 0, 0, 0 )
+
+ IF ( use_particle_tails ) THEN
+ ALLOCATE( trspt(maximum_number_of_tailpoints,5,trspt_count), &
+ trnpt(maximum_number_of_tailpoints,5,trnpt_count) )
+ tlength = maximum_number_of_tailpoints * 5
+ ENDIF
+
+ trsp_count = 0
+ trspt_count = 0
+ trnp_count = 0
+ trnpt_count = 0
+
+ ENDIF
+
+! WRITE ( 9, * ) '*** advec_particles: ##4'
+! CALL local_flush( 9 )
+! nd = 0
+! DO n = 1, number_of_particles
+! IF ( .NOT. particle_mask(n) ) nd = nd + 1
+! IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+! THEN
+! WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+! WRITE (9,*) ' id=',particles(n)%tail_id,' of (',number_of_tails,')'
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+! ENDDO
+! IF ( nd /= deleted_particles ) THEN
+! WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+
+ DO n = 1, number_of_particles
+
+ nn = particles(n)%tail_id
+!
+!-- Only those particles that have not been marked as 'deleted' may be
+!-- moved.
+ IF ( particle_mask(n) ) THEN
+ j = ( particles(n)%y + 0.5 * dy ) * ddy
+!
+!-- Above calculation does not work for indices less than zero
+ IF ( particles(n)%y < -0.5 * dy ) j = -1
+
+ IF ( j < nys ) THEN
+ IF ( j < 0 ) THEN
+!
+!-- Apply boundary condition along y
+ IF ( ibc_par_ns == 0 ) THEN
+!
+!-- Cyclic condition
+ IF ( pdims(2) == 1 ) THEN
+ particles(n)%y = ( ny + 1 ) * dy + particles(n)%y
+ particles(n)%origin_y = ( ny + 1 ) * dy + &
+ particles(n)%origin_y
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ i = particles(n)%tailpoints
+ particle_tail_coordinates(1:i,2,nn) = ( ny+1 ) * dy&
+ + particle_tail_coordinates(1:i,2,nn)
+ ENDIF
+ ELSE
+ trsp_count = trsp_count + 1
+ trsp(trsp_count) = particles(n)
+ trsp(trsp_count)%y = ( ny + 1 ) * dy + &
+ trsp(trsp_count)%y
+ trsp(trsp_count)%origin_y = trsp(trsp_count)%origin_y &
+ + ( ny + 1 ) * dy
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ trspt_count = trspt_count + 1
+ trspt(:,:,trspt_count) = &
+ particle_tail_coordinates(:,:,nn)
+ trspt(:,2,trspt_count) = ( ny + 1 ) * dy + &
+ trspt(:,2,trspt_count)
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+ ENDIF
+
+ ELSEIF ( ibc_par_ns == 1 ) THEN
+!
+!-- Particle absorption
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+
+ ELSEIF ( ibc_par_ns == 2 ) THEN
+!
+!-- Particle reflection
+ particles(n)%y = -particles(n)%y
+ particles(n)%speed_y = -particles(n)%speed_y
+
+ ENDIF
+ ELSE
+!
+!-- Store particle data in the transfer array, which will be send
+!-- to the neighbouring PE
+ trsp_count = trsp_count + 1
+ trsp(trsp_count) = particles(n)
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ trspt_count = trspt_count + 1
+ trspt(:,:,trspt_count) = particle_tail_coordinates(:,:,nn)
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+ ENDIF
+
+ ELSEIF ( j > nyn ) THEN
+ IF ( j > ny ) THEN
+!
+!-- Apply boundary condition along x
+ IF ( ibc_par_ns == 0 ) THEN
+!
+!-- Cyclic condition
+ IF ( pdims(2) == 1 ) THEN
+ particles(n)%y = particles(n)%y - ( ny + 1 ) * dy
+ particles(n)%origin_y = particles(n)%origin_y - &
+ ( ny + 1 ) * dy
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ i = particles(n)%tailpoints
+ particle_tail_coordinates(1:i,2,nn) = - (ny+1) * dy&
+ + particle_tail_coordinates(1:i,2,nn)
+ ENDIF
+ ELSE
+ trnp_count = trnp_count + 1
+ trnp(trnp_count) = particles(n)
+ trnp(trnp_count)%y = trnp(trnp_count)%y - &
+ ( ny + 1 ) * dy
+ trnp(trnp_count)%origin_y = trnp(trnp_count)%origin_y &
+ - ( ny + 1 ) * dy
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ trnpt_count = trnpt_count + 1
+ trnpt(:,:,trnpt_count) = &
+ particle_tail_coordinates(:,:,nn)
+ trnpt(:,2,trnpt_count) = trnpt(:,2,trnpt_count) - &
+ ( ny + 1 ) * dy
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+ ENDIF
+
+ ELSEIF ( ibc_par_ns == 1 ) THEN
+!
+!-- Particle absorption
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+
+ ELSEIF ( ibc_par_ns == 2 ) THEN
+!
+!-- Particle reflection
+ particles(n)%y = 2 * ( ny * dy ) - particles(n)%y
+ particles(n)%speed_y = -particles(n)%speed_y
+
+ ENDIF
+ ELSE
+!
+!-- Store particle data in the transfer array, which will be send
+!-- to the neighbouring PE
+ trnp_count = trnp_count + 1
+ trnp(trnp_count) = particles(n)
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ trnpt_count = trnpt_count + 1
+ trnpt(:,:,trnpt_count) = particle_tail_coordinates(:,:,nn)
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+ ENDIF
+
+ ENDIF
+ ENDIF
+ ENDDO
+
+! WRITE ( 9, * ) '*** advec_particles: ##5'
+! CALL local_flush( 9 )
+! nd = 0
+! DO n = 1, number_of_particles
+! IF ( .NOT. particle_mask(n) ) nd = nd + 1
+! IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+! THEN
+! WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+! WRITE (9,*) ' id=',particles(n)%tail_id,' of (',number_of_tails,')'
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+! ENDDO
+! IF ( nd /= deleted_particles ) THEN
+! WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+
+!
+!-- Send front boundary, receive back boundary (but first exchange how many
+!-- and check, if particle storage must be extended)
+ IF ( pdims(2) /= 1 ) THEN
+
+ CALL cpu_log( log_point_s(23), 'sendrcv_particles', 'continue' )
+ CALL MPI_SENDRECV( trsp_count, 1, MPI_INTEGER, psouth, 0, &
+ trnp_count_recv, 1, MPI_INTEGER, pnorth, 0, &
+ comm2d, status, ierr )
+
+ IF ( number_of_particles + trnp_count_recv > &
+ maximum_number_of_particles ) &
+ THEN
+ IF ( netcdf_output ) THEN
+ PRINT*, '+++ advec_particles: maximum_number_of_particles ', &
+ 'needs to be increased'
+ PRINT*, ' but this is not allowed with ', &
+ 'NetCDF output switched on'
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+ ELSE
+! WRITE ( 9, * ) '*** advec_particles: before allocate_prt_memory trnp'
+! CALL local_flush( 9 )
+ CALL allocate_prt_memory( trnp_count_recv )
+! WRITE ( 9, * ) '*** advec_particles: after allocate_prt_memory trnp'
+! CALL local_flush( 9 )
+ ENDIF
+ ENDIF
+
+ CALL MPI_SENDRECV( trsp(1)%age, trsp_count, mpi_particle_type, &
+ psouth, 1, particles(number_of_particles+1)%age, &
+ trnp_count_recv, mpi_particle_type, pnorth, 1, &
+ comm2d, status, ierr )
+
+ IF ( use_particle_tails ) THEN
+
+ CALL MPI_SENDRECV( trspt_count, 1, MPI_INTEGER, psouth, 0, &
+ trnpt_count_recv, 1, MPI_INTEGER, pnorth, 0, &
+ comm2d, status, ierr )
+
+ IF ( number_of_tails+trnpt_count_recv > maximum_number_of_tails ) &
+ THEN
+ IF ( netcdf_output ) THEN
+ PRINT*, '+++ advec_particles: maximum_number_of_tails ', &
+ 'needs to be increased'
+ PRINT*, ' but this is not allowed wi', &
+ 'th NetCDF output switched on'
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+ ELSE
+! WRITE ( 9, * ) '*** advec_particles: before allocate_tail_memory trnpt'
+! CALL local_flush( 9 )
+ CALL allocate_tail_memory( trnpt_count_recv )
+! WRITE ( 9, * ) '*** advec_particles: after allocate_tail_memory trnpt'
+! CALL local_flush( 9 )
+ ENDIF
+ ENDIF
+
+ CALL MPI_SENDRECV( trspt(1,1,1), trspt_count*tlength, MPI_REAL, &
+ psouth, 1, &
+ particle_tail_coordinates(1,1,number_of_tails+1), &
+ trnpt_count_recv*tlength, MPI_REAL, pnorth, 1, &
+ comm2d, status, ierr )
+!
+!-- Update the tail ids for the transferred particles
+ nn = number_of_tails
+ DO n = number_of_particles+1, number_of_particles+trnp_count_recv
+ IF ( particles(n)%tail_id /= 0 ) THEN
+ nn = nn + 1
+ particles(n)%tail_id = nn
+ ENDIF
+ ENDDO
+
+ ENDIF
+
+ number_of_particles = number_of_particles + trnp_count_recv
+ number_of_tails = number_of_tails + trnpt_count_recv
+! IF ( number_of_particles /= number_of_tails ) THEN
+! WRITE (9,*) '--- advec_particles: #5'
+! WRITE (9,*) ' #of p=',number_of_particles,' #of t=',number_of_tails
+! CALL local_flush( 9 )
+! ENDIF
+
+!
+!-- Send back boundary, receive front boundary
+ CALL MPI_SENDRECV( trnp_count, 1, MPI_INTEGER, pnorth, 0, &
+ trsp_count_recv, 1, MPI_INTEGER, psouth, 0, &
+ comm2d, status, ierr )
+
+ IF ( number_of_particles + trsp_count_recv > &
+ maximum_number_of_particles ) &
+ THEN
+ IF ( netcdf_output ) THEN
+ PRINT*, '+++ advec_particles: maximum_number_of_particles ', &
+ 'needs to be increased'
+ PRINT*, ' but this is not allowed with ', &
+ 'NetCDF output switched on'
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+ ELSE
+! WRITE ( 9, * ) '*** advec_particles: before allocate_prt_memory trsp'
+! CALL local_flush( 9 )
+ CALL allocate_prt_memory( trsp_count_recv )
+! WRITE ( 9, * ) '*** advec_particles: after allocate_prt_memory trsp'
+! CALL local_flush( 9 )
+ ENDIF
+ ENDIF
+
+ CALL MPI_SENDRECV( trnp(1)%age, trnp_count, mpi_particle_type, &
+ pnorth, 1, particles(number_of_particles+1)%age, &
+ trsp_count_recv, mpi_particle_type, psouth, 1, &
+ comm2d, status, ierr )
+
+ IF ( use_particle_tails ) THEN
+
+ CALL MPI_SENDRECV( trnpt_count, 1, MPI_INTEGER, pnorth, 0, &
+ trspt_count_recv, 1, MPI_INTEGER, psouth, 0, &
+ comm2d, status, ierr )
+
+ IF ( number_of_tails+trspt_count_recv > maximum_number_of_tails ) &
+ THEN
+ IF ( netcdf_output ) THEN
+ PRINT*, '+++ advec_particles: maximum_number_of_tails ', &
+ 'needs to be increased'
+ PRINT*, ' but this is not allowed wi', &
+ 'th NetCDF output switched on'
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+ ELSE
+! WRITE ( 9, * ) '*** advec_particles: before allocate_tail_memory trspt'
+! CALL local_flush( 9 )
+ CALL allocate_tail_memory( trspt_count_recv )
+! WRITE ( 9, * ) '*** advec_particles: after allocate_tail_memory trspt'
+! CALL local_flush( 9 )
+ ENDIF
+ ENDIF
+
+ CALL MPI_SENDRECV( trnpt(1,1,1), trnpt_count*tlength, MPI_REAL, &
+ pnorth, 1, &
+ particle_tail_coordinates(1,1,number_of_tails+1), &
+ trspt_count_recv*tlength, MPI_REAL, psouth, 1, &
+ comm2d, status, ierr )
+!
+!-- Update the tail ids for the transferred particles
+ nn = number_of_tails
+ DO n = number_of_particles+1, number_of_particles+trsp_count_recv
+ IF ( particles(n)%tail_id /= 0 ) THEN
+ nn = nn + 1
+ particles(n)%tail_id = nn
+ ENDIF
+ ENDDO
+
+ ENDIF
+
+ number_of_particles = number_of_particles + trsp_count_recv
+ number_of_tails = number_of_tails + trspt_count_recv
+! IF ( number_of_particles /= number_of_tails ) THEN
+! WRITE (9,*) '--- advec_particles: #6'
+! WRITE (9,*) ' #of p=',number_of_particles,' #of t=',number_of_tails
+! CALL local_flush( 9 )
+! ENDIF
+
+ IF ( use_particle_tails ) THEN
+ DEALLOCATE( trspt, trnpt )
+ ENDIF
+ DEALLOCATE( trsp, trnp )
+
+ CALL cpu_log( log_point_s(23), 'sendrcv_particles', 'stop' )
+
+ ENDIF
+
+! WRITE ( 9, * ) '*** advec_particles: ##6'
+! CALL local_flush( 9 )
+! nd = 0
+! DO n = 1, number_of_particles
+! IF ( .NOT. particle_mask(n) ) nd = nd + 1
+! IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+! THEN
+! WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+! WRITE (9,*) ' id=',particles(n)%tail_id,' of (',number_of_tails,')'
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+! ENDDO
+! IF ( nd /= deleted_particles ) THEN
+! WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+
+#else
+
+!
+!-- Apply boundary conditions
+ DO n = 1, number_of_particles
+
+ nn = particles(n)%tail_id
+
+ IF ( particles(n)%x < -0.5 * dx ) THEN
+
+ IF ( ibc_par_lr == 0 ) THEN
+!
+!-- Cyclic boundary. Relevant coordinate has to be changed.
+ particles(n)%x = ( nx + 1 ) * dx + particles(n)%x
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ i = particles(n)%tailpoints
+ particle_tail_coordinates(1:i,1,nn) = ( nx + 1 ) * dx + &
+ particle_tail_coordinates(1:i,1,nn)
+ ENDIF
+ ELSEIF ( ibc_par_lr == 1 ) THEN
+!
+!-- Particle absorption
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+ ELSEIF ( ibc_par_lr == 2 ) THEN
+!
+!-- Particle reflection
+ particles(n)%x = -dx - particles(n)%x
+ particles(n)%speed_x = -particles(n)%speed_x
+ ENDIF
+
+ ELSEIF ( particles(n)%x >= ( nx + 0.5 ) * dx ) THEN
+
+ IF ( ibc_par_lr == 0 ) THEN
+!
+!-- Cyclic boundary. Relevant coordinate has to be changed.
+ particles(n)%x = particles(n)%x - ( nx + 1 ) * dx
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ i = particles(n)%tailpoints
+ particle_tail_coordinates(1:i,1,nn) = - ( nx + 1 ) * dx + &
+ particle_tail_coordinates(1:i,1,nn)
+ ENDIF
+ ELSEIF ( ibc_par_lr == 1 ) THEN
+!
+!-- Particle absorption
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+ ELSEIF ( ibc_par_lr == 2 ) THEN
+!
+!-- Particle reflection
+ particles(n)%x = ( nx + 1 ) * dx - particles(n)%x
+ particles(n)%speed_x = -particles(n)%speed_x
+ ENDIF
+
+ ENDIF
+
+ IF ( particles(n)%y < -0.5 * dy ) THEN
+
+ IF ( ibc_par_ns == 0 ) THEN
+!
+!-- Cyclic boundary. Relevant coordinate has to be changed.
+ particles(n)%y = ( ny + 1 ) * dy + particles(n)%y
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ i = particles(n)%tailpoints
+ particle_tail_coordinates(1:i,2,nn) = ( ny + 1 ) * dy + &
+ particle_tail_coordinates(1:i,2,nn)
+ ENDIF
+ ELSEIF ( ibc_par_ns == 1 ) THEN
+!
+!-- Particle absorption
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+ ELSEIF ( ibc_par_ns == 2 ) THEN
+!
+!-- Particle reflection
+ particles(n)%y = -dy - particles(n)%y
+ particles(n)%speed_y = -particles(n)%speed_y
+ ENDIF
+
+ ELSEIF ( particles(n)%y >= ( ny + 0.5 ) * dy ) THEN
+
+ IF ( ibc_par_ns == 0 ) THEN
+!
+!-- Cyclic boundary. Relevant coordinate has to be changed.
+ particles(n)%y = particles(n)%y - ( ny + 1 ) * dy
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ i = particles(n)%tailpoints
+ particle_tail_coordinates(1:i,2,nn) = - ( ny + 1 ) * dy + &
+ particle_tail_coordinates(1:i,2,nn)
+ ENDIF
+ ELSEIF ( ibc_par_ns == 1 ) THEN
+!
+!-- Particle absorption
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+ ELSEIF ( ibc_par_ns == 2 ) THEN
+!
+!-- Particle reflection
+ particles(n)%y = ( ny + 1 ) * dy - particles(n)%y
+ particles(n)%speed_y = -particles(n)%speed_y
+ ENDIF
+
+ ENDIF
+ ENDDO
+
+#endif
+
+!
+!-- Apply boundary conditions to those particles that have crossed the top or
+!-- bottom boundary and delete those particles, which are older than allowed
+ DO n = 1, number_of_particles
+
+ nn = particles(n)%tail_id
+
+!
+!-- Stop if particles have moved further than the length of one
+!-- PE subdomain
+ IF ( ABS(particles(n)%speed_x) > &
+ ((nxr-nxl+2)*dx)/(particles(n)%age-particles(n)%age_m) .OR. &
+ ABS(particles(n)%speed_y) > &
+ ((nyn-nys+2)*dy)/(particles(n)%age-particles(n)%age_m) ) THEN
+
+ PRINT*, '+++ advec_particles: particle too fast. n = ', n
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ CALL local_stop
+#endif
+ ENDIF
+
+ IF ( particles(n)%age > particle_maximum_age .AND. &
+ particle_mask(n) ) &
+ THEN
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+ ENDIF
+
+ IF ( particles(n)%z >= zu(nz) .AND. particle_mask(n) ) THEN
+ IF ( ibc_par_t == 1 ) THEN
+!
+!-- Particle absorption
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+ ELSEIF ( ibc_par_t == 2 ) THEN
+!
+!-- Particle reflection
+ particles(n)%z = 2.0 * zu(nz) - particles(n)%z
+ particles(n)%speed_z = -particles(n)%speed_z
+ IF ( use_sgs_for_particles .AND. &
+ particles(n)%speed_z_sgs > 0.0 ) THEN
+ particles(n)%speed_z_sgs = -particles(n)%speed_z_sgs
+ ENDIF
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ particle_tail_coordinates(1,3,nn) = 2.0 * zu(nz) - &
+ particle_tail_coordinates(1,3,nn)
+ ENDIF
+ ENDIF
+ ENDIF
+ IF ( particles(n)%z < 0.0 .AND. particle_mask(n) ) THEN
+ IF ( ibc_par_b == 1 ) THEN
+!
+!-- Particle absorption
+ particle_mask(n) = .FALSE.
+ deleted_particles = deleted_particles + 1
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ tail_mask(nn) = .FALSE.
+ deleted_tails = deleted_tails + 1
+ ENDIF
+ ELSEIF ( ibc_par_b == 2 ) THEN
+!
+!-- Particle reflection
+ particles(n)%z = -particles(n)%z
+ particles(n)%speed_z = -particles(n)%speed_z
+ IF ( use_sgs_for_particles .AND. &
+ particles(n)%speed_z_sgs < 0.0 ) THEN
+ particles(n)%speed_z_sgs = -particles(n)%speed_z_sgs
+ ENDIF
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ particle_tail_coordinates(1,3,nn) = 2.0 * zu(nz) - &
+ particle_tail_coordinates(1,3,nn)
+ ENDIF
+ IF ( use_particle_tails .AND. nn /= 0 ) THEN
+ particle_tail_coordinates(1,3,nn) = &
+ -particle_tail_coordinates(1,3,nn)
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDDO
+
+! WRITE ( 9, * ) '*** advec_particles: ##7'
+! CALL local_flush( 9 )
+! nd = 0
+! DO n = 1, number_of_particles
+! IF ( .NOT. particle_mask(n) ) nd = nd + 1
+! IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+! THEN
+! WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+! WRITE (9,*) ' id=',particles(n)%tail_id,' of (',number_of_tails,')'
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+! ENDDO
+! IF ( nd /= deleted_particles ) THEN
+! WRITE (9,*) '*** nd=',nd,' deleted_particles=',deleted_particles
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+
+!
+!-- Pack particles (eliminate those marked for deletion),
+!-- determine new number of particles
+ IF ( number_of_particles > 0 .AND. deleted_particles > 0 ) THEN
+ nn = 0
+ nd = 0
+ DO n = 1, number_of_particles
+ IF ( particle_mask(n) ) THEN
+ nn = nn + 1
+ particles(nn) = particles(n)
+ ELSE
+ nd = nd + 1
+ ENDIF
+ ENDDO
+! IF ( nd /= deleted_particles ) THEN
+! WRITE (9,*) '*** advec_part nd=',nd,' deleted_particles=',deleted_particles
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+
+ number_of_particles = number_of_particles - deleted_particles
+!
+!-- Pack the tails, store the new tail ids and re-assign it to the
+!-- respective
+!-- particles
+ IF ( use_particle_tails ) THEN
+ nn = 0
+ nd = 0
+ DO n = 1, number_of_tails
+ IF ( tail_mask(n) ) THEN
+ nn = nn + 1
+ particle_tail_coordinates(:,:,nn) = &
+ particle_tail_coordinates(:,:,n)
+ new_tail_id(n) = nn
+ ELSE
+ nd = nd + 1
+! WRITE (9,*) '+++ n=',n,' (of ',number_of_tails,' #oftails)'
+! WRITE (9,*) ' id=',new_tail_id(n)
+! CALL local_flush( 9 )
+ ENDIF
+ ENDDO
+ ENDIF
+
+! IF ( nd /= deleted_tails .AND. use_particle_tails ) THEN
+! WRITE (9,*) '*** advec_part nd=',nd,' deleted_tails=',deleted_tails
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+
+ number_of_tails = number_of_tails - deleted_tails
+
+! nn = 0
+ DO n = 1, number_of_particles
+ IF ( particles(n)%tail_id /= 0 ) THEN
+! nn = nn + 1
+! IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id > number_of_tails ) THEN
+! WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+! WRITE (9,*) ' tail_id=',particles(n)%tail_id
+! WRITE (9,*) ' new_tail_id=', new_tail_id(particles(n)%tail_id), &
+! ' of (',number_of_tails,')'
+! CALL local_flush( 9 )
+! ENDIF
+ particles(n)%tail_id = new_tail_id(particles(n)%tail_id)
+ ENDIF
+ ENDDO
+
+! IF ( nn /= number_of_tails .AND. use_particle_tails ) THEN
+! WRITE (9,*) '*** advec_part #of_tails=',number_of_tails,' nn=',nn
+! CALL local_flush( 9 )
+! DO n = 1, number_of_particles
+! WRITE (9,*) 'prt# ',n,' tail_id=',particles(n)%tail_id, &
+! ' x=',particles(n)%x, ' y=',particles(n)%y, &
+! ' z=',particles(n)%z
+! ENDDO
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+
+ ENDIF
+
+! IF ( number_of_particles /= number_of_tails ) THEN
+! WRITE (9,*) '--- advec_particles: #7'
+! WRITE (9,*) ' #of p=',number_of_particles,' #of t=',number_of_tails
+! CALL local_flush( 9 )
+! ENDIF
+! WRITE ( 9, * ) '*** advec_particles: ##8'
+! CALL local_flush( 9 )
+! DO n = 1, number_of_particles
+! IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+! THEN
+! WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+! WRITE (9,*) ' id=',particles(n)%tail_id,' of (',number_of_tails,')'
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+! ENDDO
+
+! WRITE ( 9, * ) '*** advec_particles: ##9'
+! CALL local_flush( 9 )
+! DO n = 1, number_of_particles
+! IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+! THEN
+! WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+! WRITE (9,*) ' id=',particles(n)%tail_id,' of (',number_of_tails,')'
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+! ENDDO
+
+!
+!-- Accumulate the number of particles transferred between the subdomains
+#if defined( __parallel )
+ trlp_count_sum = trlp_count_sum + trlp_count
+ trlp_count_recv_sum = trlp_count_recv_sum + trlp_count_recv
+ trrp_count_sum = trrp_count_sum + trrp_count
+ trrp_count_recv_sum = trrp_count_recv_sum + trrp_count_recv
+ trsp_count_sum = trsp_count_sum + trsp_count
+ trsp_count_recv_sum = trsp_count_recv_sum + trsp_count_recv
+ trnp_count_sum = trnp_count_sum + trnp_count
+ trnp_count_recv_sum = trnp_count_recv_sum + trnp_count_recv
+#endif
+
+ IF ( dt_3d_reached ) EXIT
+
+ ENDDO ! timestep loop
+
+
+!
+!-- Sort particles in the sequence the gridboxes are stored in the memory
+ time_sort_particles = time_sort_particles + dt_3d
+ IF ( time_sort_particles >= dt_sort_particles ) THEN
+ CALL sort_particles
+ time_sort_particles = MOD( time_sort_particles, &
+ MAX( dt_sort_particles, dt_3d ) )
+ ENDIF
+
+
+!
+!-- Re-evaluate the weighting factors. After advection, particles within a
+!-- grid box may have different weighting factors if some have been advected
+!-- from a neighbouring box. The factors are re-evaluated so that they are
+!-- the same for all particles of one box. This procedure must conserve the
+!-- liquid water content within one box.
+ IF ( cloud_droplets ) THEN
+
+ CALL cpu_log( log_point_s(45), 'advec_part_reeval_we', 'start' )
+
+ ql = 0.0; ql_v = 0.0; ql_vp = 0.0
+
+!
+!-- Re-calculate the weighting factors and calculate the liquid water content
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb, nzt+1
+
+!
+!-- Calculate the total volume of particles in the boxes (ql_vp) as
+!-- well as the real volume (ql_v, weighting factor has to be
+!-- included)
+ psi = prt_start_index(k,j,i)
+ DO n = psi, psi+prt_count(k,j,i)-1
+ ql_vp(k,j,i) = ql_vp(k,j,i) + particles(n)%radius**3
+
+ ql_v(k,j,i) = ql_v(k,j,i) + particles(n)%weight_factor * &
+ particles(n)%radius**3
+ ENDDO
+
+!
+!-- Re-calculate the weighting factors and calculate the liquid
+!-- water content
+ IF ( ql_vp(k,j,i) /= 0.0 ) THEN
+ ql_vp(k,j,i) = ql_v(k,j,i) / ql_vp(k,j,i)
+ ql(k,j,i) = ql(k,j,i) + rho_l * 1.33333333 * pi * &
+ ql_v(k,j,i) / &
+ ( rho_surface * dx * dy * dz )
+ ELSE
+ ql(k,j,i) = 0.0
+ ENDIF
+
+!
+!-- Re-assign the weighting factor to the particles
+ DO n = psi, psi+prt_count(k,j,i)-1
+ particles(n)%weight_factor = ql_vp(k,j,i)
+ ENDDO
+
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CALL cpu_log( log_point_s(45), 'advec_part_reeval_we', 'stop' )
+
+ ENDIF
+
+!
+!-- Set particle attributes defined by the user
+ CALL user_particle_attributes
+! WRITE ( 9, * ) '*** advec_particles: ##10'
+! CALL local_flush( 9 )
+! DO n = 1, number_of_particles
+! IF ( particles(n)%tail_id<0 .OR. particles(n)%tail_id>number_of_tails ) &
+! THEN
+! WRITE (9,*) '+++ n=',n,' (of ',number_of_particles,')'
+! WRITE (9,*) ' id=',particles(n)%tail_id,' of (',number_of_tails,')'
+! CALL local_flush( 9 )
+! CALL MPI_ABORT( comm2d, 9999, ierr )
+! ENDIF
+! ENDDO
+
+!
+!-- If necessary, add the actual particle positions to the particle tails
+ IF ( use_particle_tails ) THEN
+
+ distance = 0.0
+ DO n = 1, number_of_particles
+
+ nn = particles(n)%tail_id
+
+ IF ( nn /= 0 ) THEN
+!
+!-- Calculate the distance between the actual particle position and the
+!-- next tailpoint
+! WRITE ( 9, * ) '*** advec_particles: ##10.1 nn=',nn
+! CALL local_flush( 9 )
+ IF ( minimum_tailpoint_distance /= 0.0 ) THEN
+ distance = ( particle_tail_coordinates(1,1,nn) - &
+ particle_tail_coordinates(2,1,nn) )**2 + &
+ ( particle_tail_coordinates(1,2,nn) - &
+ particle_tail_coordinates(2,2,nn) )**2 + &
+ ( particle_tail_coordinates(1,3,nn) - &
+ particle_tail_coordinates(2,3,nn) )**2
+ ENDIF
+! WRITE ( 9, * ) '*** advec_particles: ##10.2'
+! CALL local_flush( 9 )
+!
+!-- First, increase the index of all existings tailpoints by one
+ IF ( distance >= minimum_tailpoint_distance ) THEN
+ DO i = particles(n)%tailpoints, 1, -1
+ particle_tail_coordinates(i+1,:,nn) = &
+ particle_tail_coordinates(i,:,nn)
+ ENDDO
+!
+!-- Increase the counter which contains the number of tailpoints.
+!-- This must always be smaller than the given maximum number of
+!-- tailpoints because otherwise the index bounds of
+!-- particle_tail_coordinates would be exceeded
+ IF ( particles(n)%tailpoints < maximum_number_of_tailpoints-1 )&
+ THEN
+ particles(n)%tailpoints = particles(n)%tailpoints + 1
+ ENDIF
+ ENDIF
+! WRITE ( 9, * ) '*** advec_particles: ##10.3'
+! CALL local_flush( 9 )
+!
+!-- In any case, store the new point at the beginning of the tail
+ particle_tail_coordinates(1,1,nn) = particles(n)%x
+ particle_tail_coordinates(1,2,nn) = particles(n)%y
+ particle_tail_coordinates(1,3,nn) = particles(n)%z
+ particle_tail_coordinates(1,4,nn) = particles(n)%color
+! WRITE ( 9, * ) '*** advec_particles: ##10.4'
+! CALL local_flush( 9 )
+!
+!-- Increase the age of the tailpoints
+ IF ( minimum_tailpoint_distance /= 0.0 ) THEN
+ particle_tail_coordinates(2:particles(n)%tailpoints,5,nn) = &
+ particle_tail_coordinates(2:particles(n)%tailpoints,5,nn) + &
+ dt_3d
+!
+!-- Delete the last tailpoint, if it has exceeded its maximum age
+ IF ( particle_tail_coordinates(particles(n)%tailpoints,5,nn) > &
+ maximum_tailpoint_age ) THEN
+ particles(n)%tailpoints = particles(n)%tailpoints - 1
+ ENDIF
+ ENDIF
+! WRITE ( 9, * ) '*** advec_particles: ##10.5'
+! CALL local_flush( 9 )
+
+ ENDIF
+
+ ENDDO
+
+ ENDIF
+! WRITE ( 9, * ) '*** advec_particles: ##11'
+! CALL local_flush( 9 )
+
+!
+!-- Write particle statistics on file
+ IF ( write_particle_statistics ) THEN
+ CALL check_open( 80 )
+#if defined( __parallel )
+ WRITE ( 80, 8000 ) current_timestep_number+1, simulated_time+dt_3d, &
+ number_of_particles, pleft, trlp_count_sum, &
+ trlp_count_recv_sum, pright, trrp_count_sum, &
+ trrp_count_recv_sum, psouth, trsp_count_sum, &
+ trsp_count_recv_sum, pnorth, trnp_count_sum, &
+ trnp_count_recv_sum, maximum_number_of_particles
+ CALL close_file( 80 )
+#else
+ WRITE ( 80, 8000 ) current_timestep_number+1, simulated_time+dt_3d, &
+ number_of_particles, maximum_number_of_particles
+#endif
+ ENDIF
+
+ CALL cpu_log( log_point(25), 'advec_particles', 'stop' )
+
+!
+!-- Formats
+8000 FORMAT (I6,1X,F7.2,4X,I6,5X,4(I3,1X,I4,'/',I4,2X),6X,I6)
+
+ END SUBROUTINE advec_particles
+
+
+ SUBROUTINE allocate_prt_memory( number_of_new_particles )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Extend particle memory
+!------------------------------------------------------------------------------!
+
+ USE particle_attributes
+
+ IMPLICIT NONE
+
+ INTEGER :: new_maximum_number, number_of_new_particles
+
+ LOGICAL, DIMENSION(:), ALLOCATABLE :: tmp_particle_mask
+
+ TYPE(particle_type), DIMENSION(:), ALLOCATABLE :: tmp_particles
+
+
+ new_maximum_number = maximum_number_of_particles + &
+ MAX( 5*number_of_new_particles, number_of_initial_particles )
+
+ IF ( write_particle_statistics ) THEN
+ CALL check_open( 80 )
+ WRITE ( 80, '(''*** Request: '', I7, '' new_maximum_number(prt)'')' ) &
+ new_maximum_number
+ CALL close_file( 80 )
+ ENDIF
+
+ ALLOCATE( tmp_particles(maximum_number_of_particles), &
+ tmp_particle_mask(maximum_number_of_particles) )
+ tmp_particles = particles
+ tmp_particle_mask = particle_mask
+
+ DEALLOCATE( particles, particle_mask )
+ ALLOCATE( particles(new_maximum_number), &
+ particle_mask(new_maximum_number) )
+ maximum_number_of_particles = new_maximum_number
+
+ particles(1:number_of_particles) = tmp_particles(1:number_of_particles)
+ particle_mask(1:number_of_particles) = &
+ tmp_particle_mask(1:number_of_particles)
+ particle_mask(number_of_particles+1:maximum_number_of_particles) = .TRUE.
+ DEALLOCATE( tmp_particles, tmp_particle_mask )
+
+ END SUBROUTINE allocate_prt_memory
+
+
+ SUBROUTINE allocate_tail_memory( number_of_new_tails )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Extend tail memory
+!------------------------------------------------------------------------------!
+
+ USE particle_attributes
+
+ IMPLICIT NONE
+
+ INTEGER :: new_maximum_number, number_of_new_tails
+
+ LOGICAL, DIMENSION(maximum_number_of_tails) :: tmp_tail_mask
+
+ REAL, DIMENSION(maximum_number_of_tailpoints,5,maximum_number_of_tails) :: &
+ tmp_tail
+
+
+ new_maximum_number = maximum_number_of_tails + &
+ MAX( 5*number_of_new_tails, number_of_initial_tails )
+
+ IF ( write_particle_statistics ) THEN
+ CALL check_open( 80 )
+ WRITE ( 80, '(''*** Request: '', I5, '' new_maximum_number(tails)'')' ) &
+ new_maximum_number
+ CALL close_file( 80 )
+ ENDIF
+ WRITE (9,*) '*** Request: ',new_maximum_number,' new_maximum_number(tails)'
+! CALL local_flush( 9 )
+
+ tmp_tail(:,:,1:number_of_tails) = &
+ particle_tail_coordinates(:,:,1:number_of_tails)
+ tmp_tail_mask(1:number_of_tails) = tail_mask(1:number_of_tails)
+
+ DEALLOCATE( new_tail_id, particle_tail_coordinates, tail_mask )
+ ALLOCATE( new_tail_id(new_maximum_number), &
+ particle_tail_coordinates(maximum_number_of_tailpoints,5, &
+ new_maximum_number), &
+ tail_mask(new_maximum_number) )
+ maximum_number_of_tails = new_maximum_number
+
+ particle_tail_coordinates = 0.0
+ particle_tail_coordinates(:,:,1:number_of_tails) = &
+ tmp_tail(:,:,1:number_of_tails)
+ tail_mask(1:number_of_tails) = tmp_tail_mask(1:number_of_tails)
+ tail_mask(number_of_tails+1:maximum_number_of_tails) = .TRUE.
+
+ END SUBROUTINE allocate_tail_memory
+
+
+ SUBROUTINE output_particles_netcdf
+#if defined( __netcdf )
+
+ USE control_parameters
+ USE netcdf_control
+ USE particle_attributes
+
+ IMPLICIT NONE
+
+
+ CALL check_open( 108 )
+
+!
+!-- Update the NetCDF time axis
+ prt_time_count = prt_time_count + 1
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_time_prt, (/ simulated_time /), &
+ start = (/ prt_time_count /), count = (/ 1 /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 1 )
+
+!
+!-- Output the real number of particles used
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_rnop_prt, &
+ (/ number_of_particles /), &
+ start = (/ prt_time_count /), count = (/ 1 /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 2 )
+
+!
+!-- Output all particle attributes
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(1), particles%age, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 3 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(2), particles%dvrp_psize, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 4 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(3), particles%origin_x, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 5 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(4), particles%origin_y, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 6 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(5), particles%origin_z, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 7 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(6), particles%radius, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 8 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(7), particles%speed_x, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 9 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(8), particles%speed_y, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 10 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(9), particles%speed_z, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 11 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt,id_var_prt(10),particles%weight_factor,&
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 12 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(11), particles%x, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 13 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(12), particles%y, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 14 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(13), particles%z, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 15 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(14), particles%color, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 16 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(15), particles%group, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 17 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(16), particles%tailpoints, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 18 )
+
+ nc_stat = NF90_PUT_VAR( id_set_prt, id_var_prt(17), particles%tail_id, &
+ start = (/ 1, prt_time_count /), &
+ count = (/ maximum_number_of_particles /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 19 )
+
+#endif
+ END SUBROUTINE output_particles_netcdf
+
+
+ SUBROUTINE write_particles
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Write particle data on restart file
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE particle_attributes
+ USE pegrid
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=10) :: particle_binary_version
+
+!
+!-- First open the output unit.
+ IF ( myid_char == '' ) THEN
+ OPEN ( 90, FILE='PARTICLE_RESTART_DATA_OUT'//myid_char, &
+ FORM='UNFORMATTED')
+ ELSE
+ IF ( myid == 0 ) CALL local_system( 'mkdir PARTICLE_RESTART_DATA_OUT' )
+#if defined( __parallel )
+!
+!-- Set a barrier in order to allow that thereafter all other processors
+!-- in the directory created by PE0 can open their file
+ CALL MPI_BARRIER( comm2d, ierr )
+#endif
+ OPEN ( 90, FILE='PARTICLE_RESTART_DATA_OUT/'//myid_char, &
+ FORM='UNFORMATTED' )
+ ENDIF
+
+!
+!-- Write the version number of the binary format.
+!-- Attention: After changes to the following output commands the version
+!-- --------- number of the variable particle_binary_version must be changed!
+!-- Also, the version number and the list of arrays to be read in
+!-- init_particles must be adjusted accordingly.
+ particle_binary_version = '3.0'
+ WRITE ( 90 ) particle_binary_version
+
+!
+!-- Write some particle parameters, the size of the particle arrays as well as
+!-- other dvrp-plot variables.
+ WRITE ( 90 ) bc_par_b, bc_par_lr, bc_par_ns, bc_par_t, &
+ maximum_number_of_particles, maximum_number_of_tailpoints, &
+ maximum_number_of_tails, number_of_initial_particles, &
+ number_of_particles, number_of_particle_groups, &
+ number_of_tails, particle_groups, time_prel, &
+ time_write_particle_data, uniform_particles
+
+ IF ( number_of_initial_particles /= 0 ) WRITE ( 90 ) initial_particles
+
+ WRITE ( 90 ) prt_count, prt_start_index
+ WRITE ( 90 ) particles
+
+ IF ( use_particle_tails ) THEN
+ WRITE ( 90 ) particle_tail_coordinates
+ ENDIF
+
+ CLOSE ( 90 )
+
+ END SUBROUTINE write_particles
+
+
+ SUBROUTINE collision_efficiency( mean_r, r, e)
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Interpolate collision efficiency from table
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ LOGICAL, SAVE :: first = .TRUE.
+
+ REAL :: aa, bb, cc, dd, dx, dy, e, gg, mean_r, mean_rm, r, rm, &
+ x, y
+
+ REAL, DIMENSION(1:9), SAVE :: collected_r = 0.0
+ REAL, DIMENSION(1:19), SAVE :: collector_r = 0.0
+ REAL, DIMENSION(1:9,1:19), SAVE :: ef = 0.0
+
+ mean_rm = mean_r * 1.0E06
+ rm = r * 1.0E06
+
+ IF ( first ) THEN
+ collected_r = (/ 2.0, 3.0, 4.0, 6.0, 8.0, 10.0, 15.0, 20.0, 25.0 /)
+ collector_r = (/ 10.0, 20.0, 30.0, 40.0, 50.0, 60.0, 80.0, 100.0, 150.0,&
+ 200.0, 300.0, 400.0, 500.0, 600.0, 1000.0, 1400.0, &
+ 1800.0, 2400.0, 3000.0 /)
+ ef(:,1) = (/0.017, 0.027, 0.037, 0.052, 0.052, 0.052, 0.052, 0.0, 0.0 /)
+ ef(:,2) = (/0.001, 0.016, 0.027, 0.060, 0.12, 0.17, 0.17, 0.17, 0.0 /)
+ ef(:,3) = (/0.001, 0.001, 0.02, 0.13, 0.28, 0.37, 0.54, 0.55, 0.47/)
+ ef(:,4) = (/0.001, 0.001, 0.02, 0.23, 0.4, 0.55, 0.7, 0.75, 0.75/)
+ ef(:,5) = (/0.01, 0.01, 0.03, 0.3, 0.4, 0.58, 0.73, 0.75, 0.79/)
+ ef(:,6) = (/0.01, 0.01, 0.13, 0.38, 0.57, 0.68, 0.80, 0.86, 0.91/)
+ ef(:,7) = (/0.01, 0.085, 0.23, 0.52, 0.68, 0.76, 0.86, 0.92, 0.95/)
+ ef(:,8) = (/0.01, 0.14, 0.32, 0.60, 0.73, 0.81, 0.90, 0.94, 0.96/)
+ ef(:,9) = (/0.025, 0.25, 0.43, 0.66, 0.78, 0.83, 0.92, 0.95, 0.96/)
+ ef(:,10)= (/0.039, 0.3, 0.46, 0.69, 0.81, 0.87, 0.93, 0.95, 0.96/)
+ ef(:,11)= (/0.095, 0.33, 0.51, 0.72, 0.82, 0.87, 0.93, 0.96, 0.97/)
+ ef(:,12)= (/0.098, 0.36, 0.51, 0.73, 0.83, 0.88, 0.93, 0.96, 0.97/)
+ ef(:,13)= (/0.1, 0.36, 0.52, 0.74, 0.83, 0.88, 0.93, 0.96, 0.97/)
+ ef(:,14)= (/0.17, 0.4, 0.54, 0.72, 0.83, 0.88, 0.94, 0.98, 1.0 /)
+ ef(:,15)= (/0.15, 0.37, 0.52, 0.74, 0.82, 0.88, 0.94, 0.98, 1.0 /)
+ ef(:,16)= (/0.11, 0.34, 0.49, 0.71, 0.83, 0.88, 0.94, 0.95, 1.0 /)
+ ef(:,17)= (/0.08, 0.29, 0.45, 0.68, 0.8, 0.86, 0.96, 0.94, 1.0 /)
+ ef(:,18)= (/0.04, 0.22, 0.39, 0.62, 0.75, 0.83, 0.92, 0.96, 1.0 /)
+ ef(:,19)= (/0.02, 0.16, 0.33, 0.55, 0.71, 0.81, 0.90, 0.94, 1.0 /)
+ ENDIF
+
+ DO k = 1, 8
+ IF ( collected_r(k) <= mean_rm ) i = k
+ ENDDO
+
+ DO k = 1, 18
+ IF ( collector_r(k) <= rm ) j = k
+ ENDDO
+
+ IF ( rm < 10.0 ) THEN
+ e = 0.0
+ ELSEIF ( mean_rm < 2.0 ) THEN
+ e = 0.001
+ ELSEIF ( mean_rm >= 25.0 ) THEN
+ IF( j <= 3 ) e = 0.55
+ IF( j == 4 ) e = 0.8
+ IF( j == 5 ) e = 0.9
+ IF( j >=6 ) e = 1.0
+ ELSEIF ( rm >= 3000.0 ) THEN
+ e = 1.0
+ ELSE
+ x = mean_rm - collected_r(i)
+ y = rm - collected_r(j)
+ dx = collected_r(i+1) - collected_r(i)
+ dy = collector_r(j+1) - collector_r(j)
+ aa = x**2 + y**2
+ bb = ( dx - x )**2 + y**2
+ cc = x**2 + ( dy - y )**2
+ dd = ( dx - x )**2 + ( dy - y )**2
+ gg = aa + bb + cc + dd
+
+ e = ( (gg-aa)*ef(i,j) + (gg-bb)*ef(i+1,j) + (gg-cc)*ef(i,j+1) + &
+ (gg-dd)*ef(i+1,j+1) ) / (3.0*gg)
+ ENDIF
+
+ END SUBROUTINE collision_efficiency
+
+
+
+ SUBROUTINE sort_particles
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Sort particles in the sequence the grid boxes are stored in memory
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE particle_attributes
+
+ IMPLICIT NONE
+
+ INTEGER :: i, ilow, j, k, n
+
+ TYPE(particle_type), DIMENSION(1:number_of_particles) :: particles_temp
+
+
+ CALL cpu_log( log_point_s(47), 'sort_particles', 'start' )
+
+!
+!-- Initialize the array used for counting and indexing the particles
+ prt_count = 0
+
+!
+!-- Count the particles per gridbox
+ DO n = 1, number_of_particles
+
+ i = ( particles(n)%x + 0.5 * dx ) * ddx
+ j = ( particles(n)%y + 0.5 * dy ) * ddy
+ k = particles(n)%z / dz + 1 ! only exact if equidistant
+
+ prt_count(k,j,i) = prt_count(k,j,i) + 1
+
+ IF ( i < nxl .OR. i > nxr .OR. j < nys .OR. j > nyn .OR. k < nzb+1 .OR. &
+ k > nzt ) THEN
+ PRINT*, '+++ sort_particles: particle out of range: i=', i, ' j=', &
+ j, ' k=', k
+ PRINT*, ' nxl=', nxl, ' nxr=', nxr, &
+ ' nys=', nys, ' nyn=', nyn, &
+ ' nzb=', nzb, ' nzt=', nzt
+ ENDIF
+
+ ENDDO
+
+!
+!-- Calculate the lower indices of those ranges of the particles-array
+!-- containing particles which belong to the same gridpox i,j,k
+ ilow = 1
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ prt_start_index(k,j,i) = ilow
+ ilow = ilow + prt_count(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Sorting the particles
+ DO n = 1, number_of_particles
+
+ i = ( particles(n)%x + 0.5 * dx ) * ddx
+ j = ( particles(n)%y + 0.5 * dy ) * ddy
+ k = particles(n)%z / dz + 1 ! only exact if equidistant
+
+ particles_temp(prt_start_index(k,j,i)) = particles(n)
+
+ prt_start_index(k,j,i) = prt_start_index(k,j,i) + 1
+
+ ENDDO
+
+ particles(1:number_of_particles) = particles_temp
+
+!
+!-- Reset the index array to the actual start position
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ prt_start_index(k,j,i) = prt_start_index(k,j,i) - prt_count(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CALL cpu_log( log_point_s(47), 'sort_particles', 'stop' )
+
+ END SUBROUTINE sort_particles
Index: /palm/tags/release-3.4a/SOURCE/advec_s_bc.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/advec_s_bc.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/advec_s_bc.f90 (revision 141)
@@ -0,0 +1,1127 @@
+ SUBROUTINE advec_s_bc( sk, sk_char )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 97 2007-06-21 08:23:15Z raasch
+! Advection of salinity included
+! Bugfix: Error in boundary condition for TKE removed
+!
+! 63 2007-03-13 03:52:49Z raasch
+! Calculation extended for gridpoint nzt
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.22 2006/02/23 09:42:08 raasch
+! anz renamed ngp
+!
+! Revision 1.1 1997/08/29 08:53:46 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Advection term for scalar quantities using the Bott-Chlond scheme.
+! Computation in individual steps for each of the three dimensions.
+! Limiting assumptions:
+! So far the scheme has been assuming equidistant grid spacing. As this is not
+! the case in the stretched portion of the z-direction, there dzw(k) is used as
+! a substitute for a constant grid length. This certainly causes incorrect
+! results; however, it is hoped that they are not too apparent for weakly
+! stretched grids.
+! NOTE: This is a provisional, non-optimised version!
+!------------------------------------------------------------------------------!
+
+ USE advection
+ USE arrays_3d
+ USE control_parameters
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE statistics
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: sk_char
+
+ INTEGER :: i, ix, j, k, ngp, sr, type_xz_2
+
+ REAL :: cim, cimf, cip, cipf, d_new, ffmax, fminus, fplus, f2, f4, f8, &
+ f12, f24, f48, f1920, im, ip, m2, m3, nenner, snenn, sterm, &
+ tendenz, t1, t2, zaehler
+ REAL :: fmax(2), fmax_l(2)
+ REAL, DIMENSION(:,:,:), POINTER :: sk
+
+ REAL, DIMENSION(:,:), ALLOCATABLE :: a0, a1, a12, a2, a22, immb, imme, &
+ impb, impe, ipmb, ipme, ippb, ippe
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: sk_p
+
+#if defined( __nec )
+ REAL (kind=4) :: m1n, m1z !Wichtig: Division
+ REAL (kind=4), DIMENSION(:,:), ALLOCATABLE :: m1, sw
+#else
+ REAL :: m1n, m1z
+ REAL, DIMENSION(:,:), ALLOCATABLE :: m1, sw
+#endif
+
+
+!
+!-- Array sk_p requires 2 extra elements for each dimension
+ ALLOCATE( sk_p(nzb-2:nzt+3,nys-3:nyn+3,nxl-3:nxr+3) )
+ sk_p = 0.0
+
+!
+!-- Assign reciprocal values in order to avoid divisions later
+ f2 = 0.5
+ f4 = 0.25
+ f8 = 0.125
+ f12 = 0.8333333333333333E-01
+ f24 = 0.4166666666666666E-01
+ f48 = 0.2083333333333333E-01
+ f1920 = 0.5208333333333333E-03
+
+!
+!-- Advection in x-direction:
+
+!
+!-- Save the quantity to be advected in a local array
+!-- add an enlarged boundary in x-direction
+ DO i = nxl-1, nxr+1
+ DO j = nys, nyn
+ DO k = nzb, nzt+1
+ sk_p(k,j,i) = sk(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+#if defined( __parallel )
+ ngp = 2 * ( nzt - nzb + 6 ) * ( nyn - nys + 7 )
+ CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'start' )
+!
+!-- Send left boundary, receive right boundary
+ CALL MPI_SENDRECV( sk_p(nzb-2,nys-3,nxl+1), ngp, MPI_REAL, pleft, 0, &
+ sk_p(nzb-2,nys-3,nxr+2), ngp, MPI_REAL, pright, 0, &
+ comm2d, status, ierr )
+!
+!-- Send right boundary, receive left boundary
+ CALL MPI_SENDRECV( sk_p(nzb-2,nys-3,nxr-2), ngp, MPI_REAL, pright, 1, &
+ sk_p(nzb-2,nys-3,nxl-3), ngp, MPI_REAL, pleft, 1, &
+ comm2d, status, ierr )
+ CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'pause' )
+#else
+
+!
+!-- Cyclic boundary conditions
+ sk_p(:,nys:nyn,nxl-3) = sk_p(:,nys:nyn,nxr-2)
+ sk_p(:,nys:nyn,nxl-2) = sk_p(:,nys:nyn,nxr-1)
+ sk_p(:,nys:nyn,nxr+2) = sk_p(:,nys:nyn,nxl+1)
+ sk_p(:,nys:nyn,nxr+3) = sk_p(:,nys:nyn,nxl+2)
+#endif
+
+!
+!-- In case of a sloping surface, the additional gridpoints in x-direction
+!-- of the temperature field at the left and right boundary of the total
+!-- domain must be adjusted by the temperature difference between this distance
+ IF ( sloping_surface .AND. sk_char == 'pt' ) THEN
+ IF ( nxl == 0 ) THEN
+ sk_p(:,nys:nyn,nxl-3) = sk_p(:,nys:nyn,nxl-3) - pt_slope_offset
+ sk_p(:,nys:nyn,nxl-2) = sk_p(:,nys:nyn,nxl-2) - pt_slope_offset
+ ENDIF
+ IF ( nxr == nx ) THEN
+ sk_p(:,nys:nyn,nxr+2) = sk_p(:,nys:nyn,nxr+2) + pt_slope_offset
+ sk_p(:,nys:nyn,nxr+3) = sk_p(:,nys:nyn,nxr+3) + pt_slope_offset
+ ENDIF
+ ENDIF
+
+!
+!-- Initialise control density
+ d = 0.0
+
+!
+!-- Determine maxima of the first and second derivative in x-direction
+ fmax_l = 0.0
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ zaehler = ABS( sk_p(k,j,i+1) - 2.0 * sk_p(k,j,i) + sk_p(k,j,i-1) )
+ nenner = ABS( sk_p(k,j,i+1) - sk_p(k,j,i-1) )
+ fmax_l(1) = MAX( fmax_l(1) , zaehler )
+ fmax_l(2) = MAX( fmax_l(2) , nenner )
+ ENDDO
+ ENDDO
+ ENDDO
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( fmax_l, fmax, 2, MPI_REAL, MPI_MAX, comm2d, ierr )
+#else
+ fmax = fmax_l
+#endif
+
+ fmax = 0.04 * fmax
+
+!
+!-- Allocate temporary arrays
+ ALLOCATE( a0(nzb+1:nzt,nxl-1:nxr+1), a1(nzb+1:nzt,nxl-1:nxr+1), &
+ a2(nzb+1:nzt,nxl-1:nxr+1), a12(nzb+1:nzt,nxl-1:nxr+1), &
+ a22(nzb+1:nzt,nxl-1:nxr+1), immb(nzb+1:nzt,nxl-1:nxr+1), &
+ imme(nzb+1:nzt,nxl-1:nxr+1), impb(nzb+1:nzt,nxl-1:nxr+1), &
+ impe(nzb+1:nzt,nxl-1:nxr+1), ipmb(nzb+1:nzt,nxl-1:nxr+1), &
+ ipme(nzb+1:nzt,nxl-1:nxr+1), ippb(nzb+1:nzt,nxl-1:nxr+1), &
+ ippe(nzb+1:nzt,nxl-1:nxr+1), m1(nzb+1:nzt,nxl-2:nxr+2), &
+ sw(nzb+1:nzt,nxl-1:nxr+1) &
+ )
+ imme = 0.0; impe = 0.0; ipme = 0.0; ippe = 0.0
+
+!
+!-- Initialise point of time measuring of the exponential portion (this would
+!-- not work if done locally within the loop)
+ CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'start' )
+ CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'pause' )
+
+!
+!-- Outer loop of all j
+ DO j = nys, nyn
+
+!
+!-- Compute polynomial coefficients
+ DO i = nxl-1, nxr+1
+ DO k = nzb+1, nzt
+ a12(k,i) = 0.5 * ( sk_p(k,j,i+1) - sk_p(k,j,i-1) )
+ a22(k,i) = 0.5 * ( sk_p(k,j,i+1) - 2.0 * sk_p(k,j,i) &
+ + sk_p(k,j,i-1) )
+ a0(k,i) = ( 9.0 * sk_p(k,j,i+2) - 116.0 * sk_p(k,j,i+1) &
+ + 2134.0 * sk_p(k,j,i) - 116.0 * sk_p(k,j,i-1) &
+ + 9.0 * sk_p(k,j,i-2) ) * f1920
+ a1(k,i) = ( -5.0 * sk_p(k,j,i+2) + 34.0 * sk_p(k,j,i+1) &
+ - 34.0 * sk_p(k,j,i-1) + 5.0 * sk_p(k,j,i-2) &
+ ) * f48
+ a2(k,i) = ( -3.0 * sk_p(k,j,i+2) + 36.0 * sk_p(k,j,i+1) &
+ - 66.0 * sk_p(k,j,i) + 36.0 * sk_p(k,j,i-1) &
+ - 3.0 * sk_p(k,j,i-2) ) * f48
+ ENDDO
+ ENDDO
+
+!
+!-- Fluxes using the Bott scheme
+!-- *VOCL LOOP,UNROLL(2)
+ DO i = nxl, nxr
+ DO k = nzb+1, nzt
+ cip = MAX( 0.0, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )
+ cim = -MIN( 0.0, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )
+ cipf = 1.0 - 2.0 * cip
+ cimf = 1.0 - 2.0 * cim
+ ip = a0(k,i) * f2 * ( 1.0 - cipf ) &
+ + a1(k,i) * f8 * ( 1.0 - cipf*cipf ) &
+ + a2(k,i) * f24 * ( 1.0 - cipf*cipf*cipf )
+ im = a0(k,i+1) * f2 * ( 1.0 - cimf ) &
+ - a1(k,i+1) * f8 * ( 1.0 - cimf*cimf ) &
+ + a2(k,i+1) * f24 * ( 1.0 - cimf*cimf*cimf )
+ ip = MAX( ip, 0.0 )
+ im = MAX( im, 0.0 )
+ ippb(k,i) = ip * MIN( 1.0, sk_p(k,j,i) / (ip+im+1E-15) )
+ impb(k,i) = im * MIN( 1.0, sk_p(k,j,i+1) / (ip+im+1E-15) )
+
+ cip = MAX( 0.0, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )
+ cim = -MIN( 0.0, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )
+ cipf = 1.0 - 2.0 * cip
+ cimf = 1.0 - 2.0 * cim
+ ip = a0(k,i-1) * f2 * ( 1.0 - cipf ) &
+ + a1(k,i-1) * f8 * ( 1.0 - cipf*cipf ) &
+ + a2(k,i-1) * f24 * ( 1.0 - cipf*cipf*cipf )
+ im = a0(k,i) * f2 * ( 1.0 - cimf ) &
+ - a1(k,i) * f8 * ( 1.0 - cimf*cimf ) &
+ + a2(k,i) * f24 * ( 1.0 - cimf*cimf*cimf )
+ ip = MAX( ip, 0.0 )
+ im = MAX( im, 0.0 )
+ ipmb(k,i) = ip * MIN( 1.0, sk_p(k,j,i-1) / (ip+im+1E-15) )
+ immb(k,i) = im * MIN( 1.0, sk_p(k,j,i) / (ip+im+1E-15) )
+ ENDDO
+ ENDDO
+
+!
+!-- Compute monitor function m1
+ DO i = nxl-2, nxr+2
+ DO k = nzb+1, nzt
+ m1z = ABS( sk_p(k,j,i+1) - 2.0 * sk_p(k,j,i) + sk_p(k,j,i-1) )
+ m1n = ABS( sk_p(k,j,i+1) - sk_p(k,j,i-1) )
+ IF ( m1n /= 0.0 .AND. m1n >= m1z ) THEN
+ m1(k,i) = m1z / m1n
+ IF ( m1(k,i) /= 2.0 .AND. m1n < fmax(2) ) m1(k,i) = 0.0
+ ELSEIF ( m1n < m1z ) THEN
+ m1(k,i) = -1.0
+ ELSE
+ m1(k,i) = 0.0
+ ENDIF
+ ENDDO
+ ENDDO
+
+!
+!-- Compute switch sw
+ sw = 0.0
+ DO i = nxl-1, nxr+1
+ DO k = nzb+1, nzt
+ m2 = 2.0 * ABS( a1(k,i) - a12(k,i) ) / &
+ MAX( ABS( a1(k,i) + a12(k,i) ), 1E-35 )
+ IF ( ABS( a1(k,i) + a12(k,i) ) < fmax(2) ) m2 = 0.0
+
+ m3 = 2.0 * ABS( a2(k,i) - a22(k,i) ) / &
+ MAX( ABS( a2(k,i) + a22(k,i) ), 1E-35 )
+ IF ( ABS( a2(k,i) + a22(k,i) ) < fmax(1) ) m3 = 0.0
+
+ t1 = 0.35
+ t2 = 0.35
+ IF ( m1(k,i) == -1.0 ) t2 = 0.12
+
+!-- *VOCL STMT,IF(10)
+ IF ( m1(k,i-1) == 1.0 .OR. m1(k,i) == 1.0 .OR. m1(k,i+1) == 1.0 &
+ .OR. m2 > t2 .OR. m3 > T2 .OR. &
+ ( m1(k,i) > t1 .AND. m1(k,i-1) /= -1.0 .AND. &
+ m1(k,i) /= -1.0 .AND. m1(k,i+1) /= -1.0 ) &
+ ) sw(k,i) = 1.0
+ ENDDO
+ ENDDO
+
+!
+!-- Fluxes using the exponential scheme
+ CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'continue' )
+ DO i = nxl, nxr
+ DO k = nzb+1, nzt
+
+!-- *VOCL STMT,IF(10)
+ IF ( sw(k,i) == 1.0 ) THEN
+ snenn = sk_p(k,j,i+1) - sk_p(k,j,i-1)
+ IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9
+ sterm = ( sk_p(k,j,i) - sk_p(k,j,i-1) ) / snenn
+ sterm = MIN( sterm, 0.9999 )
+ sterm = MAX( sterm, 0.0001 )
+
+ ix = INT( sterm * 1000 ) + 1
+
+ cip = MAX( 0.0, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )
+
+ ippe(k,i) = sk_p(k,j,i-1) * cip + snenn * ( &
+ aex(ix) * cip + bex(ix) / dex(ix) * ( &
+ eex(ix) - EXP( dex(ix)*0.5 * ( 1.0 - 2.0 * cip ) ) &
+ ) &
+ )
+ IF ( sterm == 0.0001 ) ippe(k,i) = sk_p(k,j,i) * cip
+ IF ( sterm == 0.9999 ) ippe(k,i) = sk_p(k,j,i) * cip
+
+ snenn = sk_p(k,j,i-1) - sk_p(k,j,i+1)
+ IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9
+ sterm = ( sk_p(k,j,i) - sk_p(k,j,i+1) ) / snenn
+ sterm = MIN( sterm, 0.9999 )
+ sterm = MAX( sterm, 0.0001 )
+
+ ix = INT( sterm * 1000 ) + 1
+
+ cim = -MIN( 0.0, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )
+
+ imme(k,i) = sk_p(k,j,i+1) * cim + snenn * ( &
+ aex(ix) * cim + bex(ix) / dex(ix) * ( &
+ eex(ix) - EXP( dex(ix)*0.5 * ( 1.0 - 2.0 * cim ) ) &
+ ) &
+ )
+ IF ( sterm == 0.0001 ) imme(k,i) = sk_p(k,j,i) * cim
+ IF ( sterm == 0.9999 ) imme(k,i) = sk_p(k,j,i) * cim
+ ENDIF
+
+!-- *VOCL STMT,IF(10)
+ IF ( sw(k,i+1) == 1.0 ) THEN
+ snenn = sk_p(k,j,i) - sk_p(k,j,i+2)
+ IF ( ABS( snenn ) .LT. 1E-9 ) snenn = 1E-9
+ sterm = ( sk_p(k,j,i+1) - sk_p(k,j,i+2) ) / snenn
+ sterm = MIN( sterm, 0.9999 )
+ sterm = MAX( sterm, 0.0001 )
+
+ ix = INT( sterm * 1000 ) + 1
+
+ cim = -MIN( 0.0, ( u(k,j,i+1) - u_gtrans ) * dt_3d * ddx )
+
+ impe(k,i) = sk_p(k,j,i+2) * cim + snenn * ( &
+ aex(ix) * cim + bex(ix) / dex(ix) * ( &
+ eex(ix) - EXP( dex(ix)*0.5 * ( 1.0 - 2.0 * cim ) ) &
+ ) &
+ )
+ IF ( sterm == 0.0001 ) impe(k,i) = sk_p(k,j,i+1) * cim
+ IF ( sterm == 0.9999 ) impe(k,i) = sk_p(k,j,i+1) * cim
+ ENDIF
+
+!-- *VOCL STMT,IF(10)
+ IF ( sw(k,i-1) == 1.0 ) THEN
+ snenn = sk_p(k,j,i) - sk_p(k,j,i-2)
+ IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9
+ sterm = ( sk_p(k,j,i-1) - sk_p(k,j,i-2) ) / snenn
+ sterm = MIN( sterm, 0.9999 )
+ sterm = MAX( sterm, 0.0001 )
+
+ ix = INT( sterm * 1000 ) + 1
+
+ cip = MAX( 0.0, ( u(k,j,i) - u_gtrans ) * dt_3d * ddx )
+
+ ipme(k,i) = sk_p(k,j,i-2) * cip + snenn * ( &
+ aex(ix) * cip + bex(ix) / dex(ix) * ( &
+ eex(ix) - EXP( dex(ix)*0.5 * ( 1.0 - 2.0 * cip ) ) &
+ ) &
+ )
+ IF ( sterm == 0.0001 ) ipme(k,i) = sk_p(k,j,i-1) * cip
+ IF ( sterm == 0.9999 ) ipme(k,i) = sk_p(k,j,i-1) * cip
+ ENDIF
+
+ ENDDO
+ ENDDO
+ CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'pause' )
+
+!
+!-- Prognostic equation
+ DO i = nxl, nxr
+ DO k = nzb+1, nzt
+ fplus = ( 1.0 - sw(k,i) ) * ippb(k,i) + sw(k,i) * ippe(k,i) &
+ - ( 1.0 - sw(k,i+1) ) * impb(k,i) - sw(k,i+1) * impe(k,i)
+ fminus = ( 1.0 - sw(k,i-1) ) * ipmb(k,i) + sw(k,i-1) * ipme(k,i) &
+ - ( 1.0 - sw(k,i) ) * immb(k,i) - sw(k,i) * imme(k,i)
+ tendenz = fplus - fminus
+!
+!-- Removed in order to optimize speed
+! ffmax = MAX( ABS( fplus ), ABS( fminus ), 1E-35 )
+! IF ( ( ABS( tendenz ) / ffmax ) < 1E-7 ) tendenz = 0.0
+!
+!-- Density correction because of possible remaining divergences
+ d_new = d(k,j,i) - ( u(k,j,i+1) - u(k,j,i) ) * dt_3d * ddx
+ sk_p(k,j,i) = ( ( 1.0 + d(k,j,i) ) * sk_p(k,j,i) - tendenz ) / &
+ ( 1.0 + d_new )
+ d(k,j,i) = d_new
+ ENDDO
+ ENDDO
+
+ ENDDO ! End of the advection in x-direction
+
+!
+!-- Deallocate temporary arrays
+ DEALLOCATE( a0, a1, a2, a12, a22, immb, imme, impb, impe, ipmb, ipme, &
+ ippb, ippe, m1, sw )
+
+
+!
+!-- Enlarge boundary of local array cyclically in y-direction
+#if defined( __parallel )
+ ngp = ( nzt - nzb + 6 ) * ( nyn - nys + 7 )
+ CALL MPI_TYPE_VECTOR( nxr-nxl+7, 3*(nzt-nzb+6), ngp, MPI_REAL, &
+ type_xz_2, ierr )
+ CALL MPI_TYPE_COMMIT( type_xz_2, ierr )
+!
+!-- Send front boundary, receive rear boundary
+ CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'continue' )
+ CALL MPI_SENDRECV( sk_p(nzb-2,nys,nxl-3), 1, type_xz_2, psouth, 0, &
+ sk_p(nzb-2,nyn+1,nxl-3), 1, type_xz_2, pnorth, 0, &
+ comm2d, status, ierr )
+!
+!-- Send rear boundary, receive front boundary
+ CALL MPI_SENDRECV( sk_p(nzb-2,nyn-2,nxl-3), 1, type_xz_2, pnorth, 1, &
+ sk_p(nzb-2,nys-3,nxl-3), 1, type_xz_2, psouth, 1, &
+ comm2d, status, ierr )
+ CALL MPI_TYPE_FREE( type_xz_2, ierr )
+ CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'pause' )
+#else
+ DO i = nxl, nxr
+ DO k = nzb+1, nzt
+ sk_p(k,nys-1,i) = sk_p(k,nyn,i)
+ sk_p(k,nys-2,i) = sk_p(k,nyn-1,i)
+ sk_p(k,nys-3,i) = sk_p(k,nyn-2,i)
+ sk_p(k,nyn+1,i) = sk_p(k,nys,i)
+ sk_p(k,nyn+2,i) = sk_p(k,nys+1,i)
+ sk_p(k,nyn+3,i) = sk_p(k,nys+2,i)
+ ENDDO
+ ENDDO
+#endif
+
+!
+!-- Determine the maxima of the first and second derivative in y-direction
+ fmax_l = 0.0
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ zaehler = ABS( sk_p(k,j+1,i) - 2.0 * sk_p(k,j,i) + sk_p(k,j-1,i) )
+ nenner = ABS( sk_p(k,j+1,i) - sk_p(k,j-1,i) )
+ fmax_l(1) = MAX( fmax_l(1) , zaehler )
+ fmax_l(2) = MAX( fmax_l(2) , nenner )
+ ENDDO
+ ENDDO
+ ENDDO
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( fmax_l, fmax, 2, MPI_REAL, MPI_MAX, comm2d, ierr )
+#else
+ fmax = fmax_l
+#endif
+
+ fmax = 0.04 * fmax
+
+!
+!-- Allocate temporary arrays
+ ALLOCATE( a0(nzb+1:nzt,nys-1:nyn+1), a1(nzb+1:nzt,nys-1:nyn+1), &
+ a2(nzb+1:nzt,nys-1:nyn+1), a12(nzb+1:nzt,nys-1:nyn+1), &
+ a22(nzb+1:nzt,nys-1:nyn+1), immb(nzb+1:nzt,nys-1:nyn+1), &
+ imme(nzb+1:nzt,nys-1:nyn+1), impb(nzb+1:nzt,nys-1:nyn+1), &
+ impe(nzb+1:nzt,nys-1:nyn+1), ipmb(nzb+1:nzt,nys-1:nyn+1), &
+ ipme(nzb+1:nzt,nys-1:nyn+1), ippb(nzb+1:nzt,nys-1:nyn+1), &
+ ippe(nzb+1:nzt,nys-1:nyn+1), m1(nzb+1:nzt,nys-2:nyn+2), &
+ sw(nzb+1:nzt,nys-1:nyn+1) &
+ )
+ imme = 0.0; impe = 0.0; ipme = 0.0; ippe = 0.0
+
+!
+!-- Outer loop of all i
+ DO i = nxl, nxr
+
+!
+!-- Compute polynomial coefficients
+ DO j = nys-1, nyn+1
+ DO k = nzb+1, nzt
+ a12(k,j) = 0.5 * ( sk_p(k,j+1,i) - sk_p(k,j-1,i) )
+ a22(k,j) = 0.5 * ( sk_p(k,j+1,i) - 2.0 * sk_p(k,j,i) &
+ + sk_p(k,j-1,i) )
+ a0(k,j) = ( 9.0 * sk_p(k,j+2,i) - 116.0 * sk_p(k,j+1,i) &
+ + 2134.0 * sk_p(k,j,i) - 116.0 * sk_p(k,j-1,i) &
+ + 9.0 * sk_p(k,j-2,i) ) * f1920
+ a1(k,j) = ( -5.0 * sk_p(k,j+2,i) + 34.0 * sk_p(k,j+1,i) &
+ - 34.0 * sk_p(k,j-1,i) + 5.0 * sk_p(k,j-2,i) &
+ ) * f48
+ a2(k,j) = ( -3.0 * sk_p(k,j+2,i) + 36.0 * sk_p(k,j+1,i) &
+ - 66.0 * sk_p(k,j,i) + 36.0 * sk_p(k,j-1,i) &
+ - 3.0 * sk_p(k,j-2,i) ) * f48
+ ENDDO
+ ENDDO
+
+!
+!-- Fluxes using the Bott scheme
+!-- *VOCL LOOP,UNROLL(2)
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ cip = MAX( 0.0, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )
+ cim = -MIN( 0.0, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )
+ cipf = 1.0 - 2.0 * cip
+ cimf = 1.0 - 2.0 * cim
+ ip = a0(k,j) * f2 * ( 1.0 - cipf ) &
+ + a1(k,j) * f8 * ( 1.0 - cipf*cipf ) &
+ + a2(k,j) * f24 * ( 1.0 - cipf*cipf*cipf )
+ im = a0(k,j+1) * f2 * ( 1.0 - cimf ) &
+ - a1(k,j+1) * f8 * ( 1.0 - cimf*cimf ) &
+ + a2(k,j+1) * f24 * ( 1.0 - cimf*cimf*cimf )
+ ip = MAX( ip, 0.0 )
+ im = MAX( im, 0.0 )
+ ippb(k,j) = ip * MIN( 1.0, sk_p(k,j,i) / (ip+im+1E-15) )
+ impb(k,j) = im * MIN( 1.0, sk_p(k,j+1,i) / (ip+im+1E-15) )
+
+ cip = MAX( 0.0, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )
+ cim = -MIN( 0.0, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )
+ cipf = 1.0 - 2.0 * cip
+ cimf = 1.0 - 2.0 * cim
+ ip = a0(k,j-1) * f2 * ( 1.0 - cipf ) &
+ + a1(k,j-1) * f8 * ( 1.0 - cipf*cipf ) &
+ + a2(k,j-1) * f24 * ( 1.0 - cipf*cipf*cipf )
+ im = a0(k,j) * f2 * ( 1.0 - cimf ) &
+ - a1(k,j) * f8 * ( 1.0 - cimf*cimf ) &
+ + a2(k,j) * f24 * ( 1.0 - cimf*cimf*cimf )
+ ip = MAX( ip, 0.0 )
+ im = MAX( im, 0.0 )
+ ipmb(k,j) = ip * MIN( 1.0, sk_p(k,j-1,i) / (ip+im+1E-15) )
+ immb(k,j) = im * MIN( 1.0, sk_p(k,j,i) / (ip+im+1E-15) )
+ ENDDO
+ ENDDO
+
+!
+!-- Compute monitor function m1
+ DO j = nys-2, nyn+2
+ DO k = nzb+1, nzt
+ m1z = ABS( sk_p(k,j+1,i) - 2.0 * sk_p(k,j,i) + sk_p(k,j-1,i) )
+ m1n = ABS( sk_p(k,j+1,i) - sk_p(k,j-1,i) )
+ IF ( m1n /= 0.0 .AND. m1n >= m1z ) THEN
+ m1(k,j) = m1z / m1n
+ IF ( m1(k,j) /= 2.0 .AND. m1n < fmax(2) ) m1(k,j) = 0.0
+ ELSEIF ( m1n < m1z ) THEN
+ m1(k,j) = -1.0
+ ELSE
+ m1(k,j) = 0.0
+ ENDIF
+ ENDDO
+ ENDDO
+
+!
+!-- Compute switch sw
+ sw = 0.0
+ DO j = nys-1, nyn+1
+ DO k = nzb+1, nzt
+ m2 = 2.0 * ABS( a1(k,j) - a12(k,j) ) / &
+ MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35 )
+ IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) ) m2 = 0.0
+
+ m3 = 2.0 * ABS( a2(k,j) - a22(k,j) ) / &
+ MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35 )
+ IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) ) m3 = 0.0
+
+ t1 = 0.35
+ t2 = 0.35
+ IF ( m1(k,j) == -1.0 ) t2 = 0.12
+
+!-- *VOCL STMT,IF(10)
+ IF ( m1(k,j-1) == 1.0 .OR. m1(k,j) == 1.0 .OR. m1(k,j+1) == 1.0 &
+ .OR. m2 > t2 .OR. m3 > T2 .OR. &
+ ( m1(k,j) > t1 .AND. m1(k,j-1) /= -1.0 .AND. &
+ m1(k,j) /= -1.0 .AND. m1(k,j+1) /= -1.0 ) &
+ ) sw(k,j) = 1.0
+ ENDDO
+ ENDDO
+
+!
+!-- Fluxes using exponential scheme
+ CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'continue' )
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+
+!-- *VOCL STMT,IF(10)
+ IF ( sw(k,j) == 1.0 ) THEN
+ snenn = sk_p(k,j+1,i) - sk_p(k,j-1,i)
+ IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9
+ sterm = ( sk_p(k,j,i) - sk_p(k,j-1,i) ) / snenn
+ sterm = MIN( sterm, 0.9999 )
+ sterm = MAX( sterm, 0.0001 )
+
+ ix = INT( sterm * 1000 ) + 1
+
+ cip = MAX( 0.0, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )
+
+ ippe(k,j) = sk_p(k,j-1,i) * cip + snenn * ( &
+ aex(ix) * cip + bex(ix) / dex(ix) * ( &
+ eex(ix) - EXP( dex(ix)*0.5 * ( 1.0 - 2.0 * cip ) ) &
+ ) &
+ )
+ IF ( sterm == 0.0001 ) ippe(k,j) = sk_p(k,j,i) * cip
+ IF ( sterm == 0.9999 ) ippe(k,j) = sk_p(k,j,i) * cip
+
+ snenn = sk_p(k,j-1,i) - sk_p(k,j+1,i)
+ IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9
+ sterm = ( sk_p(k,j,i) - sk_p(k,j+1,i) ) / snenn
+ sterm = MIN( sterm, 0.9999 )
+ sterm = MAX( sterm, 0.0001 )
+
+ ix = INT( sterm * 1000 ) + 1
+
+ cim = -MIN( 0.0, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )
+
+ imme(k,j) = sk_p(k,j+1,i) * cim + snenn * ( &
+ aex(ix) * cim + bex(ix) / dex(ix) * ( &
+ eex(ix) - EXP( dex(ix)*0.5 * ( 1.0 - 2.0 * cim ) ) &
+ ) &
+ )
+ IF ( sterm == 0.0001 ) imme(k,j) = sk_p(k,j,i) * cim
+ IF ( sterm == 0.9999 ) imme(k,j) = sk_p(k,j,i) * cim
+ ENDIF
+
+!-- *VOCL STMT,IF(10)
+ IF ( sw(k,j+1) == 1.0 ) THEN
+ snenn = sk_p(k,j,i) - sk_p(k,j+2,i)
+ IF ( ABS( snenn ) .LT. 1E-9 ) snenn = 1E-9
+ sterm = ( sk_p(k,j+1,i) - sk_p(k,j+2,i) ) / snenn
+ sterm = MIN( sterm, 0.9999 )
+ sterm = MAX( sterm, 0.0001 )
+
+ ix = INT( sterm * 1000 ) + 1
+
+ cim = -MIN( 0.0, ( v(k,j+1,i) - v_gtrans ) * dt_3d * ddy )
+
+ impe(k,j) = sk_p(k,j+2,i) * cim + snenn * ( &
+ aex(ix) * cim + bex(ix) / dex(ix) * ( &
+ eex(ix) - EXP( dex(ix)*0.5 * ( 1.0 - 2.0 * cim ) ) &
+ ) &
+ )
+ IF ( sterm == 0.0001 ) impe(k,j) = sk_p(k,j+1,i) * cim
+ IF ( sterm == 0.9999 ) impe(k,j) = sk_p(k,j+1,i) * cim
+ ENDIF
+
+!-- *VOCL STMT,IF(10)
+ IF ( sw(k,j-1) == 1.0 ) THEN
+ snenn = sk_p(k,j,i) - sk_p(k,j-2,i)
+ IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9
+ sterm = ( sk_p(k,j-1,i) - sk_p(k,j-2,i) ) / snenn
+ sterm = MIN( sterm, 0.9999 )
+ sterm = MAX( sterm, 0.0001 )
+
+ ix = INT( sterm * 1000 ) + 1
+
+ cip = MAX( 0.0, ( v(k,j,i) - v_gtrans ) * dt_3d * ddy )
+
+ ipme(k,j) = sk_p(k,j-2,i) * cip + snenn * ( &
+ aex(ix) * cip + bex(ix) / dex(ix) * ( &
+ eex(ix) - EXP( dex(ix)*0.5 * ( 1.0 - 2.0 * cip ) ) &
+ ) &
+ )
+ IF ( sterm == 0.0001 ) ipme(k,j) = sk_p(k,j-1,i) * cip
+ IF ( sterm == 0.9999 ) ipme(k,j) = sk_p(k,j-1,i) * cip
+ ENDIF
+
+ ENDDO
+ ENDDO
+ CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'pause' )
+
+!
+!-- Prognostic equation
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ fplus = ( 1.0 - sw(k,j) ) * ippb(k,j) + sw(k,j) * ippe(k,j) &
+ - ( 1.0 - sw(k,j+1) ) * impb(k,j) - sw(k,j+1) * impe(k,j)
+ fminus = ( 1.0 - sw(k,j-1) ) * ipmb(k,j) + sw(k,j-1) * ipme(k,j) &
+ - ( 1.0 - sw(k,j) ) * immb(k,j) - sw(k,j) * imme(k,j)
+ tendenz = fplus - fminus
+!
+!-- Removed in order to optimise speed
+! ffmax = MAX( ABS( fplus ), ABS( fminus ), 1E-35 )
+! IF ( ( ABS( tendenz ) / ffmax ) < 1E-7 ) tendenz = 0.0
+!
+!-- Density correction because of possible remaining divergences
+ d_new = d(k,j,i) - ( v(k,j+1,i) - v(k,j,i) ) * dt_3d * ddy
+ sk_p(k,j,i) = ( ( 1.0 + d(k,j,i) ) * sk_p(k,j,i) - tendenz ) / &
+ ( 1.0 + d_new )
+ d(k,j,i) = d_new
+ ENDDO
+ ENDDO
+
+ ENDDO ! End of the advection in y-direction
+ CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'continue' )
+ CALL cpu_log( log_point_s(11), 'advec_s_bc:sendrecv', 'stop' )
+
+!
+!-- Deallocate temporary arrays
+ DEALLOCATE( a0, a1, a2, a12, a22, immb, imme, impb, impe, ipmb, ipme, &
+ ippb, ippe, m1, sw )
+
+
+!
+!-- Initialise for the computation of heat fluxes (see below; required in
+!-- UP flow_statistics)
+ IF ( sk_char == 'pt' ) sums_wsts_bc_l = 0.0
+
+!
+!-- Add top and bottom boundaries according to the relevant boundary conditions
+ IF ( sk_char == 'pt' ) THEN
+
+!
+!-- Temperature boundary condition at the bottom boundary
+ IF ( ibc_pt_b == 0 ) THEN
+!
+!-- Dirichlet (fixed surface temperature)
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
+ sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
+ ENDDO
+ ENDDO
+
+ ELSE
+!
+!-- Neumann (i.e. here zero gradient)
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
+ sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+!
+!-- Temperature boundary condition at the top boundary
+ IF ( ibc_pt_t == 0 .OR. ibc_pt_t == 1 ) THEN
+!
+!-- Dirichlet or Neumann (zero gradient)
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ sk_p(nzt+2,j,i) = sk_p(nzt+1,j,i)
+ sk_p(nzt+3,j,i) = sk_p(nzt+1,j,i)
+ ENDDO
+ ENDDO
+
+ ELSEIF ( ibc_pt_t == 2 ) THEN
+!
+!-- Neumann: dzu(nzt+2:3) are not defined, dzu(nzt+1) is used instead
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ sk_p(nzt+2,j,i) = sk_p(nzt+1,j,i) + bc_pt_t_val * dzu(nzt+1)
+ sk_p(nzt+3,j,i) = sk_p(nzt+2,j,i) + bc_pt_t_val * dzu(nzt+1)
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+ ELSEIF ( sk_char == 'sa' ) THEN
+
+!
+!-- Salinity boundary condition at the bottom boundary.
+!-- So far, always Neumann (i.e. here zero gradient) is used
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
+ sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
+ ENDDO
+ ENDDO
+
+!
+!-- Salinity boundary condition at the top boundary.
+!-- Dirichlet or Neumann (zero gradient)
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ sk_p(nzt+2,j,i) = sk_p(nzt+1,j,i)
+ sk_p(nzt+3,j,i) = sk_p(nzt+1,j,i)
+ ENDDO
+ ENDDO
+
+ ELSEIF ( sk_char == 'q' ) THEN
+
+!
+!-- Specific humidity boundary condition at the bottom boundary.
+!-- Dirichlet (fixed surface humidity) or Neumann (i.e. zero gradient)
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
+ sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
+ ENDDO
+ ENDDO
+
+!
+!-- Specific humidity boundary condition at the top boundary
+ IF ( ibc_q_t == 0 ) THEN
+!
+!-- Dirichlet
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ sk_p(nzt+2,j,i) = sk_p(nzt+1,j,i)
+ sk_p(nzt+3,j,i) = sk_p(nzt+1,j,i)
+ ENDDO
+ ENDDO
+
+ ELSE
+!
+!-- Neumann: dzu(nzt+2:3) are not defined, dzu(nzt+1) is used instead
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ sk_p(nzt+2,j,i) = sk_p(nzt+1,j,i) + bc_q_t_val * dzu(nzt+1)
+ sk_p(nzt+3,j,i) = sk_p(nzt+2,j,i) + bc_q_t_val * dzu(nzt+1)
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+ ELSEIF ( sk_char == 'e' ) THEN
+
+!
+!-- TKE boundary condition at bottom and top boundary (generally Neumann)
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ sk_p(nzb-1,j,i) = sk_p(nzb,j,i)
+ sk_p(nzb-2,j,i) = sk_p(nzb,j,i)
+ sk_p(nzt+2,j,i) = sk_p(nzt+1,j,i)
+ sk_p(nzt+3,j,i) = sk_p(nzt+1,j,i)
+ ENDDO
+ ENDDO
+
+ ELSE
+
+ IF ( myid == 0 ) PRINT*,'+++ advec_s_bc: no vertical boundary condi', &
+ 'tion for variable "', sk_char, '"'
+ CALL local_stop
+
+ ENDIF
+
+!
+!-- Determine the maxima of the first and second derivative in z-direction
+ fmax_l = 0.0
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb, nzt+1
+ zaehler = ABS( sk_p(k+1,j,i) - 2.0 * sk_p(k,j,i) + sk_p(k-1,j,i) )
+ nenner = ABS( sk_p(k+1,j,i+1) - sk_p(k-1,j,i) )
+ fmax_l(1) = MAX( fmax_l(1) , zaehler )
+ fmax_l(2) = MAX( fmax_l(2) , nenner )
+ ENDDO
+ ENDDO
+ ENDDO
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( fmax_l, fmax, 2, MPI_REAL, MPI_MAX, comm2d, ierr )
+#else
+ fmax = fmax_l
+#endif
+
+ fmax = 0.04 * fmax
+
+!
+!-- Allocate temporary arrays
+ ALLOCATE( a0(nzb:nzt+1,nys:nyn), a1(nzb:nzt+1,nys:nyn), &
+ a2(nzb:nzt+1,nys:nyn), a12(nzb:nzt+1,nys:nyn), &
+ a22(nzb:nzt+1,nys:nyn), immb(nzb+1:nzt,nys:nyn), &
+ imme(nzb+1:nzt,nys:nyn), impb(nzb+1:nzt,nys:nyn), &
+ impe(nzb+1:nzt,nys:nyn), ipmb(nzb+1:nzt,nys:nyn), &
+ ipme(nzb+1:nzt,nys:nyn), ippb(nzb+1:nzt,nys:nyn), &
+ ippe(nzb+1:nzt,nys:nyn), m1(nzb-1:nzt+2,nys:nyn), &
+ sw(nzb:nzt+1,nys:nyn) &
+ )
+ imme = 0.0; impe = 0.0; ipme = 0.0; ippe = 0.0
+
+!
+!-- Outer loop of all i
+ DO i = nxl, nxr
+
+!
+!-- Compute polynomial coefficients
+ DO j = nys, nyn
+ DO k = nzb, nzt+1
+ a12(k,j) = 0.5 * ( sk_p(k+1,j,i) - sk_p(k-1,j,i) )
+ a22(k,j) = 0.5 * ( sk_p(k+1,j,i) - 2.0 * sk_p(k,j,i) &
+ + sk_p(k-1,j,i) )
+ a0(k,j) = ( 9.0 * sk_p(k+2,j,i) - 116.0 * sk_p(k+1,j,i) &
+ + 2134.0 * sk_p(k,j,i) - 116.0 * sk_p(k-1,j,i) &
+ + 9.0 * sk_p(k-2,j,i) ) * f1920
+ a1(k,j) = ( -5.0 * sk_p(k+2,j,i) + 34.0 * sk_p(k+1,j,i) &
+ - 34.0 * sk_p(k-1,j,i) + 5.0 * sk_p(k-2,j,i) &
+ ) * f48
+ a2(k,j) = ( -3.0 * sk_p(k+2,j,i) + 36.0 * sk_p(k+1,j,i) &
+ - 66.0 * sk_p(k,j,i) + 36.0 * sk_p(k-1,j,i) &
+ - 3.0 * sk_p(k-2,j,i) ) * f48
+ ENDDO
+ ENDDO
+
+!
+!-- Fluxes using the Bott scheme
+!-- *VOCL LOOP,UNROLL(2)
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ cip = MAX( 0.0, w(k,j,i) * dt_3d * ddzw(k) )
+ cim = -MIN( 0.0, w(k,j,i) * dt_3d * ddzw(k) )
+ cipf = 1.0 - 2.0 * cip
+ cimf = 1.0 - 2.0 * cim
+ ip = a0(k,j) * f2 * ( 1.0 - cipf ) &
+ + a1(k,j) * f8 * ( 1.0 - cipf*cipf ) &
+ + a2(k,j) * f24 * ( 1.0 - cipf*cipf*cipf )
+ im = a0(k+1,j) * f2 * ( 1.0 - cimf ) &
+ - a1(k+1,j) * f8 * ( 1.0 - cimf*cimf ) &
+ + a2(k+1,j) * f24 * ( 1.0 - cimf*cimf*cimf )
+ ip = MAX( ip, 0.0 )
+ im = MAX( im, 0.0 )
+ ippb(k,j) = ip * MIN( 1.0, sk_p(k,j,i) / (ip+im+1E-15) )
+ impb(k,j) = im * MIN( 1.0, sk_p(k+1,j,i) / (ip+im+1E-15) )
+
+ cip = MAX( 0.0, w(k-1,j,i) * dt_3d * ddzw(k) )
+ cim = -MIN( 0.0, w(k-1,j,i) * dt_3d * ddzw(k) )
+ cipf = 1.0 - 2.0 * cip
+ cimf = 1.0 - 2.0 * cim
+ ip = a0(k-1,j) * f2 * ( 1.0 - cipf ) &
+ + a1(k-1,j) * f8 * ( 1.0 - cipf*cipf ) &
+ + a2(k-1,j) * f24 * ( 1.0 - cipf*cipf*cipf )
+ im = a0(k,j) * f2 * ( 1.0 - cimf ) &
+ - a1(k,j) * f8 * ( 1.0 - cimf*cimf ) &
+ + a2(k,j) * f24 * ( 1.0 - cimf*cimf*cimf )
+ ip = MAX( ip, 0.0 )
+ im = MAX( im, 0.0 )
+ ipmb(k,j) = ip * MIN( 1.0, sk_p(k-1,j,i) / (ip+im+1E-15) )
+ immb(k,j) = im * MIN( 1.0, sk_p(k,j,i) / (ip+im+1E-15) )
+ ENDDO
+ ENDDO
+
+!
+!-- Compute monitor function m1
+ DO j = nys, nyn
+ DO k = nzb-1, nzt+2
+ m1z = ABS( sk_p(k+1,j,i) - 2.0 * sk_p(k,j,i) + sk_p(k-1,j,i) )
+ m1n = ABS( sk_p(k+1,j,i) - sk_p(k-1,j,i) )
+ IF ( m1n /= 0.0 .AND. m1n >= m1z ) THEN
+ m1(k,j) = m1z / m1n
+ IF ( m1(k,j) /= 2.0 .AND. m1n < fmax(2) ) m1(k,j) = 0.0
+ ELSEIF ( m1n < m1z ) THEN
+ m1(k,j) = -1.0
+ ELSE
+ m1(k,j) = 0.0
+ ENDIF
+ ENDDO
+ ENDDO
+
+!
+!-- Compute switch sw
+ sw = 0.0
+ DO j = nys, nyn
+ DO k = nzb, nzt+1
+ m2 = 2.0 * ABS( a1(k,j) - a12(k,j) ) / &
+ MAX( ABS( a1(k,j) + a12(k,j) ), 1E-35 )
+ IF ( ABS( a1(k,j) + a12(k,j) ) < fmax(2) ) m2 = 0.0
+
+ m3 = 2.0 * ABS( a2(k,j) - a22(k,j) ) / &
+ MAX( ABS( a2(k,j) + a22(k,j) ), 1E-35 )
+ IF ( ABS( a2(k,j) + a22(k,j) ) < fmax(1) ) m3 = 0.0
+
+ t1 = 0.35
+ t2 = 0.35
+ IF ( m1(k,j) == -1.0 ) t2 = 0.12
+
+!-- *VOCL STMT,IF(10)
+ IF ( m1(k-1,j) == 1.0 .OR. m1(k,j) == 1.0 .OR. m1(k+1,j) == 1.0 &
+ .OR. m2 > t2 .OR. m3 > T2 .OR. &
+ ( m1(k,j) > t1 .AND. m1(k-1,j) /= -1.0 .AND. &
+ m1(k,j) /= -1.0 .AND. m1(k+1,j) /= -1.0 ) &
+ ) sw(k,j) = 1.0
+ ENDDO
+ ENDDO
+
+!
+!-- Fluxes using exponential scheme
+ CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'continue' )
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+
+!-- *VOCL STMT,IF(10)
+ IF ( sw(k,j) == 1.0 ) THEN
+ snenn = sk_p(k+1,j,i) - sk_p(k-1,j,i)
+ IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9
+ sterm = ( sk_p(k,j,i) - sk_p(k-1,j,i) ) / snenn
+ sterm = MIN( sterm, 0.9999 )
+ sterm = MAX( sterm, 0.0001 )
+
+ ix = INT( sterm * 1000 ) + 1
+
+ cip = MAX( 0.0, w(k,j,i) * dt_3d * ddzw(k) )
+
+ ippe(k,j) = sk_p(k-1,j,i) * cip + snenn * ( &
+ aex(ix) * cip + bex(ix) / dex(ix) * ( &
+ eex(ix) - EXP( dex(ix)*0.5 * ( 1.0 - 2.0 * cip ) ) &
+ ) &
+ )
+ IF ( sterm == 0.0001 ) ippe(k,j) = sk_p(k,j,i) * cip
+ IF ( sterm == 0.9999 ) ippe(k,j) = sk_p(k,j,i) * cip
+
+ snenn = sk_p(k-1,j,i) - sk_p(k+1,j,i)
+ IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9
+ sterm = ( sk_p(k,j,i) - sk_p(k+1,j,i) ) / snenn
+ sterm = MIN( sterm, 0.9999 )
+ sterm = MAX( sterm, 0.0001 )
+
+ ix = INT( sterm * 1000 ) + 1
+
+ cim = -MIN( 0.0, w(k-1,j,i) * dt_3d * ddzw(k) )
+
+ imme(k,j) = sk_p(k+1,j,i) * cim + snenn * ( &
+ aex(ix) * cim + bex(ix) / dex(ix) * ( &
+ eex(ix) - EXP( dex(ix)*0.5 * ( 1.0 - 2.0 * cim ) ) &
+ ) &
+ )
+ IF ( sterm == 0.0001 ) imme(k,j) = sk_p(k,j,i) * cim
+ IF ( sterm == 0.9999 ) imme(k,j) = sk_p(k,j,i) * cim
+ ENDIF
+
+!-- *VOCL STMT,IF(10)
+ IF ( sw(k+1,j) == 1.0 ) THEN
+ snenn = sk_p(k,j,i) - sk_p(k+2,j,i)
+ IF ( ABS( snenn ) .LT. 1E-9 ) snenn = 1E-9
+ sterm = ( sk_p(k+1,j,i) - sk_p(k+2,j,i) ) / snenn
+ sterm = MIN( sterm, 0.9999 )
+ sterm = MAX( sterm, 0.0001 )
+
+ ix = INT( sterm * 1000 ) + 1
+
+ cim = -MIN( 0.0, w(k,j,i) * dt_3d * ddzw(k) )
+
+ impe(k,j) = sk_p(k+2,j,i) * cim + snenn * ( &
+ aex(ix) * cim + bex(ix) / dex(ix) * ( &
+ eex(ix) - EXP( dex(ix)*0.5 * ( 1.0 - 2.0 * cim ) ) &
+ ) &
+ )
+ IF ( sterm == 0.0001 ) impe(k,j) = sk_p(k+1,j,i) * cim
+ IF ( sterm == 0.9999 ) impe(k,j) = sk_p(k+1,j,i) * cim
+ ENDIF
+
+!-- *VOCL STMT,IF(10)
+ IF ( sw(k-1,j) == 1.0 ) THEN
+ snenn = sk_p(k,j,i) - sk_p(k-2,j,i)
+ IF ( ABS( snenn ) < 1E-9 ) snenn = 1E-9
+ sterm = ( sk_p(k-1,j,i) - sk_p(k-2,j,i) ) / snenn
+ sterm = MIN( sterm, 0.9999 )
+ sterm = MAX( sterm, 0.0001 )
+
+ ix = INT( sterm * 1000 ) + 1
+
+ cip = MAX( 0.0, w(k-1,j,i) * dt_3d * ddzw(k) )
+
+ ipme(k,j) = sk_p(k-2,j,i) * cip + snenn * ( &
+ aex(ix) * cip + bex(ix) / dex(ix) * ( &
+ eex(ix) - EXP( dex(ix)*0.5 * ( 1.0 - 2.0 * cip ) ) &
+ ) &
+ )
+ IF ( sterm == 0.0001 ) ipme(k,j) = sk_p(k-1,j,i) * cip
+ IF ( sterm == 0.9999 ) ipme(k,j) = sk_p(k-1,j,i) * cip
+ ENDIF
+
+ ENDDO
+ ENDDO
+ CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'pause' )
+
+!
+!-- Prognostic equation
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ fplus = ( 1.0 - sw(k,j) ) * ippb(k,j) + sw(k,j) * ippe(k,j) &
+ - ( 1.0 - sw(k+1,j) ) * impb(k,j) - sw(k+1,j) * impe(k,j)
+ fminus = ( 1.0 - sw(k-1,j) ) * ipmb(k,j) + sw(k-1,j) * ipme(k,j) &
+ - ( 1.0 - sw(k,j) ) * immb(k,j) - sw(k,j) * imme(k,j)
+ tendenz = fplus - fminus
+!
+!-- Removed in order to optimise speed
+! ffmax = MAX( ABS( fplus ), ABS( fminus ), 1E-35 )
+! IF ( ( ABS( tendenz ) / ffmax ) < 1E-7 ) tendenz = 0.0
+!
+!-- Density correction because of possible remaining divergences
+ d_new = d(k,j,i) - ( w(k,j,i) - w(k-1,j,i) ) * dt_3d * ddzw(k)
+ sk_p(k,j,i) = ( ( 1.0 + d(k,j,i) ) * sk_p(k,j,i) - tendenz ) / &
+ ( 1.0 + d_new )
+!
+!-- Store heat flux for subsequent statistics output.
+!-- array m1 is here used as temporary storage
+ m1(k,j) = fplus / dt_3d * dzw(k)
+ ENDDO
+ ENDDO
+
+!
+!-- Sum up heat flux in order to order to obtain horizontal averages
+ IF ( sk_char == 'pt' ) THEN
+ DO sr = 0, statistic_regions
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ sums_wsts_bc_l(k,sr) = sums_wsts_bc_l(k,sr) + &
+ m1(k,j) * rmask(j,i,sr)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+ ENDDO ! End of the advection in z-direction
+ CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'continue' )
+ CALL cpu_log( log_point_s(12), 'advec_s_bc:exp', 'stop' )
+
+!
+!-- Deallocate temporary arrays
+ DEALLOCATE( a0, a1, a2, a12, a22, immb, imme, impb, impe, ipmb, ipme, &
+ ippb, ippe, m1, sw )
+
+!
+!-- Store results as tendency and deallocate local array
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ tend(k,j,i) = tend(k,j,i) + ( sk_p(k,j,i) - sk(k,j,i) ) / dt_3d
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DEALLOCATE( sk_p )
+
+ END SUBROUTINE advec_s_bc
Index: /palm/tags/release-3.4a/SOURCE/advec_s_pw.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/advec_s_pw.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/advec_s_pw.f90 (revision 141)
@@ -0,0 +1,114 @@
+ MODULE advec_s_pw_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 19 2007-02-23 04:53:48Z raasch
+! Calculation extended for gridpoint nzt
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.12 2006/02/23 09:42:55 raasch
+! nzb_2d replaced by nzb_s_inner
+!
+! Revision 1.1 1997/08/29 08:54:20 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Advection term for scalar variables using the Piacsek and Williams scheme
+! (form C3). Contrary to PW itself, for reasons of accuracy their scheme is
+! slightly modified as follows: the values of those scalars that are used for
+! the computation of the flux divergence are reduced by the value of the
+! relevant scalar at the location where the difference is computed (sk(k,j,i)).
+! NOTE: at the first grid point above the surface computation still takes place!
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC advec_s_pw
+
+ INTERFACE advec_s_pw
+ MODULE PROCEDURE advec_s_pw
+ MODULE PROCEDURE advec_s_pw_ij
+ END INTERFACE
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_s_pw( sk )
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL, DIMENSION(:,:,:), POINTER :: sk
+
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) &
+ -0.5 * ( ( u(k,j,i+1) - u_gtrans ) * ( sk(k,j,i+1) - sk(k,j,i) ) &
+ - ( u(k,j,i) - u_gtrans ) * ( sk(k,j,i-1) - sk(k,j,i) ) &
+ ) * ddx &
+ -0.5 * ( ( v(k,j+1,i) - v_gtrans ) * ( sk(k,j+1,i) - sk(k,j,i) ) &
+ - ( v(k,j,i) - v_gtrans ) * ( sk(k,j-1,i) - sk(k,j,i) ) &
+ ) * ddy &
+ - ( w(k,j,i) * ( sk(k+1,j,i) - sk(k,j,i) ) &
+ - w(k-1,j,i) * ( sk(k-1,j,i) - sk(k,j,i) ) &
+ ) * dd2zu(k)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE advec_s_pw
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_s_pw_ij( i, j, sk )
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL, DIMENSION(:,:,:), POINTER :: sk
+
+
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) &
+ -0.5 * ( ( u(k,j,i+1) - u_gtrans ) * ( sk(k,j,i+1) - sk(k,j,i) ) &
+ - ( u(k,j,i) - u_gtrans ) * ( sk(k,j,i-1) - sk(k,j,i) ) &
+ ) * ddx &
+ -0.5 * ( ( v(k,j+1,i) - v_gtrans ) * ( sk(k,j+1,i) - sk(k,j,i) ) &
+ - ( v(k,j,i) - v_gtrans ) * ( sk(k,j-1,i) - sk(k,j,i) ) &
+ ) * ddy &
+ - ( w(k,j,i) * ( sk(k+1,j,i) - sk(k,j,i) ) &
+ - w(k-1,j,i) * ( sk(k-1,j,i) - sk(k,j,i) ) &
+ ) * dd2zu(k)
+ ENDDO
+
+ END SUBROUTINE advec_s_pw_ij
+
+ END MODULE advec_s_pw_mod
Index: /palm/tags/release-3.4a/SOURCE/advec_s_up.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/advec_s_up.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/advec_s_up.f90 (revision 141)
@@ -0,0 +1,151 @@
+ MODULE advec_s_up_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Forner revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.11 2006/02/23 09:43:44 raasch
+! nzb_2d replaced by nzb_s_inner
+!
+! Revision 1.1 1997/08/29 08:54:33 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Advection term for scalar quantities using the Upstream scheme.
+! NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
+! The same problem occurs for all topography boundaries!
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC advec_s_up
+
+ INTERFACE advec_s_up
+ MODULE PROCEDURE advec_s_up
+ MODULE PROCEDURE advec_s_up_ij
+ END INTERFACE advec_s_up
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_s_up( sk )
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL :: ukomp, vkomp, wkomp
+ REAL, DIMENSION(:,:,:), POINTER :: sk
+
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+!
+!-- x-direction
+ ukomp = 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
+ IF ( ukomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
+ ENDIF
+!
+!-- y-direction
+ vkomp = 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
+ IF ( vkomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
+ ENDIF
+!
+!-- z-direction
+ wkomp = 0.5 * ( w(k,j,i) + w(k-1,j,i) )
+ IF ( wkomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - wkomp * &
+ ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - wkomp * &
+ ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
+ ENDIF
+
+ ENDDO
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE advec_s_up
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_s_up_ij( i, j, sk )
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL :: ukomp, vkomp, wkomp
+ REAL, DIMENSION(:,:,:), POINTER :: sk
+
+
+ DO k = nzb_s_inner(j,i)+1, nzt
+!
+!-- x-direction
+ ukomp = 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
+ IF ( ukomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( sk(k,j,i) - sk(k,j,i-1) ) * ddx
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( sk(k,j,i+1) - sk(k,j,i) ) * ddx
+ ENDIF
+!
+!-- y-direction
+ vkomp = 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
+ IF ( vkomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( sk(k,j,i) - sk(k,j-1,i) ) * ddy
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( sk(k,j+1,i) - sk(k,j,i) ) * ddy
+ ENDIF
+!
+!-- z-direction
+ wkomp = 0.5 * ( w(k,j,i) + w(k-1,j,i) )
+ IF ( wkomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - wkomp * &
+ ( sk(k,j,i) - sk(k-1,j,i) ) * ddzu(k)
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - wkomp * &
+ ( sk(k+1,j,i)-sk(k,j,i) ) * ddzu(k+1)
+ ENDIF
+
+ ENDDO
+
+ END SUBROUTINE advec_s_up_ij
+
+ END MODULE advec_s_up_mod
Index: /palm/tags/release-3.4a/SOURCE/advec_s_ups.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/advec_s_ups.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/advec_s_ups.f90 (revision 141)
@@ -0,0 +1,187 @@
+ SUBROUTINE advec_s_ups( s, var_char )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.6 2004/04/30 08:02:43 raasch
+! Enlarged transposition arrays introduced
+!
+! Revision 1.1 1999/02/05 08:44:47 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Upstream-Spline advection of scalar quantities (potential temperature,
+! turbulent kinetic energy). The advection process is divided into three
+! subsequent steps, one for each of the dimensions. The result is stored as a
+! tendency in array tend. The computation of the cubic splines and the possible
+! execution of the Long-filter require that all grid points of the relevant
+! dimension are available. For model runs on more than one PE therefore both the
+! advected and the advecting quantities are transposed accordingly.
+!
+! Actual arguments:
+! s = scalar quantity to be advected (remains unchanged in this UP)
+! var_char = character string specifying the quantity to be advected
+!
+! Internally used arrays:
+! v_ad = scalar quantity to be advected, initialized = s at the beginning,
+! also being used as temporary storage after each time step
+! d = advecting component (u, v, or w)
+!------------------------------------------------------------------------------!
+
+ USE advection
+ USE arrays_3d
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: var_char
+
+ INTEGER :: i, j, k
+ REAL :: s(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: v_ad
+
+ CALL cpu_log( log_point_s(16), 'advec_s_ups', 'start' )
+
+#if defined( __parallel )
+
+!
+!-- Advection of the scalar in x-direction:
+!-- Store the scalar in temporary array v_ad (component to be advected,
+!-- boundaries are not used because they disturb the transposition)
+ ALLOCATE( v_ad(nzb+1:nzta,nys:nyna,nxl:nxra) )
+ v_ad = 0.0
+ v_ad(nzb+1:nzt,nys:nyn,nxl:nxr) = s(nzb+1:nzt,nys:nyn,nxl:nxr)
+
+!
+!-- Enlarge the size of tend, used as a working array for the transpositions
+ IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN
+ DEALLOCATE( tend )
+ ALLOCATE( tend(1:nza,nys:nyna,nxl:nxra) )
+ ENDIF
+
+!
+!-- Transpose the component to be advected: z --> x
+ CALL transpose_zx( v_ad, tend, v_ad, tend, v_ad )
+
+#else
+
+!
+!-- Advection of the scalar in x-direction:
+!-- Store the scalar in temporary array v_ad (component to be advected)
+ ALLOCATE( v_ad(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ v_ad(:,:,:) = s(:,:,:)
+
+#endif
+
+!
+!-- Advecting component (u) must be averaged out on the scalar's grid
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ d(k,j,i) = 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - u_gtrans
+ ENDDO
+ ENDDO
+ ENDDO
+
+#if defined( __parallel )
+
+!
+!-- Transpose the advecting componnet: z --> x
+ CALL transpose_zx( d, tend, d, tend, d )
+
+#endif
+
+!
+!-- Upstream-Spline advection of the scalar in x-direction
+ CALL spline_x( v_ad, d, var_char )
+
+!
+!-- Advection of the scalar in y-direction:
+!-- advecting component (v) must be averaged out on the scalar's grid
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ d(k,j,i) = 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - v_gtrans
+ ENDDO
+ ENDDO
+ ENDDO
+
+#if defined( __parallel )
+
+!
+!-- Transpose the advecting component: z --> y
+ CALL transpose_zx( d, tend, d, tend, d )
+ CALL transpose_xy( d, tend, d, tend, d )
+
+!
+!-- Transpose the component to be advected: x --> y
+ CALL transpose_xy( v_ad, tend, v_ad, tend, v_ad )
+
+#endif
+
+!
+!-- Upstream-Spline advection of the scalar in y-direction
+ CALL spline_y( v_ad, d, var_char )
+
+!
+!-- Advection of the scalar in z-direction:
+!-- the advecting component (w) must be averaged out on the scalar's grid
+!-- (weighted for non-equidistant grid)
+ d = 0.0
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ d(k,j,i) = ( w(k,j,i) * ( zu(k) - zw(k-1) ) + &
+ w(k-1,j,i) * ( zw(k) - zu(k) ) ) * ddzw(k)
+ ENDDO
+ ENDDO
+ ENDDO
+
+#if defined( __parallel )
+
+!
+!-- Transpose the component to be advected: y --> z (= y --> x + x --> z)
+ CALL transpose_yx( v_ad, tend, v_ad, tend, v_ad )
+ CALL transpose_xz( v_ad, tend, v_ad, tend, v_ad )
+
+!
+!-- Resize tend to its normal size
+ IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN
+ DEALLOCATE( tend )
+ ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+
+#endif
+
+!
+!-- Upstream-Spline advection of the scalar in z-direction
+ CALL spline_z( v_ad, d, dzu, spl_tri_zu, var_char )
+
+!
+!-- Compute the tendency term
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ tend(k,j,i) = ( v_ad(k,j,i) - s(k,j,i) ) / dt_3d
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DEALLOCATE( v_ad )
+
+ CALL cpu_log( log_point_s(16), 'advec_s_ups', 'stop' )
+
+ END SUBROUTINE advec_s_ups
Index: /palm/tags/release-3.4a/SOURCE/advec_u_pw.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/advec_u_pw.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/advec_u_pw.f90 (revision 141)
@@ -0,0 +1,113 @@
+ MODULE advec_u_pw_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 106 2007-08-16 14:30:26Z raasch
+! i loop is starting from nxlu (needed for non-cyclic boundary conditions)
+!
+! 75 2007-03-22 09:54:05Z raasch
+! uxrp eliminated
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.15 2006/02/23 09:44:21 raasch
+! nzb_2d replaced by nzb_u_inner
+!
+! Revision 1.1 1997/08/11 06:09:21 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Advection term for u velocity-component using Piacsek and Williams.
+! Vertical advection at the first grid point above the surface is done with
+! normal centred differences, because otherwise no information from the surface
+! would be communicated upwards due to w=0 at K=nzb.
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC advec_u_pw
+
+ INTERFACE advec_u_pw
+ MODULE PROCEDURE advec_u_pw
+ MODULE PROCEDURE advec_u_pw_ij
+ END INTERFACE advec_u_pw
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_u_pw
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: gu, gv
+
+ gu = 2.0 * u_gtrans
+ gv = 2.0 * v_gtrans
+ DO i = nxlu, nxr
+ DO j = nys, nyn
+ DO k = nzb_u_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) - 0.25 * ( &
+ ( u(k,j,i+1) * ( u(k,j,i+1) + u(k,j,i) - gu ) &
+ - u(k,j,i-1) * ( u(k,j,i) + u(k,j,i-1) - gu ) ) * ddx &
+ + ( u(k,j+1,i) * ( v(k,j+1,i) + v(k,j+1,i-1) - gv ) &
+ - u(k,j-1,i) * ( v(k,j,i) + v(k,j,i-1) - gv ) ) * ddy &
+ + ( u(k+1,j,i) * ( w(k,j,i) + w(k,j,i-1) ) &
+ - u(k-1,j,i) * ( w(k-1,j,i) + w(k-1,j,i-1) ) ) &
+ * ddzw(k) &
+ )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE advec_u_pw
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_u_pw_ij( i, j )
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: gu, gv
+
+ gu = 2.0 * u_gtrans
+ gv = 2.0 * v_gtrans
+ DO k = nzb_u_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) - 0.25 * ( &
+ ( u(k,j,i+1) * ( u(k,j,i+1) + u(k,j,i) - gu ) &
+ - u(k,j,i-1) * ( u(k,j,i) + u(k,j,i-1) - gu ) ) * ddx &
+ + ( u(k,j+1,i) * ( v(k,j+1,i) + v(k,j+1,i-1) - gv ) &
+ - u(k,j-1,i) * ( v(k,j,i) + v(k,j,i-1) - gv ) ) * ddy &
+ + ( u(k+1,j,i) * ( w(k,j,i) + w(k,j,i-1) ) &
+ - u(k-1,j,i) * ( w(k-1,j,i) + w(k-1,j,i-1) ) ) &
+ * ddzw(k) &
+ )
+ ENDDO
+
+ END SUBROUTINE advec_u_pw_ij
+
+ END MODULE advec_u_pw_mod
Index: /palm/tags/release-3.4a/SOURCE/advec_u_up.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/advec_u_up.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/advec_u_up.f90 (revision 141)
@@ -0,0 +1,159 @@
+ MODULE advec_u_up_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 106 2007-08-16 14:30:26Z raasch
+! i loop is starting from nxlu (needed for non-cyclic boundary conditions)
+!
+! 75 2007-03-22 09:54:05Z raasch
+! uxrp eliminated
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.12 2006/02/23 09:45:04 raasch
+! nzb_2d replaced by nzb_u_inner
+!
+! Revision 1.1 1997/08/29 08:55:25 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Advection term for the u velocity-component using upstream scheme.
+! NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
+! The same problem occurs for all topography boundaries!
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC advec_u_up
+
+ INTERFACE advec_u_up
+ MODULE PROCEDURE advec_u_up
+ MODULE PROCEDURE advec_u_up_ij
+ END INTERFACE advec_u_up
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_u_up
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL :: ukomp, vkomp, wkomp
+
+
+ DO i = nxlu, nxr
+ DO j = nys, nyn
+ DO k = nzb_u_inner(j,i)+1, nzt
+!
+!-- x-direction
+ ukomp = u(k,j,i) - u_gtrans
+ IF ( ukomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( u(k,j,i) - u(k,j,i-1) ) * ddx
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( u(k,j,i+1) - u(k,j,i) ) * ddx
+ ENDIF
+!
+!-- y-direction
+ vkomp = 0.25 * ( v(k,j,i) + v(k,j+1,i) + &
+ v(k,j,i-1) + v(k,j+1,i-1) ) - v_gtrans
+ IF ( vkomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( u(k,j,i) - u(k,j-1,i) ) * ddy
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( u(k,j+1,i) - u(k,j,i) ) * ddy
+ ENDIF
+!
+!-- z-direction
+ wkomp = 0.25 * ( w(k,j,i) + w(k-1,j,i) + &
+ w(k,j,i-1) + w(k-1,j,i-1) )
+ IF ( wkomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - wkomp * &
+ ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - wkomp * &
+ ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
+ ENDIF
+
+ ENDDO
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE advec_u_up
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_u_up_ij( i, j )
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL :: ukomp, vkomp, wkomp
+
+
+ DO k = nzb_u_inner(j,i)+1, nzt
+!
+!-- x-direction
+ ukomp = u(k,j,i) - u_gtrans
+ IF ( ukomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( u(k,j,i) - u(k,j,i-1) ) * ddx
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( u(k,j,i+1) - u(k,j,i) ) * ddx
+ ENDIF
+!
+!-- y-direction
+ vkomp = 0.25 * ( v(k,j,i) + v(k,j+1,i) + v(k,j,i-1) + v(k,j+1,i-1) &
+ ) - v_gtrans
+ IF ( vkomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( u(k,j,i) - u(k,j-1,i) ) * ddy
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( u(k,j+1,i) - u(k,j,i) ) * ddy
+ ENDIF
+!
+!-- z-direction
+ wkomp = 0.25 * ( w(k,j,i) + w(k-1,j,i) + w(k,j,i-1) + w(k-1,j,i-1) )
+ IF ( wkomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - wkomp * &
+ ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k)
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - wkomp * &
+ ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1)
+ ENDIF
+
+ ENDDO
+
+ END SUBROUTINE advec_u_up_ij
+
+ END MODULE advec_u_up_mod
Index: /palm/tags/release-3.4a/SOURCE/advec_u_ups.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/advec_u_ups.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/advec_u_ups.f90 (revision 141)
@@ -0,0 +1,180 @@
+ SUBROUTINE advec_u_ups
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.6 2004/04/30 08:03:19 raasch
+! Enlarged transposition arrays introduced
+!
+! Revision 1.1 1999/02/05 08:49:08 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Upstream-Spline advection of the u velocity-component. The advection process
+! is divided into three subsequent steps, one for each of the dimensions. The
+! results is stored as a tendency in array tend. The computation of the cubic
+! splines and the possible execution of the Long-filter require that all grid
+! points of the relevant dimension are available. For model runs on more than
+! one PE therefore both the advected and the advecting quantities are
+! transposed accordingly.
+!
+! Internally used arrays:
+! v_ad = scalar quantity to be advected, initialised = u at the beginning,
+! also being used as temporary storage after each time step
+! d = advecting component (u, v, or w)
+!------------------------------------------------------------------------------!
+
+ USE advection
+ USE arrays_3d
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: v_ad
+
+
+ CALL cpu_log( log_point_s(17), 'advec_u_ups', 'start' )
+
+#if defined( __parallel )
+
+!
+!-- Advection of u in x-direction:
+!-- Store u in temporary array v_ad (component to be advected, boundaries
+!-- are not used because they disturb the transposition)
+ ALLOCATE( v_ad(nzb+1:nzta,nys:nyna,nxl:nxra) )
+ v_ad = 0.0
+ v_ad(nzb+1:nzt,nys:nyn,nxl:nxr) = u(nzb+1:nzt,nys:nyn,nxl:nxr)
+
+!
+!-- Enlarge the size of tend, used as a working array for the transpositions
+ IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN
+ DEALLOCATE( tend )
+ ALLOCATE( tend(1:nza,nys:nyna,nxl:nxra) )
+ ENDIF
+
+!
+!-- Transpose the component to be advected: z --> x
+ CALL transpose_zx( v_ad, tend, v_ad, tend, v_ad )
+
+!
+!-- Advecting component (d) = component to be advected (v_ad) (variable d is
+!-- used for storage, because it is the only one having suitable dimensions).
+!-- NOTE: here x is the first dimension and lies completely on the PE.
+ d = v_ad - u_gtrans
+
+#else
+
+!
+!-- Advection of u in x-direction:
+!-- Store u in temporary array v_ad (component to be advected)
+ ALLOCATE( v_ad(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ v_ad(:,:,:) = u(:,:,:)
+
+!
+!-- Advecting component (d) = component to be advected (u) (variable d is used
+!-- for storage, because it is the only one having suitable dimensions. This is
+!-- done for for reasons of compatibility with the parallel part.)
+ d(:,:,:) = u(nzb+1:nzt,nys:nyn,nxl:nxr) - u_gtrans
+
+#endif
+
+!
+!-- Upstream-Spline advection of u in x-direction. Array tend comes out
+!-- as v_ad before the advection step including cyclic boundaries.
+!-- It is needed for the long filter.
+ CALL spline_x( v_ad, d, 'u' )
+
+!
+!-- Advection of u in y-direction:
+!-- advecting component (v) must be averaged out on the u grid
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ d(k,j,i) = 0.25 * ( v(k,j,i-1) + v(k,j+1,i-1) + &
+ v(k,j,i) + v(k,j+1,i) ) - v_gtrans
+ ENDDO
+ ENDDO
+ ENDDO
+
+#if defined( __parallel )
+
+!
+!-- Transpose the advecting component: z --> y
+ CALL transpose_zx( d, tend, d, tend, d )
+ CALL transpose_xy( d, tend, d, tend, d )
+
+!
+!-- Transpose the component to be advected: x --> y
+ CALL transpose_xy( v_ad, tend, v_ad, tend, v_ad )
+
+#endif
+
+!
+!-- Upstream-Spline advection of u in y-direction
+ CALL spline_y( v_ad, d, 'u' )
+
+!
+!-- Advection of u in z-direction:
+!-- the advecting component (w) must be averaged out on the u grid
+!-- (weighted for non-equidistant grid)
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ d(k,j,i) = ( 0.5 * ( w(k,j,i) + w(k,j,i-1) ) * &
+ ( zu(k) - zw(k-1) ) &
+ + 0.5 * ( w(k-1,j,i) + w(k-1,j,i-1) ) * &
+ ( zw(k) - zu(k) ) &
+ ) * ddzw(k)
+ ENDDO
+ ENDDO
+ ENDDO
+
+#if defined( __parallel )
+
+!
+!-- Transpose the component to be advected: y --> z (= y --> x + x --> z)
+ CALL transpose_yx( v_ad, tend, v_ad, tend, v_ad )
+ CALL transpose_xz( v_ad, tend, v_ad, tend, v_ad )
+
+!
+!-- Resize tend to its normal size
+ IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN
+ DEALLOCATE( tend )
+ ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+
+#endif
+
+!
+!-- Upstream-Spline advection of u in z-direction
+ CALL spline_z( v_ad, d, dzu, spl_tri_zu, 'u' )
+
+!
+!-- Compute the tendency term
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ tend(k,j,i) = ( v_ad(k,j,i) - u(k,j,i) ) / dt_3d
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DEALLOCATE( v_ad )
+
+ CALL cpu_log( log_point_s(17), 'advec_u_ups', 'stop' )
+
+ END SUBROUTINE advec_u_ups
Index: /palm/tags/release-3.4a/SOURCE/advec_v_pw.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/advec_v_pw.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/advec_v_pw.f90 (revision 141)
@@ -0,0 +1,116 @@
+ MODULE advec_v_pw_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 106 2007-08-16 14:30:26Z raasch
+! j loop is starting from nysv (needed for non-cyclic boundary conditions)
+!
+! 75 2007-03-22 09:54:05Z raasch
+! vynp eliminated
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.15 2006/02/23 09:46:08 raasch
+! nzb_2d replaced by nzb_v_inner
+!
+! Revision 1.1 1997/08/11 06:09:57 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Advection term for v velocity-component using Piacsek and Williams.
+! Vertical advection at the first grid point above the surface is done with
+! normal centred differences, because otherwise no information from the surface
+! would be communicated upwards due to w=0 at K=nzb.
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC advec_v_pw
+
+ INTERFACE advec_v_pw
+ MODULE PROCEDURE advec_v_pw
+ MODULE PROCEDURE advec_v_pw_ij
+ END INTERFACE advec_v_pw
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_v_pw
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: gu, gv
+
+
+ gu = 2.0 * u_gtrans
+ gv = 2.0 * v_gtrans
+ DO i = nxl, nxr
+ DO j = nysv, nyn
+ DO k = nzb_v_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) - 0.25 * ( &
+ ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu ) &
+ - v(k,j,i-1) * ( u(k,j-1,i) + u(k,j,i) - gu ) ) * ddx &
+ + ( v(k,j+1,i) * ( v(k,j+1,i) + v(k,j,i) - gv ) &
+ - v(k,j-1,i) * ( v(k,j,i) + v(k,j-1,i) - gv ) ) * ddy &
+ + ( v(k+1,j,i) * ( w(k,j-1,i) + w(k,j,i) ) &
+ - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) ) &
+ * ddzw(k) &
+ )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE advec_v_pw
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_v_pw_ij( i, j )
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: gu, gv
+
+
+ gu = 2.0 * u_gtrans
+ gv = 2.0 * v_gtrans
+ DO k = nzb_v_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) - 0.25 * ( &
+ ( v(k,j,i+1) * ( u(k,j-1,i+1) + u(k,j,i+1) - gu ) &
+ - v(k,j,i-1) * ( u(k,j-1,i) + u(k,j,i) - gu ) ) * ddx &
+ + ( v(k,j+1,i) * ( v(k,j+1,i) + v(k,j,i) - gv ) &
+ - v(k,j-1,i) * ( v(k,j,i) + v(k,j-1,i) - gv ) ) * ddy &
+ + ( v(k+1,j,i) * ( w(k,j-1,i) + w(k,j,i) ) &
+ - v(k-1,j,i) * ( w(k-1,j-1,i) + w(k-1,j,i) ) ) &
+ * ddzw(k) &
+ )
+ ENDDO
+
+ END SUBROUTINE advec_v_pw_ij
+
+ END MODULE advec_v_pw_mod
+
Index: /palm/tags/release-3.4a/SOURCE/advec_v_up.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/advec_v_up.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/advec_v_up.f90 (revision 141)
@@ -0,0 +1,158 @@
+ MODULE advec_v_up_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 106 2007-08-16 14:30:26Z raasch
+! j loop is starting from nysv (needed for non-cyclic boundary conditions)
+!
+! 75 2007-03-22 09:54:05Z raasch
+! vynp eliminated
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.12 2006/02/23 09:46:37 raasch
+! nzb_2d replaced by nzb_v_inner
+!
+! Revision 1.1 1997/08/29 08:56:05 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Advection term for the v velocity-component using upstream scheme.
+! NOTE: vertical advection at k=1 still has wrong grid spacing for w>0!
+! The same problem occurs for all topography boundaries!
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC advec_v_up
+
+ INTERFACE advec_v_up
+ MODULE PROCEDURE advec_v_up
+ MODULE PROCEDURE advec_v_up_ij
+ END INTERFACE advec_v_up
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_v_up
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: ukomp, vkomp, wkomp
+
+
+ DO i = nxl, nxr
+ DO j = nysv, nyn
+ DO k = nzb_v_inner(j,i)+1, nzt
+!
+!-- x-direction
+ ukomp = 0.25 * ( u(k,j,i) + u(k,j-1,i) + &
+ u(k,j,i+1) + u(k,j-1,i+1) ) - u_gtrans
+ IF ( ukomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( v(k,j,i) - v(k,j,i-1) ) * ddx
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( v(k,j,i+1) - v(k,j,i) ) * ddx
+ ENDIF
+!
+!-- y-direction
+ vkomp = v(k,j,i) - v_gtrans
+ IF ( vkomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( v(k,j,i) - v(k,j-1,i) ) * ddy
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( v(k,j+1,i) - v(k,j,i) ) * ddy
+ ENDIF
+!
+!-- z-direction
+ wkomp = 0.25 * ( w(k,j,i) + w(k-1,j,i) + &
+ w(k,j-1,i) + w(k-1,j-1,i) )
+ IF ( wkomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - wkomp * &
+ ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k)
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - wkomp * &
+ ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)
+ ENDIF
+
+ ENDDO
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE advec_v_up
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_v_up_ij( i, j )
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL :: ukomp, vkomp, wkomp
+
+
+ DO k = nzb_v_inner(j,i)+1, nzt
+!
+!-- x-direction
+ ukomp = 0.25 * ( u(k,j,i) + u(k,j-1,i) + u(k,j,i+1) + u(k,j-1,i+1) &
+ ) - u_gtrans
+ IF ( ukomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( v(k,j,i) - v(k,j,i-1) ) * ddx
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( v(k,j,i+1) - v(k,j,i) ) * ddx
+ ENDIF
+!
+!-- y-direction
+ vkomp = v(k,j,i) - v_gtrans
+ IF ( vkomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( v(k,j,i) - v(k,j-1,i) ) * ddy
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( v(k,j+1,i) - v(k,j,i) ) * ddy
+ ENDIF
+!
+!-- z-direction
+ wkomp = 0.25 * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) )
+ IF ( wkomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - wkomp * &
+ ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k)
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - wkomp * &
+ ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1)
+ ENDIF
+
+ ENDDO
+
+ END SUBROUTINE advec_v_up_ij
+
+ END MODULE advec_v_up_mod
Index: /palm/tags/release-3.4a/SOURCE/advec_v_ups.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/advec_v_ups.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/advec_v_ups.f90 (revision 141)
@@ -0,0 +1,181 @@
+ SUBROUTINE advec_v_ups
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.7 2004/04/30 08:03:52 raasch
+! Enlarged transposition arrays introduced
+!
+! Revision 1.1 1999/02/05 08:50:32 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Upstream-Spline advection of the v velocity-component. The advection process
+! is divided into three subsequent steps, one for each of the dimensions. The
+! result is stored as a tendency in array tend. The computation of the cubic
+! splines and the possible execution of the Long-filter require that all grid
+! points of the relevant dimension are available. For model runs on more than
+! one PE therefore both the advected and the advecting quantities are
+! transposed accordingly.
+!
+! Internally used arrays:
+! v_ad = scalar quantity to be advected, initialised = v at the beginning,
+! also being used as temporary storage after each time step
+! d = advecting component (u, v, or w)
+!------------------------------------------------------------------------------!
+
+ USE advection
+ USE arrays_3d
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: v_ad
+
+
+ CALL cpu_log( log_point_s(18), 'advec_v_ups', 'start' )
+
+#if defined( __parallel )
+
+!
+!-- Advection of v in x-direction:
+!-- Store v in temporary array v_ad (component to be advected, boundaries
+!-- are not used because they disturb the transposition)
+ ALLOCATE( v_ad(nzb+1:nzta,nys:nyna,nxl:nxra) )
+ v_ad = 0.0
+ v_ad(nzb+1:nzt,nys:nyn,nxl:nxr) = v(nzb+1:nzt,nys:nyn,nxl:nxr)
+
+!
+!-- Enlarge the size of tend, used as a working array for the transpositions
+ IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN
+ DEALLOCATE( tend )
+ ALLOCATE( tend(1:nza,nys:nyna,nxl:nxra) )
+ ENDIF
+
+!
+!-- Transpose the component to be advected: z --> x
+ CALL transpose_zx( v_ad, tend, v_ad, tend, v_ad )
+
+#else
+
+!
+!-- Advection of v in x-direction:
+!-- Store v in temporary array v_ad (component to be advected)
+ ALLOCATE( v_ad(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ v_ad(:,:,:) = v(:,:,:)
+
+#endif
+
+!
+!-- Advecting component (u) must be averaged out on the v grid
+ d = 0.0
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ d(k,j,i) = 0.25 * ( u(k,j-1,i) + u(k,j-1,i+1) + &
+ u(k,j,i+1) + u(k,j,i) ) - u_gtrans
+ ENDDO
+ ENDDO
+ ENDDO
+
+#if defined( __parallel )
+
+!
+!-- Transpose the advecting component: z --> x
+ CALL transpose_zx( d, tend, d, tend, d )
+
+#endif
+
+!
+!-- Upstream-Spline advection of v in x-direction. Array tend comes out
+!-- as v_ad before the advection step including cyclic boundaries.
+!-- It is needed for the long filter.
+ CALL spline_x( v_ad, d, 'v' )
+
+!
+!-- Advection of v in y-direction:
+!-- advecting component (d) = component to be advected (v)
+ d(nzb+1:nzt,nys:nyn,nxl:nxr) = v(nzb+1:nzt,nys:nyn,nxl:nxr) - v_gtrans
+
+#if defined( __parallel )
+
+!
+!-- Transpose the advecting component: z --> y
+ CALL transpose_zx( d, tend, d, tend, d )
+ CALL transpose_xy( d, tend, d, tend, d )
+
+!
+!-- Transpose the component to be advected: x --> y
+ CALL transpose_xy( v_ad, tend, v_ad, tend, v_ad )
+
+#endif
+
+!
+!-- Upstream-Spline advection of v in y-direction
+ CALL spline_y( v_ad, d, 'v' )
+
+!
+!-- Advection of v in z-direction:
+!-- the advecting component (w) must be averaged out on the v grid
+!-- (weighted for non-equidistant grid)
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ d(k,j,i) = ( 0.5 * ( w(k-1,j-1,i) + w(k-1,j,i) ) * &
+ ( zw(k) - zu(k) ) + &
+ 0.5 * ( w(k,j,i) + w(k,j-1,i) ) * &
+ ( zu(k) - zw(k-1) ) &
+ ) * ddzw(k)
+ ENDDO
+ ENDDO
+ ENDDO
+
+#if defined( __parallel )
+
+!
+!-- Transpose the component to be advected: y --> z (= y --> x + x --> z)
+ CALL transpose_yx( v_ad, tend, v_ad, tend, v_ad )
+ CALL transpose_xz( v_ad, tend, v_ad, tend, v_ad )
+
+!
+!-- Resize tend to its normal size
+ IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN
+ DEALLOCATE( tend )
+ ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+
+#endif
+
+!
+!-- Upstream-Spline advection of v in z-direction
+ CALL spline_z( v_ad, d, dzu, spl_tri_zu, 'v' )
+
+!
+!-- Compute the tendency term
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ tend(k,j,i) = ( v_ad(k,j,i) - v(k,j,i) ) / dt_3d
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DEALLOCATE( v_ad )
+
+ CALL cpu_log( log_point_s(18), 'advec_v_ups', 'stop' )
+
+ END SUBROUTINE advec_v_ups
Index: /palm/tags/release-3.4a/SOURCE/advec_w_pw.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/advec_w_pw.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/advec_w_pw.f90 (revision 141)
@@ -0,0 +1,108 @@
+ MODULE advec_w_pw_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.15 2006/02/23 09:47:01 raasch
+! nzb_2d replaced by nzb_w_inner
+!
+! Revision 1.1 1997/08/11 06:10:29 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Advection term for w velocity-component using Piacsek and Williams.
+! Vertical advection at the first grid point above the surface is done with
+! normal centred differences, because otherwise no information from the surface
+! would be communicated upwards due to w=0 at k=nzb.
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC advec_w_pw
+
+ INTERFACE advec_w_pw
+ MODULE PROCEDURE advec_w_pw
+ MODULE PROCEDURE advec_w_pw_ij
+ END INTERFACE advec_w_pw
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_w_pw
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: gu, gv
+
+
+ gu = 2.0 * u_gtrans
+ gv = 2.0 * v_gtrans
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_w_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) - 0.25 * ( &
+ ( w(k,j,i+1) * ( u(k+1,j,i+1) + u(k,j,i+1) - gu ) &
+ - w(k,j,i-1) * ( u(k+1,j,i) + u(k,j,i) - gu ) ) * ddx &
+ + ( w(k,j+1,i) * ( v(k+1,j+1,i) + v(k,j+1,i) - gv ) &
+ - w(k,j-1,i) * ( v(k+1,j,i) + v(k,j,i) - gv ) ) * ddy &
+ + ( w(k+1,j,i) * ( w(k+1,j,i) + w(k,j,i) ) &
+ - w(k-1,j,i) * ( w(k,j,i) + w(k-1,j,i) ) ) &
+ * ddzu(k+1) &
+ )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE advec_w_pw
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_w_pw_ij( i, j )
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: gu, gv
+
+
+ gu = 2.0 * u_gtrans
+ gv = 2.0 * v_gtrans
+ DO k = nzb_w_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) - 0.25 * ( &
+ ( w(k,j,i+1) * ( u(k+1,j,i+1) + u(k,j,i+1) - gu ) &
+ - w(k,j,i-1) * ( u(k+1,j,i) + u(k,j,i) - gu ) ) * ddx &
+ + ( w(k,j+1,i) * ( v(k+1,j+1,i) + v(k,j+1,i) - gv ) &
+ - w(k,j-1,i) * ( v(k+1,j,i) + v(k,j,i) - gv ) ) * ddy &
+ + ( w(k+1,j,i) * ( w(k+1,j,i) + w(k,j,i) ) &
+ - w(k-1,j,i) * ( w(k,j,i) + w(k-1,j,i) ) ) &
+ * ddzu(k+1) &
+ )
+ ENDDO
+
+ END SUBROUTINE advec_w_pw_ij
+
+ END MODULE advec_w_pw_mod
Index: /palm/tags/release-3.4a/SOURCE/advec_w_up.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/advec_w_up.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/advec_w_up.f90 (revision 141)
@@ -0,0 +1,149 @@
+ MODULE advec_w_up_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.11 2006/02/23 09:47:23 raasch
+! *** empty log message ***
+!
+! Revision 1.1 1997/08/29 08:56:33 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Advection term for the w velocity-component using upstream scheme.
+! NOTE: vertical advection at k=1 still has wrong grid spacing for w>0
+! The same problem occurs for all topography boundaries!
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC advec_w_up
+
+ INTERFACE advec_w_up
+ MODULE PROCEDURE advec_w_up
+ MODULE PROCEDURE advec_w_up_ij
+ END INTERFACE advec_w_up
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_w_up
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: ukomp, vkomp
+
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_w_inner(j,i)+1, nzt-1
+!
+!-- x-direction
+ ukomp = 0.25 * ( u(k,j,i) + u(k,j,i+1) + &
+ u(k+1,j,i) + u(k+1,j,i+1) ) - u_gtrans
+ IF ( ukomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( w(k,j,i) - w(k,j,i-1) ) * ddx
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( w(k,j,i+1) - w(k,j,i) ) * ddx
+ ENDIF
+!
+!-- y-direction
+ vkomp = 0.25 * ( v(k,j,i) + v(k,j+1,i) + &
+ v(k+1,j,i) + v(k+1,j+1,i) ) - v_gtrans
+ IF ( vkomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( w(k,j,i) - w(k,j-1,i) ) * ddy
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( w(k,j+1,i) - w(k,j,i) ) * ddy
+ ENDIF
+!
+!-- z-direction
+ IF ( w(k,j,i) > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
+ ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
+ ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)
+ ENDIF
+
+ ENDDO
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE advec_w_up
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE advec_w_up_ij( i, j )
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: ukomp, vkomp
+
+
+ DO k = nzb_w_inner(j,i)+1, nzt-1
+!
+!-- x-direction
+ ukomp = 0.25 * ( u(k,j,i) + u(k,j,i+1) + u(k+1,j,i) + u(k+1,j,i+1) &
+ ) - u_gtrans
+ IF ( ukomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( w(k,j,i) - w(k,j,i-1) ) * ddx
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - ukomp * &
+ ( w(k,j,i+1) - w(k,j,i) ) * ddx
+ ENDIF
+!
+!-- y-direction
+ vkomp = 0.25 * ( v(k,j,i) + v(k,j+1,i) + v(k+1,j,i) + v(k+1,j+1,i) &
+ ) - v_gtrans
+ IF ( vkomp > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( w(k,j,i) - w(k,j-1,i) ) * ddy
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - vkomp * &
+ ( w(k,j+1,i) - w(k,j,i) ) * ddy
+ ENDIF
+!
+!-- z-direction
+ IF ( w(k,j,i) > 0.0 ) THEN
+ tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
+ ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+ ELSE
+ tend(k,j,i) = tend(k,j,i) - w(k,j,i) * &
+ ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1)
+ ENDIF
+
+ ENDDO
+
+ END SUBROUTINE advec_w_up_ij
+
+ END MODULE advec_w_up_mod
Index: /palm/tags/release-3.4a/SOURCE/advec_w_ups.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/advec_w_ups.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/advec_w_ups.f90 (revision 141)
@@ -0,0 +1,177 @@
+ SUBROUTINE advec_w_ups
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.6 2004/04/30 08:05:05 raasch
+! Enlarged transposition arrays introduced
+!
+! Revision 1.1 1999/02/05 08:52:09 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Upstream-Spline advection of the w velocity-component. The advection process
+! is divided into three subsequent steps, one for each of the dimensions. The
+! result is stored as a tendency in array tend. The computation of the cubic
+! splines and the possible execution of the Long-filter require that all grid
+! points of the relevant dimension are available. For model runs on more than
+! one PE therefore both the advected and the advecting quantities are
+! transposed accordingly.
+!
+! Internally used arrays:
+! v_ad = scalar quantity to be advected, initialised = w at the beginning, also
+! being used as temporary storage after each time step
+! d = advecting component (u, v, or w)
+!------------------------------------------------------------------------------!
+
+ USE advection
+ USE arrays_3d
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ INTEGER :: i,j,k
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: v_ad
+
+
+ CALL cpu_log( log_point_s(19), 'advec_w_ups', 'start' )
+
+#if defined( __parallel )
+
+!
+!-- Advection of w in x-direction:
+!-- Store w in temporary array v_ad (component to be advected, boundaries
+!-- are not used because they disturb the transposition)
+ ALLOCATE( v_ad(nzb+1:nzta,nys:nyna,nxl:nxra) )
+ v_ad = 0.0
+ v_ad(nzb+1:nzt,nys:nyn,nxl:nxr) = w(nzb+1:nzt,nys:nyn,nxl:nxr)
+
+!
+!-- Enlarge the size of tend, used as a working array for the transpositions
+ IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN
+ DEALLOCATE( tend )
+ ALLOCATE( tend(1:nza,nys:nyna,nxl:nxra) )
+ ENDIF
+
+!
+!-- Transpose the component to be advected: z --> x
+ CALL transpose_zx( v_ad, tend, v_ad, tend, v_ad )
+
+#else
+
+!
+!-- Advection of w in x-direction:
+!-- Store w in temporary array v_ad (component to be advected)
+ ALLOCATE( v_ad(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ v_ad(:,:,:) = w(:,:,:)
+
+#endif
+
+!
+!-- Advecting component (u) must be averaged out on the w grid
+ d = 0.0
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ d(k,j,i) = 0.25 * ( u(k,j,i) + u(k,j,i+1) + &
+ u(k+1,j,i+1) + u(k+1,j,i) ) - u_gtrans
+ ENDDO
+ ENDDO
+ ENDDO
+
+#if defined( __parallel )
+
+!
+!-- Transpose the component to be advected: z --> x
+ CALL transpose_zx( d, tend, d, tend, d )
+
+#endif
+
+!
+!-- Upstream-Spline advection of w in x-direction. Array tend comes out
+!-- as v_ad before the advection step including cyclic boundaries.
+!-- It is needed for the long filter.
+ CALL spline_x( v_ad, d, 'w' )
+
+!
+!-- Advection of w in y-direction:
+!-- advecting component (v) must be averaged out on the w grid
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ d(k,j,i) = 0.25 * ( v(k,j,i) + v(k,j+1,i) + &
+ v(k+1,j+1,i) + v(k+1,j,i) ) - v_gtrans
+ ENDDO
+ ENDDO
+ ENDDO
+
+#if defined( __parallel )
+
+!
+!-- Transpose the advecting component: z --> y
+ CALL transpose_zx( d, tend, d, tend, d )
+ CALL transpose_xy( d, tend, d, tend, d )
+
+!
+!-- Transpose the component to be advected: x --> y
+ CALL transpose_xy( v_ad, tend, v_ad, tend, v_ad )
+
+#endif
+
+!
+!-- Upstream-Spline advection of w in y-direction
+ CALL spline_y( v_ad, d, 'w' )
+
+!
+!-- Advection of w in z-direction:
+!-- advecting component (d) = component to be advected (v_ad)
+ d(nzb+1:nzt,nys:nyn,nxl:nxr) = w(nzb+1:nzt,nys:nyn,nxl:nxr)
+
+#if defined( __parallel )
+
+!
+!-- Transpose the component to be advected: y --> z (= y --> x + x --> z)
+ CALL transpose_yx( v_ad, tend, v_ad, tend, v_ad )
+ CALL transpose_xz( v_ad, tend, v_ad, tend, v_ad )
+
+!
+!-- Resize tend to its normal size
+ IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN
+ DEALLOCATE( tend )
+ ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+
+#endif
+
+!
+!-- Upstream-Spline advection of w in z-direction
+ CALL spline_z( v_ad, d, dzw, spl_tri_zw, 'w' )
+
+!
+!-- Compute the tendency term
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ tend(k,j,i) = ( v_ad(k,j,i) - w(k,j,i) ) / dt_3d
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DEALLOCATE( v_ad )
+
+ CALL cpu_log( log_point_s(19), 'advec_w_ups', 'stop' )
+
+ END SUBROUTINE advec_w_ups
Index: /palm/tags/release-3.4a/SOURCE/asselin_filter.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/asselin_filter.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/asselin_filter.f90 (revision 141)
@@ -0,0 +1,110 @@
+ SUBROUTINE asselin_filter
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! ---------------------
+! $Id$
+!
+! 75 2007-03-22 09:54:05Z raasch
+! moisture renamed humidity
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.8 2004/01/30 10:14:02 raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.1 2002/05/02 13:43:53 13:43:53 raasch (Siegfried Raasch)
+! Initial revision
+!
+!
+! Description:
+! -------------
+! Time filter needed for the leap-frog method
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+
+ CALL cpu_log( log_point(9), 'timefilter', 'start' )
+
+!
+!-- Return to the calling routine, if time filter is not to be applied
+ IF ( asselin_filter_factor == 0.0 ) RETURN
+
+!
+!-- Apply the time filter
+#if defined( __ibm )
+!$OMP PARALLEL PRIVATE (i,j,k)
+!$OMP DO
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+
+ DO k = nzb_2d(j,i), nzt+1
+ u(k,j,i) = u(k,j,i) + asselin_filter_factor * &
+ ( u_p(k,j,i) - 2.0 * u(k,j,i) + u_m(k,j,i) )
+ v(k,j,i) = v(k,j,i) + asselin_filter_factor * &
+ ( v_p(k,j,i) - 2.0 * v(k,j,i) + v_m(k,j,i) )
+ w(k,j,i) = w(k,j,i) + asselin_filter_factor * &
+ ( w_p(k,j,i) - 2.0 * w(k,j,i) + w_m(k,j,i) )
+ ENDDO
+
+ IF ( scalar_advec /= 'bc-scheme' ) THEN
+ DO k = nzb_2d(j,i), nzt+1
+ pt(k,j,i) = pt(k,j,i) + asselin_filter_factor * &
+ ( pt_p(k,j,i) - 2.0 * pt(k,j,i) + pt_m(k,j,i) )
+ ENDDO
+ ENDIF
+
+ IF ( .NOT. constant_diffusion .AND. scalar_advec /= 'bc-scheme' ) &
+ THEN
+ DO k = nzb_2d(j,i), nzt+1
+ e(k,j,i) = e(k,j,i) + asselin_filter_factor * &
+ ( e_p(k,j,i) - 2.0 * e(k,j,i) + e_m(k,j,i) )
+ ENDDO
+ ENDIF
+
+ IF ( ( humidity .OR. passive_scalar ) .AND. &
+ scalar_advec /= 'bc-scheme' ) THEN
+ DO k = nzb_2d(j,i), nzt+1
+ q(k,j,i) = q(k,j,i) + asselin_filter_factor * &
+ ( q_p(k,j,i) - 2.0 * q(k,j,i) + q_m(k,j,i) )
+ ENDDO
+ ENDIF
+
+ ENDDO
+ ENDDO
+!$OMP END PARALLEL
+#else
+ u = u + asselin_filter_factor * ( u_p - 2.0 * u + u_m )
+ v = v + asselin_filter_factor * ( v_p - 2.0 * v + v_m )
+ w = w + asselin_filter_factor * ( w_p - 2.0 * w + w_m )
+
+ IF ( scalar_advec /= 'bc-scheme' ) THEN
+ pt = pt + asselin_filter_factor * ( pt_p - 2.0 * pt + pt_m )
+ ENDIF
+
+ IF ( .NOT. constant_diffusion .AND. scalar_advec /= 'bc-scheme' ) THEN
+ e = e + asselin_filter_factor * ( e_p - 2.0 * e + e_m )
+ ENDIF
+
+ IF ( ( humidity .OR. passive_scalar ) .AND. &
+ scalar_advec /= 'bc-scheme' ) THEN
+ q = q + asselin_filter_factor * ( q_p - 2.0 * q + q_m )
+ ENDIF
+#endif
+
+ CALL cpu_log( log_point(9), 'timefilter', 'stop' )
+
+ END SUBROUTINE asselin_filter
Index: /palm/tags/release-3.4a/SOURCE/average_3d_data.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/average_3d_data.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/average_3d_data.f90 (revision 141)
@@ -0,0 +1,271 @@
+ SUBROUTINE average_3d_data
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 96 2007-06-04 08:07:41Z raasch
+! Averaging of density and salinity
+!
+! 72 2007-03-19 08:20:46Z raasch
+! Averaging the precipitation rate and roughness length (prr*, z0*)
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.1 2006/02/23 09:48:58 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Time-averaging of 3d-data-arrays.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE averaging
+ USE cloud_parameters
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+
+ IMPLICIT NONE
+
+ INTEGER :: i, ii, j, k
+
+
+ CALL cpu_log (log_point(35),'average_3d_data','start')
+
+!
+!-- Check, if averaging is necessary
+ IF ( average_count_3d <= 1 ) RETURN
+
+!
+!-- Loop of all variables to be averaged.
+ DO ii = 1, doav_n
+
+!
+!-- Store the array chosen on the temporary array.
+ SELECT CASE ( TRIM( doav(ii) ) )
+
+ CASE ( 'e' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ e_av(k,j,i) = e_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'lwp*' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ lwp_av(j,i) = lwp_av(j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+
+ CASE ( 'p' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ p_av(k,j,i) = p_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'pc' )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb, nzt+1
+ pc_av(k,j,i) = pc_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'pr' )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb, nzt+1
+ pr_av(k,j,i) = pr_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'prr*' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ precipitation_rate_av(j,i) = precipitation_rate_av(j,i) / &
+ REAL( average_count_3d )
+ ENDDO
+ ENDDO
+
+ CASE ( 'pt' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ pt_av(k,j,i) = pt_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'q' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ q_av(k,j,i) = q_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'ql' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ ql_av(k,j,i) = ql_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'ql_c' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ ql_c_av(k,j,i) = ql_c_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'ql_v' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ ql_v_av(k,j,i) = ql_v_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'ql_vp' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ ql_vp_av(k,j,i) = ql_vp_av(k,j,i) / &
+ REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'qv' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ qv_av(k,j,i) = qv_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'rho' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ rho_av(k,j,i) = rho_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 's' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ s_av(k,j,i) = s_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'sa' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ sa_av(k,j,i) = sa_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 't*' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ ts_av(j,i) = ts_av(j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+
+ CASE ( 'u' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ u_av(k,j,i) = u_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'u*' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ us_av(j,i) = us_av(j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+
+ CASE ( 'v' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ v_av(k,j,i) = v_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'vpt' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ vpt_av(k,j,i) = vpt_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'w' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ w_av(k,j,i) = w_av(k,j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'z0*' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ z0_av(j,i) = z0_av(j,i) / REAL( average_count_3d )
+ ENDDO
+ ENDDO
+
+ CASE DEFAULT
+!
+!-- User-defined quantity
+ CALL user_3d_data_averaging( 'average', doav(ii) )
+
+ END SELECT
+
+ ENDDO
+
+!
+!-- Reset the counter
+ average_count_3d = 0.0
+
+ CALL cpu_log (log_point(35),'average_3d_data','stop','nobarrier')
+
+
+ END SUBROUTINE average_3d_data
Index: /palm/tags/release-3.4a/SOURCE/boundary_conds.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/boundary_conds.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/boundary_conds.f90 (revision 141)
@@ -0,0 +1,617 @@
+ SUBROUTINE boundary_conds( range )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 107 2007-08-17 13:54:45Z raasch
+! Boundary conditions for temperature adjusted for coupled runs,
+! bugfixes for the radiation boundary conditions at the outflow: radiation
+! conditions are used for every substep, phase speeds are calculated for the
+! first Runge-Kutta substep only and then reused, several index values changed
+!
+! 95 2007-06-02 16:48:38Z raasch
+! Boundary conditions for salinity added
+!
+! 75 2007-03-22 09:54:05Z raasch
+! The "main" part sets conditions for time level t+dt instead of level t,
+! outflow boundary conditions changed from Neumann to radiation condition,
+! uxrp, vynp eliminated, moisture renamed humidity
+!
+! 19 2007-02-23 04:53:48Z raasch
+! Boundary conditions for e(nzt), pt(nzt), and q(nzt) removed because these
+! gridpoints are now calculated by the prognostic equation,
+! Dirichlet and zero gradient condition for pt established at top boundary
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.15 2006/02/23 09:54:55 raasch
+! Surface boundary conditions in case of topography: nzb replaced by
+! 2d-k-index-arrays (nzb_w_inner, etc.). Conditions for u and v remain
+! unchanged (still using nzb) because a non-flat topography must use a
+! Prandtl-layer, which don't requires explicit setting of the surface values.
+!
+! Revision 1.1 1997/09/12 06:21:34 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Boundary conditions for the prognostic quantities (range='main').
+! In case of non-cyclic lateral boundaries the conditions for velocities at
+! the outflow are set after the pressure solver has been called (range=
+! 'outflow_uvw').
+! One additional bottom boundary condition is applied for the TKE (=(u*)**2)
+! in prandtl_fluxes. The cyclic lateral boundary conditions are implicitly
+! handled in routine exchange_horiz. Pressure boundary conditions are
+! explicitly set in routines pres, poisfft, poismg and sor.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE pegrid
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: range
+
+ INTEGER :: i, j, k
+
+ REAL :: c_max, denom
+
+
+ IF ( range == 'main') THEN
+!
+!-- Bottom boundary
+ IF ( ibc_uv_b == 0 ) THEN
+!
+!-- Satisfying the Dirichlet condition with an extra layer below the
+!-- surface where the u and v component change their sign
+ u_p(nzb,:,:) = -u_p(nzb+1,:,:)
+ v_p(nzb,:,:) = -v_p(nzb+1,:,:)
+ ELSE
+ u_p(nzb,:,:) = u_p(nzb+1,:,:)
+ v_p(nzb,:,:) = v_p(nzb+1,:,:)
+ ENDIF
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ w_p(nzb_w_inner(j,i),j,i) = 0.0
+ ENDDO
+ ENDDO
+
+!
+!-- Top boundary
+ IF ( ibc_uv_t == 0 ) THEN
+ u_p(nzt+1,:,:) = ug(nzt+1)
+ v_p(nzt+1,:,:) = vg(nzt+1)
+ ELSE
+ u_p(nzt+1,:,:) = u_p(nzt,:,:)
+ v_p(nzt+1,:,:) = v_p(nzt,:,:)
+ ENDIF
+ w_p(nzt:nzt+1,:,:) = 0.0 ! nzt is not a prognostic level (but cf. pres)
+
+!
+!-- Temperature at bottom boundary.
+!-- In case of coupled runs (ibc_pt_b = 2) the temperature is given by
+!-- the sea surface temperature of the coupled ocean model.
+ IF ( ibc_pt_b == 0 ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ pt_p(nzb_s_inner(j,i),j,i) = pt(nzb_s_inner(j,i),j,i)
+ ENDDO
+ ENDDO
+ ELSEIF ( ibc_pt_b == 1 ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ pt_p(nzb_s_inner(j,i),j,i) = pt_p(nzb_s_inner(j,i)+1,j,i)
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Temperature at top boundary
+ IF ( ibc_pt_t == 0 ) THEN
+ pt_p(nzt+1,:,:) = pt(nzt+1,:,:)
+ ELSEIF ( ibc_pt_t == 1 ) THEN
+ pt_p(nzt+1,:,:) = pt_p(nzt,:,:)
+ ELSEIF ( ibc_pt_t == 2 ) THEN
+ pt_p(nzt+1,:,:) = pt_p(nzt,:,:) + bc_pt_t_val * dzu(nzt+1)
+ ENDIF
+
+!
+!-- Boundary conditions for TKE
+!-- Generally Neumann conditions with de/dz=0 are assumed
+ IF ( .NOT. constant_diffusion ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ e_p(nzb_s_inner(j,i),j,i) = e_p(nzb_s_inner(j,i)+1,j,i)
+ ENDDO
+ ENDDO
+ e_p(nzt+1,:,:) = e_p(nzt,:,:)
+ ENDIF
+
+!
+!-- Boundary conditions for salinity
+ IF ( ocean ) THEN
+!
+!-- Bottom boundary: Neumann condition because salinity flux is always
+!-- given
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ sa_p(nzb_s_inner(j,i),j,i) = sa_p(nzb_s_inner(j,i)+1,j,i)
+ ENDDO
+ ENDDO
+
+!
+!-- Top boundary: Dirichlet or Neumann
+ IF ( ibc_sa_t == 0 ) THEN
+ sa_p(nzt+1,:,:) = sa(nzt+1,:,:)
+ ELSEIF ( ibc_sa_t == 1 ) THEN
+ sa_p(nzt+1,:,:) = sa_p(nzt,:,:)
+ ENDIF
+
+ ENDIF
+
+!
+!-- Boundary conditions for total water content or scalar,
+!-- bottom and top boundary (see also temperature)
+ IF ( humidity .OR. passive_scalar ) THEN
+!
+!-- Surface conditions for constant_humidity_flux
+ IF ( ibc_q_b == 0 ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ q_p(nzb_s_inner(j,i),j,i) = q(nzb_s_inner(j,i),j,i)
+ ENDDO
+ ENDDO
+ ELSE
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ q_p(nzb_s_inner(j,i),j,i) = q_p(nzb_s_inner(j,i)+1,j,i)
+ ENDDO
+ ENDDO
+ ENDIF
+!
+!-- Top boundary
+ q_p(nzt+1,:,:) = q_p(nzt,:,:) + bc_q_t_val * dzu(nzt+1)
+ ENDIF
+
+!
+!-- Lateral boundary conditions at the inflow. Quasi Neumann conditions
+!-- are needed for the wall normal velocity in order to ensure zero
+!-- divergence. Dirichlet conditions are used for all other quantities.
+ IF ( inflow_s ) THEN
+ v_p(:,nys,:) = v_p(:,nys-1,:)
+ ELSEIF ( inflow_n ) THEN
+ v_p(:,nyn,:) = v_p(:,nyn+1,:)
+ ELSEIF ( inflow_l ) THEN
+ u_p(:,:,nxl) = u_p(:,:,nxl-1)
+ ELSEIF ( inflow_r ) THEN
+ u_p(:,:,nxr) = u_p(:,:,nxr+1)
+ ENDIF
+
+!
+!-- Lateral boundary conditions for scalar quantities at the outflow
+ IF ( outflow_s ) THEN
+ pt_p(:,nys-1,:) = pt_p(:,nys,:)
+ IF ( .NOT. constant_diffusion ) e_p(:,nys-1,:) = e_p(:,nys,:)
+ IF ( humidity .OR. passive_scalar ) q_p(:,nys-1,:) = q_p(:,nys,:)
+ ELSEIF ( outflow_n ) THEN
+ pt_p(:,nyn+1,:) = pt_p(:,nyn,:)
+ IF ( .NOT. constant_diffusion ) e_p(:,nyn+1,:) = e_p(:,nyn,:)
+ IF ( humidity .OR. passive_scalar ) q_p(:,nyn+1,:) = q_p(:,nyn,:)
+ ELSEIF ( outflow_l ) THEN
+ pt_p(:,:,nxl-1) = pt_p(:,:,nxl)
+ IF ( .NOT. constant_diffusion ) e_p(:,:,nxl-1) = e_p(:,:,nxl)
+ IF ( humidity .OR. passive_scalar ) q_p(:,:,nxl-1) = q_p(:,:,nxl)
+ ELSEIF ( outflow_r ) THEN
+ pt_p(:,:,nxr+1) = pt_p(:,:,nxr)
+ IF ( .NOT. constant_diffusion ) e_p(:,:,nxr+1) = e_p(:,:,nxr)
+ IF ( humidity .OR. passive_scalar ) q_p(:,:,nxr+1) = q_p(:,:,nxr)
+ ENDIF
+
+ ENDIF
+
+!
+!-- Radiation boundary condition for the velocities at the respective outflow
+ IF ( outflow_s ) THEN
+
+ c_max = dy / dt_3d
+
+ DO i = nxl-1, nxr+1
+ DO k = nzb+1, nzt+1
+
+!
+!-- Calculate the phase speeds for u,v, and w. In case of using a
+!-- Runge-Kutta scheme, do this for the first substep only and then
+!-- reuse this values for the further substeps.
+ IF ( intermediate_timestep_count == 1 ) THEN
+
+ denom = u_m_s(k,0,i) - u_m_s(k,1,i)
+
+ IF ( denom /= 0.0 ) THEN
+ c_u(k,i) = -c_max * ( u(k,0,i) - u_m_s(k,0,i) ) / denom
+ IF ( c_u(k,i) < 0.0 ) THEN
+ c_u(k,i) = 0.0
+ ELSEIF ( c_u(k,i) > c_max ) THEN
+ c_u(k,i) = c_max
+ ENDIF
+ ELSE
+ c_u(k,i) = c_max
+ ENDIF
+
+ denom = v_m_s(k,1,i) - v_m_s(k,2,i)
+
+ IF ( denom /= 0.0 ) THEN
+ c_v(k,i) = -c_max * ( v(k,1,i) - v_m_s(k,1,i) ) / denom
+ IF ( c_v(k,i) < 0.0 ) THEN
+ c_v(k,i) = 0.0
+ ELSEIF ( c_v(k,i) > c_max ) THEN
+ c_v(k,i) = c_max
+ ENDIF
+ ELSE
+ c_v(k,i) = c_max
+ ENDIF
+
+ denom = w_m_s(k,0,i) - w_m_s(k,1,i)
+
+ IF ( denom /= 0.0 ) THEN
+ c_w(k,i) = -c_max * ( w(k,0,i) - w_m_s(k,0,i) ) / denom
+ IF ( c_w(k,i) < 0.0 ) THEN
+ c_w(k,i) = 0.0
+ ELSEIF ( c_w(k,i) > c_max ) THEN
+ c_w(k,i) = c_max
+ ENDIF
+ ELSE
+ c_w(k,i) = c_max
+ ENDIF
+
+!
+!-- Save old timelevels for the next timestep
+ u_m_s(k,:,i) = u(k,0:1,i)
+ v_m_s(k,:,i) = v(k,1:2,i)
+ w_m_s(k,:,i) = w(k,0:1,i)
+
+ ENDIF
+
+!
+!-- Calculate the new velocities
+ u_p(k,-1,i) = u(k,-1,i) - dt_3d * tsc(2) * c_u(k,i) * &
+ ( u(k,-1,i) - u(k,0,i) ) * ddy
+
+ v_p(k,0,i) = v(k,0,i) - dt_3d * tsc(2) * c_v(k,i) * &
+ ( v(k,0,i) - v(k,1,i) ) * ddy
+
+ w_p(k,-1,i) = w(k,-1,i) - dt_3d * tsc(2) * c_w(k,i) * &
+ ( w(k,-1,i) - w(k,0,i) ) * ddy
+
+ ENDDO
+ ENDDO
+
+!
+!-- Bottom boundary at the outflow
+ IF ( ibc_uv_b == 0 ) THEN
+ u_p(nzb,-1,:) = -u_p(nzb+1,-1,:)
+ v_p(nzb,0,:) = -v_p(nzb+1,0,:)
+ ELSE
+ u_p(nzb,-1,:) = u_p(nzb+1,-1,:)
+ v_p(nzb,0,:) = v_p(nzb+1,0,:)
+ ENDIF
+ w_p(nzb,-1,:) = 0.0
+
+!
+!-- Top boundary at the outflow
+ IF ( ibc_uv_t == 0 ) THEN
+ u_p(nzt+1,-1,:) = ug(nzt+1)
+ v_p(nzt+1,0,:) = vg(nzt+1)
+ ELSE
+ u_p(nzt+1,-1,:) = u(nzt,-1,:)
+ v_p(nzt+1,0,:) = v(nzt,0,:)
+ ENDIF
+ w_p(nzt:nzt+1,-1,:) = 0.0
+
+ ENDIF
+
+ IF ( outflow_n ) THEN
+
+ c_max = dy / dt_3d
+
+ DO i = nxl-1, nxr+1
+ DO k = nzb+1, nzt+1
+
+!
+!-- Calculate the phase speeds for u,v, and w. In case of using a
+!-- Runge-Kutta scheme, do this for the first substep only and then
+!-- reuse this values for the further substeps.
+ IF ( intermediate_timestep_count == 1 ) THEN
+
+ denom = u_m_n(k,ny,i) - u_m_n(k,ny-1,i)
+
+ IF ( denom /= 0.0 ) THEN
+ c_u(k,i) = -c_max * ( u(k,ny,i) - u_m_n(k,ny,i) ) / denom
+ IF ( c_u(k,i) < 0.0 ) THEN
+ c_u(k,i) = 0.0
+ ELSEIF ( c_u(k,i) > c_max ) THEN
+ c_u(k,i) = c_max
+ ENDIF
+ ELSE
+ c_u(k,i) = c_max
+ ENDIF
+
+ denom = v_m_n(k,ny,i) - v_m_n(k,ny-1,i)
+
+ IF ( denom /= 0.0 ) THEN
+ c_v(k,i) = -c_max * ( v(k,ny,i) - v_m_n(k,ny,i) ) / denom
+ IF ( c_v(k,i) < 0.0 ) THEN
+ c_v(k,i) = 0.0
+ ELSEIF ( c_v(k,i) > c_max ) THEN
+ c_v(k,i) = c_max
+ ENDIF
+ ELSE
+ c_v(k,i) = c_max
+ ENDIF
+
+ denom = w_m_n(k,ny,i) - w_m_n(k,ny-1,i)
+
+ IF ( denom /= 0.0 ) THEN
+ c_w(k,i) = -c_max * ( w(k,ny,i) - w_m_n(k,ny,i) ) / denom
+ IF ( c_w(k,i) < 0.0 ) THEN
+ c_w(k,i) = 0.0
+ ELSEIF ( c_w(k,i) > c_max ) THEN
+ c_w(k,i) = c_max
+ ENDIF
+ ELSE
+ c_w(k,i) = c_max
+ ENDIF
+
+!
+!-- Swap timelevels for the next timestep
+ u_m_n(k,:,i) = u(k,ny-1:ny,i)
+ v_m_n(k,:,i) = v(k,ny-1:ny,i)
+ w_m_n(k,:,i) = w(k,ny-1:ny,i)
+
+ ENDIF
+
+!
+!-- Calculate the new velocities
+ u_p(k,ny+1,i) = u(k,ny+1,i) - dt_3d * tsc(2) * c_u(k,i) * &
+ ( u(k,ny+1,i) - u(k,ny,i) ) * ddy
+
+ v_p(k,ny+1,i) = v(k,ny+1,i) - dt_3d * tsc(2) * c_v(k,i) * &
+ ( v(k,ny+1,i) - v(k,ny,i) ) * ddy
+
+ w_p(k,ny+1,i) = w(k,ny+1,i) - dt_3d * tsc(2) * c_w(k,i) * &
+ ( w(k,ny+1,i) - w(k,ny,i) ) * ddy
+
+ ENDDO
+ ENDDO
+
+!
+!-- Bottom boundary at the outflow
+ IF ( ibc_uv_b == 0 ) THEN
+ u_p(nzb,ny+1,:) = -u_p(nzb+1,ny+1,:)
+ v_p(nzb,ny+1,:) = -v_p(nzb+1,ny+1,:)
+ ELSE
+ u_p(nzb,ny+1,:) = u_p(nzb+1,ny+1,:)
+ v_p(nzb,ny+1,:) = v_p(nzb+1,ny+1,:)
+ ENDIF
+ w_p(nzb,ny+1,:) = 0.0
+
+!
+!-- Top boundary at the outflow
+ IF ( ibc_uv_t == 0 ) THEN
+ u_p(nzt+1,ny+1,:) = ug(nzt+1)
+ v_p(nzt+1,ny+1,:) = vg(nzt+1)
+ ELSE
+ u_p(nzt+1,ny+1,:) = u_p(nzt,nyn+1,:)
+ v_p(nzt+1,ny+1,:) = v_p(nzt,nyn+1,:)
+ ENDIF
+ w_p(nzt:nzt+1,ny+1,:) = 0.0
+
+ ENDIF
+
+ IF ( outflow_l ) THEN
+
+ c_max = dx / dt_3d
+
+ DO j = nys-1, nyn+1
+ DO k = nzb+1, nzt+1
+
+!
+!-- Calculate the phase speeds for u,v, and w. In case of using a
+!-- Runge-Kutta scheme, do this for the first substep only and then
+!-- reuse this values for the further substeps.
+ IF ( intermediate_timestep_count == 1 ) THEN
+
+ denom = u_m_l(k,j,1) - u_m_l(k,j,2)
+
+ IF ( denom /= 0.0 ) THEN
+ c_u(k,j) = -c_max * ( u(k,j,1) - u_m_l(k,j,1) ) / denom
+ IF ( c_u(k,j) < 0.0 ) THEN
+ c_u(k,j) = 0.0
+ ELSEIF ( c_u(k,j) > c_max ) THEN
+ c_u(k,j) = c_max
+ ENDIF
+ ELSE
+ c_u(k,j) = c_max
+ ENDIF
+
+ denom = v_m_l(k,j,0) - v_m_l(k,j,1)
+
+ IF ( denom /= 0.0 ) THEN
+ c_v(k,j) = -c_max * ( v(k,j,0) - v_m_l(k,j,0) ) / denom
+ IF ( c_v(k,j) < 0.0 ) THEN
+ c_v(k,j) = 0.0
+ ELSEIF ( c_v(k,j) > c_max ) THEN
+ c_v(k,j) = c_max
+ ENDIF
+ ELSE
+ c_v(k,j) = c_max
+ ENDIF
+
+ denom = w_m_l(k,j,0) - w_m_l(k,j,1)
+
+ IF ( denom /= 0.0 ) THEN
+ c_w(k,j) = -c_max * ( w(k,j,0) - w_m_l(k,j,0) ) / denom
+ IF ( c_w(k,j) < 0.0 ) THEN
+ c_w(k,j) = 0.0
+ ELSEIF ( c_w(k,j) > c_max ) THEN
+ c_w(k,j) = c_max
+ ENDIF
+ ELSE
+ c_w(k,j) = c_max
+ ENDIF
+
+!
+!-- Swap timelevels for the next timestep
+ u_m_l(k,j,:) = u(k,j,1:2)
+ v_m_l(k,j,:) = v(k,j,0:1)
+ w_m_l(k,j,:) = w(k,j,0:1)
+
+ ENDIF
+
+!
+!-- Calculate the new velocities
+ u_p(k,j,0) = u(k,j,0) - dt_3d * tsc(2) * c_u(k,j) * &
+ ( u(k,j,0) - u(k,j,1) ) * ddx
+
+ v_p(k,j,-1) = v(k,j,-1) - dt_3d * tsc(2) * c_v(k,j) * &
+ ( v(k,j,-1) - v(k,j,0) ) * ddx
+
+ w_p(k,j,-1) = w(k,j,-1) - dt_3d * tsc(2) * c_w(k,j) * &
+ ( w(k,j,-1) - w(k,j,0) ) * ddx
+
+ ENDDO
+ ENDDO
+
+!
+!-- Bottom boundary at the outflow
+ IF ( ibc_uv_b == 0 ) THEN
+ u_p(nzb,:,-1) = -u_p(nzb+1,:,-1)
+ v_p(nzb,:,-1) = -v_p(nzb+1,:,-1)
+ ELSE
+ u_p(nzb,:,-1) = u_p(nzb+1,:,-1)
+ v_p(nzb,:,-1) = v_p(nzb+1,:,-1)
+ ENDIF
+ w_p(nzb,:,-1) = 0.0
+
+!
+!-- Top boundary at the outflow
+ IF ( ibc_uv_t == 0 ) THEN
+ u_p(nzt+1,:,-1) = ug(nzt+1)
+ v_p(nzt+1,:,-1) = vg(nzt+1)
+ ELSE
+ u_p(nzt+1,:,-1) = u_p(nzt,:,-1)
+ v_p(nzt+1,:,-1) = v_p(nzt,:,-1)
+ ENDIF
+ w_p(nzt:nzt+1,:,-1) = 0.0
+
+ ENDIF
+
+ IF ( outflow_r ) THEN
+
+ c_max = dx / dt_3d
+
+ DO j = nys-1, nyn+1
+ DO k = nzb+1, nzt+1
+
+!
+!-- Calculate the phase speeds for u,v, and w. In case of using a
+!-- Runge-Kutta scheme, do this for the first substep only and then
+!-- reuse this values for the further substeps.
+ IF ( intermediate_timestep_count == 1 ) THEN
+
+ denom = u_m_r(k,j,nx) - u_m_r(k,j,nx-1)
+
+ IF ( denom /= 0.0 ) THEN
+ c_u(k,j) = -c_max * ( u(k,j,nx) - u_m_r(k,j,nx) ) / denom
+ IF ( c_u(k,j) < 0.0 ) THEN
+ c_u(k,j) = 0.0
+ ELSEIF ( c_u(k,j) > c_max ) THEN
+ c_u(k,j) = c_max
+ ENDIF
+ ELSE
+ c_u(k,j) = c_max
+ ENDIF
+
+ denom = v_m_r(k,j,nx) - v_m_r(k,j,nx-1)
+
+ IF ( denom /= 0.0 ) THEN
+ c_v(k,j) = -c_max * ( v(k,j,nx) - v_m_r(k,j,nx) ) / denom
+ IF ( c_v(k,j) < 0.0 ) THEN
+ c_v(k,j) = 0.0
+ ELSEIF ( c_v(k,j) > c_max ) THEN
+ c_v(k,j) = c_max
+ ENDIF
+ ELSE
+ c_v(k,j) = c_max
+ ENDIF
+
+ denom = w_m_r(k,j,nx) - w_m_r(k,j,nx-1)
+
+ IF ( denom /= 0.0 ) THEN
+ c_w(k,j) = -c_max * ( w(k,j,nx) - w_m_r(k,j,nx) ) / denom
+ IF ( c_w(k,j) < 0.0 ) THEN
+ c_w(k,j) = 0.0
+ ELSEIF ( c_w(k,j) > c_max ) THEN
+ c_w(k,j) = c_max
+ ENDIF
+ ELSE
+ c_w(k,j) = c_max
+ ENDIF
+
+!
+!-- Swap timelevels for the next timestep
+ u_m_r(k,j,:) = u(k,j,nx-1:nx)
+ v_m_r(k,j,:) = v(k,j,nx-1:nx)
+ w_m_r(k,j,:) = w(k,j,nx-1:nx)
+
+ ENDIF
+
+!
+!-- Calculate the new velocities
+ u_p(k,j,nx+1) = u(k,j,nx+1) - dt_3d * tsc(2) * c_u(k,j) * &
+ ( u(k,j,nx+1) - u(k,j,nx) ) * ddx
+
+ v_p(k,j,nx+1) = v(k,j,nx+1) - dt_3d * tsc(2) * c_v(k,j) * &
+ ( v(k,j,nx+1) - v(k,j,nx) ) * ddx
+
+ w_p(k,j,nx+1) = w(k,j,nx+1) - dt_3d * tsc(2) * c_w(k,j) * &
+ ( w(k,j,nx+1) - w(k,j,nx) ) * ddx
+
+ ENDDO
+ ENDDO
+
+!
+!-- Bottom boundary at the outflow
+ IF ( ibc_uv_b == 0 ) THEN
+ u_p(nzb,:,nx+1) = -u_p(nzb+1,:,nx+1)
+ v_p(nzb,:,nx+1) = -v_p(nzb+1,:,nx+1)
+ ELSE
+ u_p(nzb,:,nx+1) = u_p(nzb+1,:,nx+1)
+ v_p(nzb,:,nx+1) = v_p(nzb+1,:,nx+1)
+ ENDIF
+ w_p(nzb,:,nx+1) = 0.0
+
+!
+!-- Top boundary at the outflow
+ IF ( ibc_uv_t == 0 ) THEN
+ u_p(nzt+1,:,nx+1) = ug(nzt+1)
+ v_p(nzt+1,:,nx+1) = vg(nzt+1)
+ ELSE
+ u_p(nzt+1,:,nx+1) = u_p(nzt,:,nx+1)
+ v_p(nzt+1,:,nx+1) = v_p(nzt,:,nx+1)
+ ENDIF
+ w(nzt:nzt+1,:,nx+1) = 0.0
+
+ ENDIF
+
+
+ END SUBROUTINE boundary_conds
Index: /palm/tags/release-3.4a/SOURCE/buoyancy.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/buoyancy.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/buoyancy.f90 (revision 141)
@@ -0,0 +1,291 @@
+ MODULE buoyancy_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 132 2007-11-20 09:46:11Z letzel
+! Vertical scalar profiles now based on nzb_s_inner and ngp_2dh_s_inner.
+!
+! 106 2007-08-16 14:30:26Z raasch
+! i loop for u-component (sloping surface) is starting from nxlu (needed for
+! non-cyclic boundary conditions)
+!
+! 97 2007-06-21 08:23:15Z raasch
+! Routine reneralized to be used with temperature AND density:
+! argument theta renamed var, new argument var_reference,
+! use_pt_reference renamed use_reference,
+! calc_mean_pt_profile renamed calc_mean_profile
+!
+! 57 2007-03-09 12:05:41Z raasch
+! Reference temperature pt_reference can be used.
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.19 2006/04/26 12:09:56 raasch
+! OpenMP optimization (one dimension added to sums_l)
+!
+! Revision 1.1 1997/08/29 08:56:48 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Buoyancy term of the third component of the equation of motion.
+! WARNING: humidity is not regarded when using a sloping surface!
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC buoyancy, calc_mean_profile
+
+ INTERFACE buoyancy
+ MODULE PROCEDURE buoyancy
+ MODULE PROCEDURE buoyancy_ij
+ END INTERFACE buoyancy
+
+ INTERFACE calc_mean_profile
+ MODULE PROCEDURE calc_mean_profile
+ END INTERFACE calc_mean_profile
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE buoyancy( var, var_reference, wind_component, pr )
+
+ USE arrays_3d
+ USE control_parameters
+ USE indices
+ USE pegrid
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, pr, wind_component
+ REAL :: var_reference
+ REAL, DIMENSION(:,:,:), POINTER :: var
+
+
+ IF ( .NOT. sloping_surface ) THEN
+!
+!-- Normal case: horizontal surface
+ IF ( use_reference ) THEN
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt-1
+ tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5 * &
+ ( &
+ ( var(k,j,i) - hom(k,1,pr,0) ) / var_reference + &
+ ( var(k+1,j,i) - hom(k+1,1,pr,0) ) / var_reference &
+ )
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSE
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt-1
+ tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5 * &
+ ( &
+ ( var(k,j,i) - hom(k,1,pr,0) ) / hom(k,1,pr,0) + &
+ ( var(k+1,j,i) - hom(k+1,1,pr,0) ) / hom(k+1,1,pr,0) &
+ )
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+ ELSE
+!
+!-- Buoyancy term for a surface with a slope in x-direction. The equations
+!-- for both the u and w velocity-component contain proportionate terms.
+!-- Temperature field at time t=0 serves as environmental temperature.
+!-- Reference temperature (pt_surface) is the one at the lower left corner
+!-- of the total domain.
+ IF ( wind_component == 1 ) THEN
+
+ DO i = nxlu, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt-1
+ tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface * &
+ 0.5 * ( ( pt(k,j,i-1) + pt(k,j,i) ) &
+ - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) &
+ ) / pt_surface
+ ENDDO
+ ENDDO
+ ENDDO
+
+ ELSEIF ( wind_component == 3 ) THEN
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt-1
+ tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface * &
+ 0.5 * ( ( pt(k,j,i) + pt(k+1,j,i) ) &
+ - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) &
+ ) / pt_surface
+ ENDDO
+ ENDDO
+ ENDDO
+
+ ELSE
+
+ IF ( myid == 0 ) PRINT*, '+++ buoyancy: no term for component "',&
+ wind_component,'"'
+ CALL local_stop
+
+ ENDIF
+
+ ENDIF
+
+ END SUBROUTINE buoyancy
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE buoyancy_ij( i, j, var, var_reference, wind_component, pr )
+
+ USE arrays_3d
+ USE control_parameters
+ USE indices
+ USE pegrid
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, pr, wind_component
+ REAL :: var_reference
+ REAL, DIMENSION(:,:,:), POINTER :: var
+
+
+ IF ( .NOT. sloping_surface ) THEN
+!
+!-- Normal case: horizontal surface
+ IF ( use_reference ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt-1
+ tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5 * ( &
+ ( var(k,j,i) - hom(k,1,pr,0) ) / var_reference + &
+ ( var(k+1,j,i) - hom(k+1,1,pr,0) ) / var_reference &
+ )
+ ENDDO
+ ELSE
+ DO k = nzb_s_inner(j,i)+1, nzt-1
+ tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5 * ( &
+ ( var(k,j,i) - hom(k,1,pr,0) ) / hom(k,1,pr,0) + &
+ ( var(k+1,j,i) - hom(k+1,1,pr,0) ) / hom(k+1,1,pr,0) &
+ )
+ ENDDO
+ ENDIF
+
+ ELSE
+!
+!-- Buoyancy term for a surface with a slope in x-direction. The equations
+!-- for both the u and w velocity-component contain proportionate terms.
+!-- Temperature field at time t=0 serves as environmental temperature.
+!-- Reference temperature (pt_surface) is the one at the lower left corner
+!-- of the total domain.
+ IF ( wind_component == 1 ) THEN
+
+ DO k = nzb_s_inner(j,i)+1, nzt-1
+ tend(k,j,i) = tend(k,j,i) + g * sin_alpha_surface * &
+ 0.5 * ( ( pt(k,j,i-1) + pt(k,j,i) ) &
+ - ( pt_slope_ref(k,i-1) + pt_slope_ref(k,i) ) &
+ ) / pt_surface
+ ENDDO
+
+ ELSEIF ( wind_component == 3 ) THEN
+
+ DO k = nzb_s_inner(j,i)+1, nzt-1
+ tend(k,j,i) = tend(k,j,i) + g * cos_alpha_surface * &
+ 0.5 * ( ( pt(k,j,i) + pt(k+1,j,i) ) &
+ - ( pt_slope_ref(k,i) + pt_slope_ref(k+1,i) ) &
+ ) / pt_surface
+ ENDDO
+
+ ELSE
+
+ IF ( myid == 0 ) PRINT*, '+++ buoyancy: no term for component "',&
+ wind_component,'"'
+ CALL local_stop
+
+ ENDIF
+
+ ENDIF
+
+ END SUBROUTINE buoyancy_ij
+
+
+ SUBROUTINE calc_mean_profile( var, pr )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Calculate the horizontally averaged vertical temperature profile (pr=4 in case
+! of potential temperature and 44 in case of virtual potential temperature).
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE indices
+ USE pegrid
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, omp_get_thread_num, pr, tn
+ REAL, DIMENSION(:,:,:), POINTER :: var
+
+!
+!-- Computation of the horizontally averaged profile of variable var, unless
+!-- already done by the relevant call from flow_statistics. The calculation
+!-- is done only for the first respective intermediate timestep in order to
+!-- spare communication time and to produce identical model results with jobs
+!-- which are calling flow_statistics at different time intervals.
+ IF ( .NOT. flow_statistics_called .AND. &
+ intermediate_timestep_count == 1 ) THEN
+
+!
+!-- Horizontal average of variable var
+ tn = 0 ! Default thread number in case of one thread
+ !$OMP PARALLEL PRIVATE( i, j, k, tn )
+!$ tn = omp_get_thread_num()
+ sums_l(:,pr,tn) = 0.0
+ !$OMP DO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i), nzt+1
+ sums_l(k,pr,tn) = sums_l(k,pr,tn) + var(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ !$OMP END PARALLEL
+
+ DO i = 1, threads_per_task-1
+ sums_l(:,pr,0) = sums_l(:,pr,0) + sums_l(:,pr,i)
+ ENDDO
+
+#if defined( __parallel )
+
+ CALL MPI_ALLREDUCE( sums_l(nzb,pr,0), sums(nzb,pr), nzt+2-nzb, &
+ MPI_REAL, MPI_SUM, comm2d, ierr )
+
+#else
+
+ sums(:,pr) = sums_l(:,pr,0)
+
+#endif
+
+ hom(:,1,pr,0) = sums(:,pr) / ngp_2dh_s_inner(:,0)
+
+ ENDIF
+
+ END SUBROUTINE calc_mean_profile
+
+ END MODULE buoyancy_mod
Index: /palm/tags/release-3.4a/SOURCE/calc_liquid_water_content.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/calc_liquid_water_content.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/calc_liquid_water_content.f90 (revision 141)
@@ -0,0 +1,87 @@
+ SUBROUTINE calc_liquid_water_content
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 95 2007-06-02 16:48:38Z raasch
+! hydro_press renamed hyp
+!
+! 19 2007-02-23 04:53:48Z raasch
+! Old comment removed
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.5 2005/03/26 15:22:06 raasch
+! Arguments for non-cyclic boundary conditions added to argument list of
+! routine exchange_horiz,
+! ql calculated for the ghost points, exchange of ghost points removed
+!
+! Revision 1.1 2000/04/13 14:50:45 schroeter
+! Initial revision
+!
+!
+!
+! Description:
+! ------------
+! Calculation of the liquid water content (0%-or-100%-scheme)
+!------------------------------------------------------------------------------!
+
+
+ USE arrays_3d
+ USE cloud_parameters
+ USE constants
+ USE grid_variables
+ USE indices
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL :: alpha, e_s, q_s, t_l
+
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb_2d(j,i)+1, nzt
+
+!
+!-- Compute the liquid water temperature
+ t_l = t_d_pt(k) * pt(k,j,i)
+
+!
+!-- Compute saturation water vapor pressure at t_l
+ e_s = 610.78 * EXP( 17.269 * ( t_l - 273.16 ) / &
+ ( t_l - 35.86 ) )
+
+!
+!-- Compute approximation of saturation humidity
+ q_s = 0.622 * e_s / ( hyp(k) - 0.378 * e_s )
+
+!
+!-- Correction factor
+ alpha = 0.622 * l_d_r * l_d_cp / ( t_l * t_l )
+
+!
+!-- Correction of the approximated value
+!-- (see: Cuijpers + Duynkerke, 1993, JAS, 23)
+ q_s = q_s * ( 1.0 + alpha * q(k,j,i) ) / ( 1.0 + alpha * q_s )
+
+!
+!-- Compute the liquid water content
+ IF ( ( q(k,j,i) - q_s ) > 0.0 ) THEN
+ ql(k,j,i) = q(k,j,i) - q_s
+ ELSE
+ ql(k,j,i) = 0.0
+ ENDIF
+
+ ENDDO
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE calc_liquid_water_content
Index: /palm/tags/release-3.4a/SOURCE/calc_precipitation.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/calc_precipitation.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/calc_precipitation.f90 (revision 141)
@@ -0,0 +1,146 @@
+ MODULE calc_precipitation_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 73 2007-03-20 08:33:14Z raasch
+! Precipitation rate and amount are calculated/stored,
+! + module control_parameters
+!
+! 19 2007-02-23 04:53:48Z raasch
+! Calculation extended for gridpoint nzt
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.5 2004/01/30 10:15:57 raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.1 2000/04/13 14:45:22 schroeter
+! Initial revision
+!
+!
+!
+! Description:
+! ------------
+! Calculate the change of total water content due to precipitation
+! (simplified Kessler scheme)
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC calc_precipitation
+
+ INTERFACE calc_precipitation
+ MODULE PROCEDURE calc_precipitation
+ MODULE PROCEDURE calc_precipitation_ij
+ END INTERFACE calc_precipitation
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE calc_precipitation
+
+ USE arrays_3d
+ USE cloud_parameters
+ USE constants
+ USE control_parameters
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: dqdt_precip
+
+
+ precipitation_rate = 0.0
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_2d(j,i)+1, nzt
+
+ IF ( ql(k,j,i) > ql_crit ) THEN
+ dqdt_precip = prec_time_const * ( ql(k,j,i) - ql_crit )
+ ELSE
+ dqdt_precip = 0.0
+ ENDIF
+ tend(k,j,i) = tend(k,j,i) - dqdt_precip
+!
+!-- Precipitation rate in kg / m**2 / s (= mm/s)
+ precipitation_rate(j,i) = precipitation_rate(j,i) + &
+ dqdt_precip * dzw(k)
+
+ ENDDO
+!
+!-- Sum up the precipitation amount, unit kg / m**2 (= mm)
+ IF ( intermediate_timestep_count == &
+ intermediate_timestep_count_max .AND. &
+ ( dt_do2d_xy-time_do2d_xy ) < precipitation_amount_interval )&
+ THEN
+ precipitation_amount(j,i) = precipitation_amount(j,i) + &
+ precipitation_rate(j,i) * dt_3d
+ ENDIF
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE calc_precipitation
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE calc_precipitation_ij( i, j )
+
+ USE arrays_3d
+ USE cloud_parameters
+ USE constants
+ USE control_parameters
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: dqdt_precip
+
+
+ precipitation_rate(j,i) = 0.0
+
+!
+!-- Ghostpoints are included (although not needed for tend) to avoid a later
+!-- exchange of these data for the precipitation amount/rate arrays
+ DO k = nzb_2d(j,i)+1, nzt
+
+ IF ( ql(k,j,i) > ql_crit ) THEN
+ dqdt_precip = prec_time_const * ( ql(k,j,i) - ql_crit )
+ ELSE
+ dqdt_precip = 0.0
+ ENDIF
+ tend(k,j,i) = tend(k,j,i) - dqdt_precip
+
+!
+!-- Precipitation rate in (kg * 0.001) / m**2 / s (because 1kg gives 1 mm)
+! precipitation_rate(j,i) = precipitation_rate(j,i) + dqdt_precip * &
+! dzw(k) * 0.001
+ precipitation_rate(j,i) = 1.0
+
+ ENDDO
+
+!
+!-- Sum up the precipitation amount (unit kg * 0.001 / m**2)
+ IF ( intermediate_timestep_count == intermediate_timestep_count_max &
+ .AND. ( dt_do2d_xy-time_do2d_xy ) < precipitation_amount_interval )&
+ THEN
+ precipitation_amount(j,i) = precipitation_amount(j,i) + &
+ precipitation_rate(j,i) * dt_3d
+ ENDIF
+
+ END SUBROUTINE calc_precipitation_ij
+
+ END MODULE calc_precipitation_mod
Index: /palm/tags/release-3.4a/SOURCE/calc_radiation.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/calc_radiation.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/calc_radiation.f90 (revision 141)
@@ -0,0 +1,270 @@
+ MODULE calc_radiation_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.6 2004/01/30 10:17:03 raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.1 2000/04/13 14:42:45 schroeter
+! Initial revision
+!
+!
+! Description:
+! -------------
+! Calculation of the vertical divergences of the long-wave radiation-fluxes
+! based on the parameterization of the cloud effective emissivity
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC calc_radiation
+
+ LOGICAL, SAVE :: first_call = .TRUE.
+ REAL, SAVE :: sigma = 5.67E-08
+
+ REAL, DIMENSION(:), ALLOCATABLE, SAVE :: lwp_ground, lwp_top, &
+ blackbody_emission
+
+ INTERFACE calc_radiation
+ MODULE PROCEDURE calc_radiation
+ MODULE PROCEDURE calc_radiation_ij
+ END INTERFACE calc_radiation
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE calc_radiation
+
+ USE arrays_3d
+ USE cloud_parameters
+ USE control_parameters
+ USE indices
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, k_help
+
+ REAL :: df_p, df_m , effective_emission_up_m, effective_emission_up_p, &
+ effective_emission_down_m, effective_emission_down_p, &
+ f_up_m, f_up_p, f_down_m, f_down_p, impinging_flux_at_top, &
+ temperature
+
+
+!
+!-- On first call, allocate temporary arrays
+ IF ( first_call ) THEN
+ ALLOCATE( blackbody_emission(nzb:nzt+1), lwp_ground(nzb:nzt+1), &
+ lwp_top(nzb:nzt+1) )
+ first_call = .FALSE.
+ ENDIF
+
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+!
+!-- Compute the liquid water path (LWP) and blackbody_emission
+!-- at all vertical levels
+ lwp_ground(nzb) = 0.0
+ lwp_top(nzt+1) = rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
+
+ temperature = pt(nzb,j,i) * t_d_pt(nzb) + l_d_cp * ql(nzb,j,i)
+ blackbody_emission(nzb) = sigma * temperature**4.0
+
+ DO k = nzb_2d(j,i)+1, nzt
+
+ k_help = ( nzt+nzb+1 ) - k
+ lwp_ground(k) = lwp_ground(k-1) + rho_surface * ql(k,j,i) * &
+ dzw(k)
+
+ lwp_top(k_help) = lwp_top(k_help+1) + &
+ rho_surface * ql(k_help,j,i) * dzw(k_help)
+
+ temperature = pt(k,j,i) * t_d_pt(k) + l_d_cp * ql(k,j,i)
+ blackbody_emission(k) = sigma * temperature**4.0
+
+ ENDDO
+
+ lwp_ground(nzt+1) = lwp_ground(nzt) + &
+ rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
+ lwp_top(nzb) = lwp_top(nzb+1)
+
+ temperature = pt(nzt+1,j,i) * t_d_pt(nzt+1) + l_d_cp * &
+ ql(nzt+1,j,i)
+ blackbody_emission(nzt+1) = sigma * temperature**4.0
+
+!
+!-- See Chlond '92, this is just a first guess
+ impinging_flux_at_top = blackbody_emission(nzb) - 100.0
+
+ DO k = nzb_2d(j,i)+1, nzt
+!
+!-- Save some computational time, but this may cause load
+!-- imbalances if ql is not distributed uniformly
+ IF ( ql(k,j,i) /= 0.0 ) THEN
+!
+!-- Compute effective emissivities
+ effective_emission_up_p = 1.0 - &
+ EXP( -130.0 * lwp_ground(k+1) )
+ effective_emission_up_m = 1.0 - &
+ EXP( -130.0 * lwp_ground(k-1) )
+ effective_emission_down_p = 1.0 - &
+ EXP( -158.0 * lwp_top(k+1) )
+ effective_emission_down_m = 1.0 - &
+ EXP( -158.0 * lwp_top(k-1) )
+
+!
+!-- Compute vertical long wave radiation fluxes
+ f_up_p = blackbody_emission(nzb) + &
+ effective_emission_up_p * &
+ ( blackbody_emission(k) - blackbody_emission(nzb) )
+
+ f_up_m = blackbody_emission(nzb) + &
+ effective_emission_up_m * &
+ ( blackbody_emission(k-1) - blackbody_emission(nzb) )
+
+ f_down_p = impinging_flux_at_top + &
+ effective_emission_down_p * &
+ ( blackbody_emission(k) - impinging_flux_at_top )
+
+ f_down_m = impinging_flux_at_top + &
+ effective_emission_down_m * &
+ ( blackbody_emission(k-1) - impinging_flux_at_top )
+
+!
+!-- Divergence of vertical long wave radiation fluxes
+ df_p = f_up_p - f_down_p
+ df_m = f_up_m - f_down_m
+
+!
+!-- Compute tendency term
+ tend(k,j,i) = tend(k,j,i) - &
+ ( pt_d_t(k) / ( rho_surface * cp ) * &
+ ( df_p - df_m ) / dzw(k) )
+
+ ENDIF
+
+ ENDDO
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE calc_radiation
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE calc_radiation_ij( i, j )
+
+ USE arrays_3d
+ USE cloud_parameters
+ USE control_parameters
+ USE indices
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, k_help
+
+ REAL :: df_p, df_m , effective_emission_up_m, effective_emission_up_p, &
+ effective_emission_down_m, effective_emission_down_p, &
+ f_up_m, f_up_p, f_down_m, f_down_p, impinging_flux_at_top, &
+ temperature
+
+!
+!-- On first call, allocate temporary arrays
+ IF ( first_call ) THEN
+ ALLOCATE( blackbody_emission(nzb:nzt+1), lwp_ground(nzb:nzt+1), &
+ lwp_top(nzb:nzt+1) )
+ first_call = .FALSE.
+ ENDIF
+
+!
+!-- Compute the liquid water path (LWP) and blackbody_emission
+!-- at all vertical levels
+ lwp_ground(nzb) = 0.0
+ lwp_top(nzt+1) = rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
+
+ temperature = pt(nzb,j,i) * t_d_pt(nzb) + l_d_cp * ql(nzb,j,i)
+ blackbody_emission(nzb) = sigma * temperature**4.0
+
+ DO k = nzb_2d(j,i)+1, nzt
+ k_help = ( nzt+nzb+1 ) - k
+ lwp_ground(k) = lwp_ground(k-1) + rho_surface * ql(k,j,i) * dzw(k)
+
+ lwp_top(k_help) = lwp_top(k_help+1) + &
+ rho_surface * ql(k_help,j,i) * dzw(k_help)
+
+ temperature = pt(k,j,i) * t_d_pt(k) + l_d_cp * ql(k,j,i)
+ blackbody_emission(k) = sigma * temperature**4.0
+
+ ENDDO
+ lwp_ground(nzt+1) = lwp_ground(nzt) + &
+ rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
+ lwp_top(nzb) = lwp_top(nzb+1)
+
+ temperature = pt(nzt+1,j,i) * t_d_pt(nzt+1) + l_d_cp * &
+ ql(nzt+1,j,i)
+ blackbody_emission(nzt+1) = sigma * temperature**4.0
+
+!
+!-- See Chlond '92, this is just a first guess
+ impinging_flux_at_top = blackbody_emission(nzb) - 100.0
+
+ DO k = nzb_2d(j,i)+1, nzt
+!
+!-- Store some computational time,
+!-- this may cause load imbalances if ql is not distributed uniformly
+ IF ( ql(k,j,i) /= 0.0 ) THEN
+!
+!-- Compute effective emissivities
+ effective_emission_up_p = 1.0 - &
+ EXP( -130.0 * lwp_ground(k+1) )
+ effective_emission_up_m = 1.0 - &
+ EXP( -130.0 * lwp_ground(k-1) )
+ effective_emission_down_p = 1.0 - &
+ EXP( -158.0 * lwp_top(k+1) )
+ effective_emission_down_m = 1.0 - &
+ EXP( -158.0 * lwp_top(k-1) )
+
+!
+!-- Compute vertical long wave radiation fluxes
+ f_up_p = blackbody_emission(nzb) + effective_emission_up_p * &
+ ( blackbody_emission(k) - blackbody_emission(nzb) )
+
+ f_up_m = blackbody_emission(nzb) + effective_emission_up_m * &
+ ( blackbody_emission(k-1) - blackbody_emission(nzb) )
+
+ f_down_p = impinging_flux_at_top + effective_emission_down_p * &
+ ( blackbody_emission(k) - impinging_flux_at_top )
+
+ f_down_m = impinging_flux_at_top + effective_emission_down_m * &
+ ( blackbody_emission(k-1) - impinging_flux_at_top )
+
+!
+!- Divergence of vertical long wave radiation fluxes
+ df_p = f_up_p - f_down_p
+ df_m = f_up_m - f_down_m
+
+!
+!-- Compute tendency term
+ tend(k,j,i) = tend(k,j,i) - ( pt_d_t(k) / ( rho_surface * cp ) * &
+ ( df_p - df_m ) / dzw(k) )
+
+ ENDIF
+
+ ENDDO
+
+ END SUBROUTINE calc_radiation_ij
+
+ END MODULE calc_radiation_mod
Index: /palm/tags/release-3.4a/SOURCE/calc_spectra.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/calc_spectra.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/calc_spectra.f90 (revision 141)
@@ -0,0 +1,421 @@
+ SUBROUTINE calc_spectra
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.9 2006/04/11 14:56:00 raasch
+! pl_spectra renamed data_output_sp
+!
+! Revision 1.1 2001/01/05 15:08:07 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Calculate horizontal spectra along x and y.
+! ATTENTION: 1d-decomposition along y still needs improvement, because in that
+! case the gridpoint number along z still depends on the PE number
+! because transpose_xz has to be used (and possibly also
+! transpose_zyd needs modification).
+!------------------------------------------------------------------------------!
+
+#if defined( __spectra )
+ USE arrays_3d
+ USE control_parameters
+ USE cpulog
+ USE fft_xy
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE spectrum
+
+ IMPLICIT NONE
+
+ INTEGER :: m, pr
+
+
+ CALL cpu_log( log_point(30), 'calc_spectra', 'start' )
+
+!
+!-- Initialize ffts
+ CALL fft_init
+
+!
+!-- Enlarge the size of tend, used as a working array for the transpositions
+ IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN
+ DEALLOCATE( tend )
+ ALLOCATE( tend(1:nza,nys:nyna,nxl:nxra) )
+ ENDIF
+
+ m = 1
+ DO WHILE ( data_output_sp(m) /= ' ' .AND. m <= 10 )
+!
+!-- Transposition from z --> x ( y --> x in case of a 1d-decomposition
+!-- along x)
+ IF ( INDEX( spectra_direction(m), 'x' ) /= 0 ) THEN
+
+!
+!-- Calculation of spectra works for cyclic boundary conditions only
+ IF ( bc_lr /= 'cyclic' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ calc_spectra:'
+ PRINT*, ' non-cyclic lateral boundaries along x do not ', &
+ 'allow calculation of spectra along x'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ CALL preprocess_spectra( m, pr )
+
+#if defined( __parallel )
+ IF ( pdims(2) /= 1 ) THEN
+ CALL transpose_zx( d, tend, d, tend, d )
+ ELSE
+ CALL transpose_yxd( d, tend, d, tend, d )
+ ENDIF
+ CALL calc_spectra_x( d, pr, m )
+#else
+ PRINT*, '+++ calc_spectra: sorry, calculation of spectra ', &
+ 'in non parallel mode'
+ PRINT*, ' is still not realized'
+ CALL local_stop
+#endif
+
+ ENDIF
+
+!
+!-- Transposition from z --> y (d is rearranged only in case of a
+!-- 1d-decomposition along x)
+ IF ( INDEX( spectra_direction(m), 'y' ) /= 0 ) THEN
+
+!
+!-- Calculation of spectra works for cyclic boundary conditions only
+ IF ( bc_ns /= 'cyclic' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ calc_spectra:'
+ PRINT*, ' non-cyclic lateral boundaries along y do not ', &
+ 'allow calculation of spectra along y'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ CALL preprocess_spectra( m, pr )
+
+#if defined( __parallel )
+ CALL transpose_zyd( d, tend, d, tend, d )
+ CALL calc_spectra_y( d, pr, m )
+#else
+ PRINT*, '+++ calc_spectra: sorry, calculation of spectra', &
+ 'in non parallel mode'
+ PRINT*, ' still not realized'
+ CALL local_stop
+#endif
+
+ ENDIF
+
+!
+!-- Increase counter for next spectrum
+ m = m + 1
+
+ ENDDO
+
+!
+!-- Increase counter for averaging process in routine plot_spectra
+ average_count_sp = average_count_sp + 1
+
+!
+!-- Resize tend to its normal size
+ IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN
+ DEALLOCATE( tend )
+ ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+
+ CALL cpu_log( log_point(30), 'calc_spectra', 'stop' )
+
+#endif
+ END SUBROUTINE calc_spectra
+
+
+#if defined( __spectra )
+ SUBROUTINE preprocess_spectra( m, pr )
+
+ USE arrays_3d
+ USE indices
+ USE pegrid
+ USE spectrum
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, m, pr
+
+ SELECT CASE ( TRIM( data_output_sp(m) ) )
+
+ CASE ( 'u' )
+ pr = 1
+ d(nzb+1:nzt,nys:nyn,nxl:nxr) = u(nzb+1:nzt,nys:nyn,nxl:nxr)
+
+ CASE ( 'v' )
+ pr = 2
+ d(nzb+1:nzt,nys:nyn,nxl:nxr) = v(nzb+1:nzt,nys:nyn,nxl:nxr)
+
+ CASE ( 'w' )
+ pr = 3
+ d(nzb+1:nzt,nys:nyn,nxl:nxr) = w(nzb+1:nzt,nys:nyn,nxl:nxr)
+
+ CASE ( 'pt' )
+ pr = 4
+ d(nzb+1:nzt,nys:nyn,nxl:nxr) = pt(nzb+1:nzt,nys:nyn,nxl:nxr)
+
+ CASE ( 'q' )
+ pr = 41
+ d(nzb+1:nzt,nys:nyn,nxl:nxr) = q(nzb+1:nzt,nys:nyn,nxl:nxr)
+
+ CASE DEFAULT
+ PRINT*, '+++ preprocess_spectra: Spectra of ', &
+ TRIM( data_output_sp(m) ), ' can not be calculated'
+
+ END SELECT
+
+!
+!-- Subtract horizontal mean from the array, for which spectra have to be
+!-- calculated
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ d(k,j,i) = d(k,j,i) - sums(k,pr)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE preprocess_spectra
+
+
+ SUBROUTINE calc_spectra_x( ddd, pr, m )
+
+ USE arrays_3d
+ USE constants
+ USE control_parameters
+ USE fft_xy
+ USE grid_variables
+ USE indices
+ USE pegrid
+ USE spectrum
+ USE statistics
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, ishape(1), j, k, m, n, pr
+
+ REAL :: fac, exponent
+ REAL, DIMENSION(0:nx) :: work
+ REAL, DIMENSION(0:nx/2) :: sums_spectra_l
+ REAL, DIMENSION(0:nx/2,10) :: sums_spectra
+
+ REAL, DIMENSION(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa) :: ddd
+
+!
+!-- Exponent for geometric average
+ exponent = 1.0 / ( nx + 1.0 )
+
+!
+!-- Loop over all levels defined by the user
+ n = 1
+ DO WHILE ( comp_spectra_level(n) /= 999999 .AND. n <= 10 )
+
+ k = comp_spectra_level(n)
+
+!
+!-- Calculate FFT only if the corresponding level is situated on this PE
+ IF ( k >= nzb_x .AND. k <= nzt_x ) THEN
+
+ DO j = nys_x, nyn_x
+
+ work = ddd(0:nx,j,k)
+ CALL fft_x( work, 'forward' )
+
+ ddd(0,j,k) = dx * work(0)**2
+ DO i = 1, nx/2
+ ddd(i,j,k) = dx * ( work(i)**2 + work(nx+1-i)**2 )
+ ENDDO
+
+ ENDDO
+
+!
+!-- Local sum and geometric average of these spectra
+!-- (WARNING: no global sum should be performed, because floating
+!-- point overflow may occur)
+ DO i = 0, nx/2
+
+ sums_spectra_l(i) = 1.0
+ DO j = nys_x, nyn_x
+ sums_spectra_l(i) = sums_spectra_l(i) * ddd(i,j,k)**exponent
+ ENDDO
+
+ ENDDO
+
+ ELSE
+
+ sums_spectra_l = 1.0
+
+ ENDIF
+
+!
+!-- Global sum of spectra on PE0 (from where they are written on file)
+ sums_spectra(:,n) = 0.0
+#if defined( __parallel )
+ CALL MPI_BARRIER( comm2d, ierr ) ! Necessary?
+ CALL MPI_REDUCE( sums_spectra_l(0), sums_spectra(0,n), nx/2+1, &
+ MPI_REAL, MPI_PROD, 0, comm2d, ierr )
+#else
+ sums_spectra(:,n) = sums_spectra_l
+#endif
+
+ n = n + 1
+
+ ENDDO
+ n = n - 1
+
+ IF ( myid == 0 ) THEN
+!
+!-- Sum of spectra for later averaging (see routine plot_spectra)
+!-- Temperton fft results need to be normalized
+ IF ( fft_method == 'temperton-algorithm' ) THEN
+ fac = nx + 1.0
+ ELSE
+ fac = 1.0
+ ENDIF
+ DO i = 1, nx/2
+ DO k = 1, n
+ spectrum_x(i,k,m) = spectrum_x(i,k,m) + sums_spectra(i,k) * fac
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+!
+!-- n_sp_x is needed by plot_spectra_x
+ n_sp_x = n
+
+ END SUBROUTINE calc_spectra_x
+
+
+ SUBROUTINE calc_spectra_y( ddd, pr, m )
+
+ USE arrays_3d
+ USE constants
+ USE control_parameters
+ USE fft_xy
+ USE grid_variables
+ USE indices
+ USE pegrid
+ USE spectrum
+ USE statistics
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, jshape(1), k, m, n, pr
+
+ REAL :: fac, exponent
+ REAL, DIMENSION(0:ny) :: work
+ REAL, DIMENSION(0:ny/2) :: sums_spectra_l
+ REAL, DIMENSION(0:ny/2,10) :: sums_spectra
+
+ REAL, DIMENSION(0:nya,nxl_yd:nxr_yda,nzb_yd:nzt_yda) :: ddd
+
+
+!
+!-- Exponent for geometric average
+ exponent = 1.0 / ( nx + 1.0 )
+
+!
+!-- Loop over all levels defined by the user
+ n = 1
+ DO WHILE ( comp_spectra_level(n) /= 999999 .AND. n <= 10 )
+
+ k = comp_spectra_level(n)
+
+!
+!-- Calculate FFT only if the corresponding level is situated on this PE
+ IF ( k >= nzb_yd .AND. k <= nzt_yd ) THEN
+
+ DO i = nxl_yd, nxr_yd
+
+ work = ddd(0:ny,i,k)
+ CALL fft_y( work, 'forward' )
+
+ ddd(0,i,k) = dy * work(0)**2
+ DO j = 1, ny/2
+ ddd(j,i,k) = dy * ( work(j)**2 + work(ny+1-j)**2 )
+ ENDDO
+
+ ENDDO
+
+!
+!-- Local sum and geometric average of these spectra
+!-- (WARNING: no global sum should be performed, because floating
+!-- point overflow may occur)
+ DO j = 0, ny/2
+
+ sums_spectra_l(j) = 1.0
+ DO i = nxl_yd, nxr_yd
+ sums_spectra_l(j) = sums_spectra_l(j) * ddd(j,i,k)**exponent
+ ENDDO
+
+ ENDDO
+
+ ELSE
+
+ sums_spectra_l = 1.0
+
+ ENDIF
+
+!
+!-- Global sum of spectra on PE0 (from where they are written on file)
+ sums_spectra(:,n) = 0.0
+#if defined( __parallel )
+ CALL MPI_BARRIER( comm2d, ierr ) ! Necessary?
+ CALL MPI_REDUCE( sums_spectra_l(0), sums_spectra(0,n), ny/2+1, &
+ MPI_REAL, MPI_PROD, 0, comm2d, ierr )
+#else
+ sums_spectra(:,n) = sums_spectra_l
+#endif
+
+ n = n + 1
+
+ ENDDO
+ n = n - 1
+
+
+ IF ( myid == 0 ) THEN
+!
+!-- Sum of spectra for later averaging (see routine plot_spectra)
+!-- Temperton fft results need to be normalized
+ IF ( fft_method == 'temperton-algorithm' ) THEN
+ fac = ny + 1.0
+ ELSE
+ fac = 1.0
+ ENDIF
+ DO j = 1, ny/2
+ DO k = 1, n
+ spectrum_y(j,k,m) = spectrum_y(j,k,m) + sums_spectra(j,k) * fac
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+!
+!-- n_sp_y is needed by plot_spectra_y
+ n_sp_y = n
+
+ END SUBROUTINE calc_spectra_y
+#endif
Index: /palm/tags/release-3.4a/SOURCE/check_for_restart.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/check_for_restart.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/check_for_restart.f90 (revision 141)
@@ -0,0 +1,146 @@
+ SUBROUTINE check_for_restart
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 108 2007-08-24 15:10:38Z letzel
+! modifications to terminate coupled runs
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.11 2007/02/11 12:55:13 raasch
+! Informative output to the job protocol
+!
+! Revision 1.1 1998/03/18 20:06:51 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Set stop flag, if restart is neccessary because of expiring cpu-time or
+! if it is forced by user
+!------------------------------------------------------------------------------!
+
+ USE pegrid
+ USE control_parameters
+
+ IMPLICIT NONE
+
+
+ LOGICAL :: terminate_run_l
+ REAL :: remaining_time
+
+
+!
+!-- Check remaining CPU-time
+ CALL local_tremain( remaining_time )
+
+!
+!-- If necessary set a flag to stop the model run
+ terminate_run_l = .FALSE.
+ IF ( remaining_time <= termination_time_needed .AND. &
+ write_binary(1:4) == 'true' ) THEN
+
+ terminate_run_l = .TRUE.
+ ENDIF
+
+#if defined( __parallel )
+!
+!-- Make a logical OR for all processes. Stop the model run if at least
+!-- one processor has reached the time limit.
+ CALL MPI_ALLREDUCE( terminate_run_l, terminate_run, 1, MPI_LOGICAL, &
+ MPI_LOR, comm2d, ierr )
+#else
+ terminate_run = terminate_run_l
+#endif
+
+!
+!-- Output that job will be terminated
+ IF ( terminate_run .AND. myid == 0 ) THEN
+ PRINT*, '*** WARNING: run will be terminated because it is running out', &
+ ' of job cpu limit'
+ PRINT*, ' remaining time: ', remaining_time, ' s'
+ PRINT*, ' termination time needed:', termination_time_needed,&
+ ' s'
+ ENDIF
+
+!
+!-- In case of coupled runs inform the remote model of the termination
+!-- and its reason, provided the remote model has not already been
+!-- informed of another termination reason (terminate_coupled > 0) before,
+!-- or vice versa (terminate_coupled_remote > 0).
+ IF ( terminate_run .AND. TRIM( coupling_mode ) /= 'uncoupled' .AND. &
+ terminate_coupled == 0 .AND. terminate_coupled_remote == 0 ) THEN
+
+ terminate_coupled = 3
+ CALL MPI_SENDRECV( terminate_coupled, 1, MPI_INTEGER, myid, 0, &
+ terminate_coupled_remote, 1, MPI_INTEGER, myid, 0, &
+ comm_inter, status, ierr )
+ ENDIF
+
+!
+!-- Set the stop flag also, if restart is forced by user
+ IF ( time_restart /= 9999999.9 .AND. time_restart < simulated_time ) &
+ THEN
+!
+!-- Restart is not neccessary, if the end time of the run (given by
+!-- the user) has been reached
+ IF ( simulated_time < end_time ) THEN
+ terminate_run = .TRUE.
+!
+!-- Increment restart time, if forced by user, otherwise set restart
+!-- time to default (no user restart)
+ IF ( dt_restart /= 9999999.9 ) THEN
+ time_restart = time_restart + dt_restart
+ ELSE
+ time_restart = 9999999.9
+ ENDIF
+
+ IF ( myid == 0 ) THEN
+ PRINT*, '*** INFORMATIVE: run will be terminated due to user ', &
+ 'settings of'
+ PRINT*, ' restart_time / dt_restart'
+ PRINT*, ' new restart time is: ', time_restart, ' s'
+ ENDIF
+!
+!-- In case of coupled runs inform the remote model of the termination
+!-- and its reason, provided the remote model has not already been
+!-- informed of another termination reason (terminate_coupled > 0) before,
+!-- or vice versa (terminate_coupled_remote > 0).
+ IF ( coupling_mode /= 'uncoupled' .AND. terminate_coupled == 0 .AND. &
+ terminate_coupled_remote == 0) THEN
+
+ IF ( dt_restart /= 9999999.9 ) THEN
+ terminate_coupled = 4
+ ELSE
+ terminate_coupled = 5
+ ENDIF
+ CALL MPI_SENDRECV( &
+ terminate_coupled, 1, MPI_INTEGER, myid, 0, &
+ terminate_coupled_remote, 1, MPI_INTEGER, myid, 0, &
+ comm_inter, status, ierr )
+ ENDIF
+ ELSE
+ time_restart = 9999999.9
+ ENDIF
+ ENDIF
+
+!
+!-- If the run is stopped, set a flag file which is necessary to initiate
+!-- the start of a continuation run
+ IF ( terminate_run .AND. myid == 0 ) THEN
+
+ OPEN ( 90, FILE='CONTINUE_RUN', FORM='FORMATTED' )
+ WRITE ( 90, '(A)' ) TRIM( run_description_header )
+ CLOSE ( 90 )
+
+ ENDIF
+
+
+ END SUBROUTINE check_for_restart
Index: /palm/tags/release-3.4a/SOURCE/check_open.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/check_open.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/check_open.f90 (revision 141)
@@ -0,0 +1,1245 @@
+ SUBROUTINE check_open( file_id )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 120 2007-10-17 11:54:43Z raasch
+! Status of 3D-volume NetCDF data file only depends on switch netcdf_64bit_3d
+!
+! 105 2007-08-08 07:12:55Z raasch
+! Different filenames are used in case of a coupled simulation,
+! coupling_char added to all relevant filenames
+!
+! 82 2007-04-16 15:40:52Z raasch
+! Call of local_getenv removed, preprocessor directives for old systems removed
+!
+! 46 2007-03-05 06:00:47Z raasch
+! +netcdf_64bit_3d to switch on 64bit offset only for 3D files
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.44 2006/08/22 13:48:34 raasch
+! xz and yz cross sections now up to nzt+1
+!
+! Revision 1.1 1997/08/11 06:10:55 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Check if file unit is open. If not, open file and, if necessary, write a
+! header or start other initializing actions, respectively.
+!------------------------------------------------------------------------------!
+
+ USE array_kind
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE netcdf_control
+ USE particle_attributes
+ USE pegrid
+ USE profil_parameter
+ USE statistics
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=2) :: suffix
+ CHARACTER (LEN=20) :: xtext = 'time in s'
+ CHARACTER (LEN=30) :: filename
+ CHARACTER (LEN=40) :: avs_coor_file, avs_coor_file_localname, &
+ avs_data_file_localname
+ CHARACTER (LEN=80) :: rtext
+ CHARACTER (LEN=100) :: avs_coor_file_catalog, avs_data_file_catalog, &
+ batch_scp, zeile
+ CHARACTER (LEN=400) :: command
+
+ INTEGER :: av, anzzeile = 1, cranz, file_id, i, iaddres, ierr1, iusern, &
+ j, k, legpos = 1, timodex = 1
+ INTEGER, DIMENSION(10) :: cucol, klist, lstyle
+
+ LOGICAL :: avs_coor_file_found = .FALSE., avs_data_file_found = .FALSE., &
+ datleg = .TRUE., get_filenames, grid = .TRUE., netcdf_extend, &
+ rand = .TRUE., swap = .TRUE., twoxa = .TRUE., twoya = .TRUE.
+
+ REAL :: ansx = -999.999, ansy = -999.999, gwid = 0.1, rlegfak = 1.5, &
+ sizex = 250.0, sizey = 40.0, texfac = 1.5
+
+ REAL, DIMENSION(:), ALLOCATABLE :: eta, ho, hu
+ REAL(spk), DIMENSION(:), ALLOCATABLE :: xkoor, ykoor, zkoor
+
+
+ NAMELIST /RAHMEN/ anzzeile, cranz, datleg, rtext, swap
+ NAMELIST /CROSS/ ansx, ansy, cucol, grid, gwid, klist, legpos, lstyle, &
+ rand, rlegfak, sizex, sizey, texfac, &
+ timodex, twoxa, twoya, xtext
+
+
+!
+!-- Immediate return if file already open
+ IF ( openfile(file_id)%opened ) RETURN
+
+!
+!-- Only certain files are allowed to be re-opened
+!-- NOTE: some of the other files perhaps also could be re-opened, but it
+!-- has not been checked so far, if it works!
+ IF ( openfile(file_id)%opened_before ) THEN
+ SELECT CASE ( file_id )
+ CASE ( 14, 21, 22, 23, 80:85 )
+ IF ( file_id == 14 .AND. openfile(file_id)%opened_before ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_open: re-open of unit ', &
+ ' 14 is not verified. Please check results!'
+ ENDIF
+ CONTINUE
+ CASE DEFAULT
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_open: re-opening of file-id ', file_id, &
+ ' is not allowed'
+ ENDIF
+ RETURN
+ END SELECT
+ ENDIF
+
+!
+!-- Check if file may be opened on the relevant PE
+ SELECT CASE ( file_id )
+
+ CASE ( 15, 16, 17, 18, 19, 40:49, 50:59, 81:84, 101:107, 109, 111:113, &
+ 116 )
+
+ IF ( myid /= 0 ) THEN
+ PRINT*,'+++ check_open: opening file-id ',file_id, &
+ ' not allowed for PE ',myid
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ CALL local_stop
+#endif
+ ENDIF
+
+ CASE ( 21, 22, 23 )
+
+ IF ( .NOT. data_output_2d_on_each_pe ) THEN
+ IF ( myid /= 0 ) THEN
+ PRINT*,'+++ check_open: opening file-id ',file_id, &
+ ' not allowed for PE ',myid
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ CALL local_stop
+#endif
+ ENDIF
+ ENDIF
+
+ CASE ( 27, 28, 29, 31, 32, 33, 71:73, 90:99 )
+
+!
+!-- File-ids that are used temporarily in other routines
+ PRINT*,'+++ check_open: opening file-id ',file_id, &
+ ' is not allowed since it is used otherwise'
+
+ END SELECT
+
+!
+!-- Open relevant files
+ SELECT CASE ( file_id )
+
+ CASE ( 11 )
+
+ OPEN ( 11, FILE='PARIN'//coupling_char, FORM='FORMATTED', &
+ STATUS='OLD' )
+
+ CASE ( 13 )
+
+ IF ( myid_char == '' ) THEN
+ OPEN ( 13, FILE='BININ'//coupling_char//myid_char, &
+ FORM='UNFORMATTED', STATUS='OLD' )
+ ELSE
+ OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/'//myid_char, &
+ FORM='UNFORMATTED', STATUS='OLD' )
+ ENDIF
+
+ CASE ( 14 )
+
+ IF ( myid_char == '' ) THEN
+ OPEN ( 14, FILE='BINOUT'//coupling_char//myid_char, &
+ FORM='UNFORMATTED', POSITION='APPEND' )
+ ELSE
+ IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
+ CALL local_system( 'mkdir BINOUT' // coupling_char )
+ ENDIF
+#if defined( __parallel )
+!
+!-- Set a barrier in order to allow that all other processors in the
+!-- directory created by PE0 can open their file
+ CALL MPI_BARRIER( comm2d, ierr )
+#endif
+ OPEN ( 14, FILE='BINOUT'//TRIM(coupling_char)//'/'//myid_char_14, &
+ FORM='UNFORMATTED', POSITION='APPEND' )
+ ENDIF
+
+ CASE ( 15 )
+
+ OPEN ( 15, FILE='RUN_CONTROL'//coupling_char, FORM='FORMATTED' )
+
+ CASE ( 16 )
+
+ OPEN ( 16, FILE='LIST_PROFIL'//coupling_char, FORM='FORMATTED' )
+
+ CASE ( 17 )
+
+ OPEN ( 17, FILE='LIST_PROFIL_1D'//coupling_char, FORM='FORMATTED' )
+
+ CASE ( 18 )
+
+ OPEN ( 18, FILE='CPU_MEASURES'//coupling_char, FORM='FORMATTED' )
+
+ CASE ( 19 )
+
+ OPEN ( 19, FILE='HEADER'//coupling_char, FORM='FORMATTED' )
+
+ CASE ( 20 )
+
+ IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
+ CALL local_system( 'mkdir DATA_LOG' // coupling_char )
+ ENDIF
+ IF ( myid_char == '' ) THEN
+ OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/_0000', &
+ FORM='UNFORMATTED', POSITION='APPEND' )
+ ELSE
+#if defined( __parallel )
+!
+!-- Set a barrier in order to allow that all other processors in the
+!-- directory created by PE0 can open their file
+ CALL MPI_BARRIER( comm2d, ierr )
+#endif
+ OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/'//myid_char,&
+ FORM='UNFORMATTED', POSITION='APPEND' )
+ ENDIF
+
+ CASE ( 21 )
+
+ IF ( data_output_2d_on_each_pe ) THEN
+ OPEN ( 21, FILE='PLOT2D_XY'//TRIM( coupling_char )//myid_char, &
+ FORM='UNFORMATTED', POSITION='APPEND' )
+ ELSE
+ OPEN ( 21, FILE='PLOT2D_XY'//coupling_char, &
+ FORM='UNFORMATTED', POSITION='APPEND' )
+ ENDIF
+
+ IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
+!
+!-- Output for combine_plot_fields
+ IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN
+ WRITE (21) -1, nx+1, -1, ny+1 ! total array size
+ WRITE (21) 0, nx+1, 0, ny+1 ! output part
+ ENDIF
+!
+!-- Determine and write ISO2D coordiante header
+ ALLOCATE( eta(0:ny+1), ho(0:nx+1), hu(0:nx+1) )
+ hu = 0.0
+ ho = (ny+1) * dy
+ DO i = 1, ny
+ eta(i) = REAL( i ) / ( ny + 1.0 )
+ ENDDO
+ eta(0) = 0.0
+ eta(ny+1) = 1.0
+
+ WRITE (21) dx,eta,hu,ho
+ DEALLOCATE( eta, ho, hu )
+
+!
+!-- Create output file for local parameters
+ IF ( iso2d_output ) THEN
+ OPEN ( 27, FILE='PLOT2D_XY_LOCAL'//coupling_char, &
+ FORM='FORMATTED', DELIM='APOSTROPHE' )
+ openfile(27)%opened = .TRUE.
+ ENDIF
+
+ ENDIF
+
+ CASE ( 22 )
+
+ IF ( data_output_2d_on_each_pe ) THEN
+ OPEN ( 22, FILE='PLOT2D_XZ'//TRIM( coupling_char )//myid_char, &
+ FORM='UNFORMATTED', POSITION='APPEND' )
+ ELSE
+ OPEN ( 22, FILE='PLOT2D_XZ'//coupling_char, FORM='UNFORMATTED', &
+ POSITION='APPEND' )
+ ENDIF
+
+ IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
+!
+!-- Output for combine_plot_fields
+ IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN
+ WRITE (22) -1, nx+1, 0, nz+1 ! total array size
+ WRITE (22) 0, nx+1, 0, nz+1 ! output part
+ ENDIF
+!
+!-- Determine and write ISO2D coordiante header
+ ALLOCATE( eta(0:nz+1), ho(0:nx+1), hu(0:nx+1) )
+ hu = 0.0
+ ho = zu(nz+1)
+ DO i = 1, nz
+ eta(i) = REAL( zu(i) ) / zu(nz+1)
+ ENDDO
+ eta(0) = 0.0
+ eta(nz+1) = 1.0
+
+ WRITE (22) dx,eta,hu,ho
+ DEALLOCATE( eta, ho, hu )
+!
+!-- Create output file for local parameters
+ OPEN ( 28, FILE='PLOT2D_XZ_LOCAL'//coupling_char, &
+ FORM='FORMATTED', DELIM='APOSTROPHE' )
+ openfile(28)%opened = .TRUE.
+
+ ENDIF
+
+ CASE ( 23 )
+
+ IF ( data_output_2d_on_each_pe ) THEN
+ OPEN ( 23, FILE='PLOT2D_YZ'//TRIM( coupling_char )//myid_char, &
+ FORM='UNFORMATTED', POSITION='APPEND' )
+ ELSE
+ OPEN ( 23, FILE='PLOT2D_YZ'//coupling_char, FORM='UNFORMATTED', &
+ POSITION='APPEND' )
+ ENDIF
+
+ IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
+!
+!-- Output for combine_plot_fields
+ IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN
+ WRITE (23) -1, ny+1, 0, nz+1 ! total array size
+ WRITE (23) 0, ny+1, 0, nz+1 ! output part
+ ENDIF
+!
+!-- Determine and write ISO2D coordiante header
+ ALLOCATE( eta(0:nz+1), ho(0:ny+1), hu(0:ny+1) )
+ hu = 0.0
+ ho = zu(nz+1)
+ DO i = 1, nz
+ eta(i) = REAL( zu(i) ) / zu(nz+1)
+ ENDDO
+ eta(0) = 0.0
+ eta(nz+1) = 1.0
+
+ WRITE (23) dx,eta,hu,ho
+ DEALLOCATE( eta, ho, hu )
+!
+!-- Create output file for local parameters
+ OPEN ( 29, FILE='PLOT2D_YZ_LOCAL'//coupling_char, &
+ FORM='FORMATTED', DELIM='APOSTROPHE' )
+ openfile(29)%opened = .TRUE.
+
+ ENDIF
+
+ CASE ( 30 )
+
+ OPEN ( 30, FILE='PLOT3D_DATA'//TRIM( coupling_char )//myid_char, &
+ FORM='UNFORMATTED' )
+!
+!-- Write coordinate file for AVS
+ IF ( myid == 0 ) THEN
+#if defined( __parallel )
+!
+!-- Specifications for combine_plot_fields
+ IF ( .NOT. do3d_compress ) THEN
+ WRITE ( 30 ) -1,nx+1,-1,ny+1,0,nz_do3d
+ WRITE ( 30 ) 0,nx+1,0,ny+1,0,nz_do3d
+ ENDIF
+#endif
+!
+!-- Write coordinate file for AVS:
+!-- First determine file names (including cyle numbers) of AVS files on
+!-- target machine (to which the files are to be transferred).
+!-- Therefore path information has to be obtained first.
+ IF ( avs_output ) THEN
+ iaddres = LEN_TRIM( return_addres )
+ iusern = LEN_TRIM( return_username )
+
+ OPEN ( 3, FILE='OUTPUT_FILE_CONNECTIONS', FORM='FORMATTED' )
+ DO WHILE ( .NOT. avs_coor_file_found .OR. &
+ .NOT. avs_data_file_found )
+
+ READ ( 3, '(A)', END=1 ) zeile
+
+ SELECT CASE ( zeile(1:11) )
+
+ CASE ( 'PLOT3D_COOR' )
+ READ ( 3, '(A/A)' ) avs_coor_file_catalog, &
+ avs_coor_file_localname
+ avs_coor_file_found = .TRUE.
+
+ CASE ( 'PLOT3D_DATA' )
+ READ ( 3, '(A/A)' ) avs_data_file_catalog, &
+ avs_data_file_localname
+ avs_data_file_found = .TRUE.
+
+ CASE DEFAULT
+ READ ( 3, '(A/A)' ) zeile, zeile
+
+ END SELECT
+
+ ENDDO
+!
+!-- Now the cycle numbers on the remote machine must be obtained
+!-- using batch_scp
+ 1 CLOSE ( 3 )
+ IF ( .NOT. avs_coor_file_found .OR. &
+ .NOT. avs_data_file_found ) THEN
+ PRINT*, '+++ check_open: no filename for AVS-data-file ', &
+ 'found in MRUN-config-file'
+ PRINT*, ' filename in FLD-file set to ', &
+ '"unknown"'
+
+ avs_coor_file = 'unknown'
+ avs_data_file = 'unknown'
+ ELSE
+ get_filenames = .TRUE.
+ IF ( TRIM( host ) == 'hpmuk' .OR. &
+ TRIM( host ) == 'lcmuk' ) THEN
+ batch_scp = '/home/raasch/pub/batch_scp'
+ ELSEIF ( TRIM( host ) == 'nech' ) THEN
+ batch_scp = '/ipf/b/b323011/pub/batch_scp'
+ ELSEIF ( TRIM( host ) == 'ibmh' .OR. &
+ TRIM( host ) == 'ibmb' ) THEN
+ batch_scp = '/home/h/niksiraa/pub/batch_scp'
+ ELSEIF ( TRIM( host ) == 't3eb' ) THEN
+ batch_scp = '/home/nhbksira/pub/batch_scp'
+ ELSE
+ PRINT*,'+++ check_open: no path for batch_scp on host "',&
+ TRIM( host ), '"'
+ get_filenames = .FALSE.
+ ENDIF
+
+ IF ( get_filenames ) THEN
+!
+!-- Determine the coordinate file name.
+!-- /etc/passwd serves as Dummy-Datei, because it is not
+!-- really transferred.
+ command = TRIM( batch_scp ) // ' -n -u ' // &
+ return_username(1:iusern) // ' ' // &
+ return_addres(1:iaddres) // ' /etc/passwd "' // &
+ TRIM( avs_coor_file_catalog ) // '" ' // &
+ TRIM( avs_coor_file_localname ) // ' > REMOTE_FILENAME'
+
+ CALL local_system( command )
+ OPEN ( 3, FILE='REMOTE_FILENAME', FORM='FORMATTED' )
+ READ ( 3, '(A)' ) avs_coor_file
+ CLOSE ( 3 )
+!
+!-- Determine the data file name
+ command = TRIM( batch_scp ) // ' -n -u ' // &
+ return_username(1:iusern) // ' ' // &
+ return_addres(1:iaddres) // ' /etc/passwd "' // &
+ TRIM( avs_data_file_catalog ) // '" ' // &
+ TRIM( avs_data_file_localname ) // ' > REMOTE_FILENAME'
+
+ CALL local_system( command )
+ OPEN ( 3, FILE='REMOTE_FILENAME', FORM='FORMATTED' )
+ READ ( 3, '(A)' ) avs_data_file
+ CLOSE ( 3 )
+
+ ELSE
+
+ avs_coor_file = 'unknown'
+ avs_data_file = 'unknown'
+
+ ENDIF
+
+ ENDIF
+
+!
+!-- Output of the coordinate file description for FLD-file
+ OPEN ( 33, FILE='PLOT3D_FLD_COOR', FORM='FORMATTED' )
+ openfile(33)%opened = .TRUE.
+ WRITE ( 33, 3300 ) TRIM( avs_coor_file ), &
+ TRIM( avs_coor_file ), (nx+2)*4, &
+ TRIM( avs_coor_file ), (nx+2)*4+(ny+2)*4
+
+
+ ALLOCATE( xkoor(0:nx+1), ykoor(0:ny+1), zkoor(0:nz_do3d) )
+ DO i = 0, nx+1
+ xkoor(i) = i * dx
+ ENDDO
+ DO j = 0, ny+1
+ ykoor(j) = j * dy
+ ENDDO
+ DO k = 0, nz_do3d
+ zkoor(k) = zu(k)
+ ENDDO
+
+!
+!-- Create and write on AVS coordinate file
+ OPEN ( 31, FILE='PLOT3D_COOR', FORM='UNFORMATTED' )
+ openfile(31)%opened = .TRUE.
+
+ WRITE (31) xkoor, ykoor, zkoor
+ DEALLOCATE( xkoor, ykoor, zkoor )
+
+!
+!-- Create FLD file (being written on in close_file)
+ OPEN ( 32, FILE='PLOT3D_FLD', FORM='FORMATTED' )
+ openfile(32)%opened = .TRUE.
+
+!
+!-- Create flag file for compressed 3D output,
+!-- influences output commands in mrun
+ IF ( do3d_compress ) THEN
+ OPEN ( 3, FILE='PLOT3D_COMPRESSED', FORM='FORMATTED' )
+ WRITE ( 3, '(1X)' )
+ CLOSE ( 3 )
+ ENDIF
+
+ ENDIF
+
+ ENDIF
+
+!
+!-- In case of data compression output of the coordinates of the
+!-- corresponding partial array of a PE only once at the top of the file
+ IF ( avs_output .AND. do3d_compress ) THEN
+ WRITE ( 30 ) nxl-1, nxr+1, nys-1, nyn+1, nzb, nz_do3d
+ ENDIF
+
+ CASE ( 40:49 )
+
+ IF ( statistic_regions == 0 .AND. file_id == 40 ) THEN
+ suffix = ''
+ ELSE
+ WRITE ( suffix, '(''_'',I1)' ) file_id - 40
+ ENDIF
+ OPEN ( file_id, FILE='PLOT1D_DATA'//TRIM( coupling_char )// &
+ TRIM( suffix ), &
+ FORM='FORMATTED' )
+!
+!-- Write contents comments at the top of the file
+ WRITE ( file_id, 4000 ) TRIM( run_description_header ) // ' ' // &
+ TRIM( region( file_id - 40 ) )
+
+ CASE ( 50:59 )
+
+ IF ( statistic_regions == 0 .AND. file_id == 50 ) THEN
+ suffix = ''
+ ELSE
+ WRITE ( suffix, '(''_'',I1)' ) file_id - 50
+ ENDIF
+ OPEN ( file_id, FILE='PLOTTS_DATA'//TRIM( coupling_char )// &
+ TRIM( suffix ), &
+ FORM='FORMATTED', RECL=496 )
+!
+!-- Write PROFIL parameter file for output of time series
+!-- NOTE: To be on the safe side, this output is done at the beginning of
+!-- the model run (in case of collapse) and it is repeated in
+!-- close_file, then, however, with value ranges for the coordinate
+!-- systems
+!
+!-- Firstly determine the number of the coordinate systems to be drawn
+ cranz = 0
+ DO j = 1, 10
+ IF ( cross_ts_number_count(j) /= 0 ) cranz = cranz+1
+ ENDDO
+ rtext = '\1.0 ' // TRIM( run_description_header ) // ' ' // &
+ TRIM( region( file_id - 50 ) )
+!
+!-- Write RAHMEN parameter
+ OPEN ( 90, FILE='PLOTTS_PAR'//TRIM( coupling_char )// &
+ TRIM( suffix ), &
+ FORM='FORMATTED', DELIM='APOSTROPHE' )
+ WRITE ( 90, RAHMEN )
+!
+!-- Determine and write CROSS parameters for the individual coordinate
+!-- systems
+ DO j = 1, 10
+ k = cross_ts_number_count(j)
+ IF ( k /= 0 ) THEN
+!
+!-- Store curve numbers, colours and line style
+ klist(1:k) = cross_ts_numbers(1:k,j)
+ klist(k+1:10) = 999999
+ cucol(1:k) = linecolors(1:k)
+ lstyle(1:k) = linestyles(1:k)
+!
+!-- Write CROSS parameter
+ WRITE ( 90, CROSS )
+
+ ENDIF
+ ENDDO
+
+ CLOSE ( 90 )
+!
+!-- Write all labels at the top of the data file, but only during the
+!-- first run of a sequence of jobs. The following jobs copy the time
+!-- series data to the bottom of that file.
+ IF ( runnr == 0 ) THEN
+ WRITE ( file_id, 5000 ) TRIM( run_description_header ) // &
+ ' ' // TRIM( region( file_id - 50 ) )
+ ENDIF
+
+
+ CASE ( 80 )
+
+ IF ( myid_char == '' ) THEN
+ OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM(coupling_char)//myid_char, &
+ FORM='FORMATTED', POSITION='APPEND' )
+ ELSE
+ IF ( myid == 0 .AND. .NOT. openfile(80)%opened_before ) THEN
+ CALL local_system( 'mkdir PARTICLE_INFOS' // coupling_char )
+ ENDIF
+#if defined( __parallel )
+!
+!-- Set a barrier in order to allow that thereafter all other
+!-- processors in the directory created by PE0 can open their file.
+!-- WARNING: The following barrier will lead to hanging jobs, if
+!-- check_open is first called from routine
+!-- allocate_prt_memory!
+ IF ( .NOT. openfile(80)%opened_before ) THEN
+ CALL MPI_BARRIER( comm2d, ierr )
+ ENDIF
+#endif
+ OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM( coupling_char )//'/'// &
+ myid_char, &
+ FORM='FORMATTED', POSITION='APPEND' )
+ ENDIF
+
+ IF ( .NOT. openfile(80)%opened_before ) THEN
+ WRITE ( 80, 8000 ) TRIM( run_description_header )
+ ENDIF
+
+ CASE ( 81 )
+
+ OPEN ( 81, FILE='PLOTSP_X_PAR'//coupling_char, FORM='FORMATTED', &
+ DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' )
+
+ CASE ( 82 )
+
+ OPEN ( 82, FILE='PLOTSP_X_DATA'//coupling_char, FORM='FORMATTED', &
+ POSITION = 'APPEND' )
+
+ CASE ( 83 )
+
+ OPEN ( 83, FILE='PLOTSP_Y_PAR'//coupling_char, FORM='FORMATTED', &
+ DELIM='APOSTROPHE', RECL=1500, POSITION='APPEND' )
+
+ CASE ( 84 )
+
+ OPEN ( 84, FILE='PLOTSP_Y_DATA'//coupling_char, FORM='FORMATTED', &
+ POSITION='APPEND' )
+
+ CASE ( 85 )
+
+ IF ( myid_char == '' ) THEN
+ OPEN ( 85, FILE='PARTICLE_DATA'//TRIM(coupling_char)//myid_char, &
+ FORM='UNFORMATTED', POSITION='APPEND' )
+ ELSE
+ IF ( myid == 0 .AND. .NOT. openfile(85)%opened_before ) THEN
+ CALL local_system( 'mkdir PARTICLE_DATA' // coupling_char )
+ ENDIF
+#if defined( __parallel )
+!
+!-- Set a barrier in order to allow that thereafter all other
+!-- processors in the directory created by PE0 can open their file
+ CALL MPI_BARRIER( comm2d, ierr )
+#endif
+ OPEN ( 85, FILE='PARTICLE_DATA'//TRIM( coupling_char )//'/'// &
+ myid_char, &
+ FORM='UNFORMATTED', POSITION='APPEND' )
+ ENDIF
+
+ IF ( .NOT. openfile(85)%opened_before ) THEN
+ WRITE ( 85 ) run_description_header
+!
+!-- Attention: change version number whenever the output format on
+!-- unit 85 is changed (see also in routine advec_particles)
+ rtext = 'data format version 3.0'
+ WRITE ( 85 ) rtext
+ WRITE ( 85 ) number_of_particle_groups, &
+ max_number_of_particle_groups
+ WRITE ( 85 ) particle_groups
+ ENDIF
+
+#if defined( __netcdf )
+ CASE ( 101, 111 )
+!
+!-- Set filename depending on unit number
+ IF ( file_id == 101 ) THEN
+ filename = 'DATA_2D_XY_NETCDF' // coupling_char
+ av = 0
+ ELSE
+ filename = 'DATA_2D_XY_AV_NETCDF' // coupling_char
+ av = 1
+ ENDIF
+!
+!-- Inquire, if there is a NetCDF file from a previuos run. This should
+!-- be opened for extension, if its dimensions and variables match the
+!-- actual run.
+ INQUIRE( FILE=filename, EXIST=netcdf_extend )
+
+ IF ( netcdf_extend ) THEN
+!
+!-- Open an existing NetCDF file for output
+ nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 20 )
+!
+!-- Read header information and set all ids. If there is a mismatch
+!-- between the previuos and the actual run, netcdf_extend is returned
+!-- as .FALSE.
+ CALL define_netcdf_header( 'xy', netcdf_extend, av )
+
+!
+!-- Remove the local file, if it can not be extended
+ IF ( .NOT. netcdf_extend ) THEN
+ nc_stat = NF90_CLOSE( id_set_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 21 )
+ CALL local_system( 'rm ' // TRIM( filename ) )
+ ENDIF
+
+ ENDIF
+
+ IF ( .NOT. netcdf_extend ) THEN
+!
+!-- Create a new NetCDF output file
+ IF ( netcdf_64bit ) THEN
+#if defined( __netcdf_64bit )
+ nc_stat = NF90_CREATE( filename, &
+ OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+ id_set_xy(av) )
+#else
+ IF ( myid == 0 ) PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+ 'offset allowed on this machine'
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xy(av) )
+#endif
+ ELSE
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xy(av) )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 22 )
+!
+!-- Define the header
+ CALL define_netcdf_header( 'xy', netcdf_extend, av )
+
+ ENDIF
+
+ CASE ( 102, 112 )
+!
+!-- Set filename depending on unit number
+ IF ( file_id == 102 ) THEN
+ filename = 'DATA_2D_XZ_NETCDF' // coupling_char
+ av = 0
+ ELSE
+ filename = 'DATA_2D_XZ_AV_NETCDF' // coupling_char
+ av = 1
+ ENDIF
+!
+!-- Inquire, if there is a NetCDF file from a previuos run. This should
+!-- be opened for extension, if its dimensions and variables match the
+!-- actual run.
+ INQUIRE( FILE=filename, EXIST=netcdf_extend )
+
+ IF ( netcdf_extend ) THEN
+!
+!-- Open an existing NetCDF file for output
+ nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 23 )
+!
+!-- Read header information and set all ids. If there is a mismatch
+!-- between the previuos and the actual run, netcdf_extend is returned
+!-- as .FALSE.
+ CALL define_netcdf_header( 'xz', netcdf_extend, av )
+
+!
+!-- Remove the local file, if it can not be extended
+ IF ( .NOT. netcdf_extend ) THEN
+ nc_stat = NF90_CLOSE( id_set_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 24 )
+ CALL local_system( 'rm ' // TRIM( filename ) )
+ ENDIF
+
+ ENDIF
+
+ IF ( .NOT. netcdf_extend ) THEN
+!
+!-- Create a new NetCDF output file
+ IF ( netcdf_64bit ) THEN
+#if defined( __netcdf_64bit )
+ nc_stat = NF90_CREATE( filename, &
+ OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+ id_set_xz(av) )
+#else
+ IF ( myid == 0 ) PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+ 'offset allowed on this machine'
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xz(av) )
+#endif
+ ELSE
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_xz(av) )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 25 )
+!
+!-- Define the header
+ CALL define_netcdf_header( 'xz', netcdf_extend, av )
+
+ ENDIF
+
+ CASE ( 103, 113 )
+!
+!-- Set filename depending on unit number
+ IF ( file_id == 103 ) THEN
+ filename = 'DATA_2D_YZ_NETCDF' // coupling_char
+ av = 0
+ ELSE
+ filename = 'DATA_2D_YZ_AV_NETCDF' // coupling_char
+ av = 1
+ ENDIF
+!
+!-- Inquire, if there is a NetCDF file from a previuos run. This should
+!-- be opened for extension, if its dimensions and variables match the
+!-- actual run.
+ INQUIRE( FILE=filename, EXIST=netcdf_extend )
+
+ IF ( netcdf_extend ) THEN
+!
+!-- Open an existing NetCDF file for output
+ nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 26 )
+!
+!-- Read header information and set all ids. If there is a mismatch
+!-- between the previuos and the actual run, netcdf_extend is returned
+!-- as .FALSE.
+ CALL define_netcdf_header( 'yz', netcdf_extend, av )
+
+!
+!-- Remove the local file, if it can not be extended
+ IF ( .NOT. netcdf_extend ) THEN
+ nc_stat = NF90_CLOSE( id_set_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 27 )
+ CALL local_system( 'rm ' // TRIM( filename ) )
+ ENDIF
+
+ ENDIF
+
+ IF ( .NOT. netcdf_extend ) THEN
+!
+!-- Create a new NetCDF output file
+ IF ( netcdf_64bit ) THEN
+#if defined( __netcdf_64bit )
+ nc_stat = NF90_CREATE( filename, &
+ OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET), &
+ id_set_yz(av) )
+#else
+ IF ( myid == 0 ) PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+ 'offset allowed on this machine'
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_yz(av) )
+#endif
+ ELSE
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_yz(av) )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 28 )
+!
+!-- Define the header
+ CALL define_netcdf_header( 'yz', netcdf_extend, av )
+
+ ENDIF
+
+ CASE ( 104 )
+!
+!-- Set filename
+ filename = 'DATA_1D_PR_NETCDF' // coupling_char
+
+!
+!-- Inquire, if there is a NetCDF file from a previuos run. This should
+!-- be opened for extension, if its variables match the actual run.
+ INQUIRE( FILE=filename, EXIST=netcdf_extend )
+
+ IF ( netcdf_extend ) THEN
+!
+!-- Open an existing NetCDF file for output
+ nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_pr )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 29 )
+!
+!-- Read header information and set all ids. If there is a mismatch
+!-- between the previuos and the actual run, netcdf_extend is returned
+!-- as .FALSE.
+ CALL define_netcdf_header( 'pr', netcdf_extend, 0 )
+
+!
+!-- Remove the local file, if it can not be extended
+ IF ( .NOT. netcdf_extend ) THEN
+ nc_stat = NF90_CLOSE( id_set_pr )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 30 )
+ CALL local_system( 'rm ' // TRIM( filename ) )
+ ENDIF
+
+ ENDIF
+
+ IF ( .NOT. netcdf_extend ) THEN
+!
+!-- Create a new NetCDF output file
+ IF ( netcdf_64bit ) THEN
+#if defined( __netcdf_64bit )
+ nc_stat = NF90_CREATE( filename, &
+ OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+ id_set_pr )
+#else
+ IF ( myid == 0 ) PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+ 'offset allowed on this machine'
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_pr )
+#endif
+ ELSE
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_pr )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 31 )
+!
+!-- Define the header
+ CALL define_netcdf_header( 'pr', netcdf_extend, 0 )
+
+ ENDIF
+
+ CASE ( 105 )
+!
+!-- Set filename
+ filename = 'DATA_1D_TS_NETCDF' // coupling_char
+
+!
+!-- Inquire, if there is a NetCDF file from a previuos run. This should
+!-- be opened for extension, if its variables match the actual run.
+ INQUIRE( FILE=filename, EXIST=netcdf_extend )
+
+ IF ( netcdf_extend ) THEN
+!
+!-- Open an existing NetCDF file for output
+ nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_ts )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 32 )
+!
+!-- Read header information and set all ids. If there is a mismatch
+!-- between the previuos and the actual run, netcdf_extend is returned
+!-- as .FALSE.
+ CALL define_netcdf_header( 'ts', netcdf_extend, 0 )
+
+!
+!-- Remove the local file, if it can not be extended
+ IF ( .NOT. netcdf_extend ) THEN
+ nc_stat = NF90_CLOSE( id_set_ts )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 33 )
+ CALL local_system( 'rm ' // TRIM( filename ) )
+ ENDIF
+
+ ENDIF
+
+ IF ( .NOT. netcdf_extend ) THEN
+!
+!-- Create a new NetCDF output file
+ IF ( netcdf_64bit ) THEN
+#if defined( __netcdf_64bit )
+ nc_stat = NF90_CREATE( filename, &
+ OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+ id_set_ts )
+#else
+ IF ( myid == 0 ) PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+ 'offset allowed on this machine'
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_ts )
+#endif
+ ELSE
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_ts )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 34 )
+!
+!-- Define the header
+ CALL define_netcdf_header( 'ts', netcdf_extend, 0 )
+
+ ENDIF
+
+
+ CASE ( 106, 116 )
+!
+!-- Set filename depending on unit number
+ IF ( file_id == 106 ) THEN
+ filename = 'DATA_3D_NETCDF' // coupling_char
+ av = 0
+ ELSE
+ filename = 'DATA_3D_AV_NETCDF' // coupling_char
+ av = 1
+ ENDIF
+!
+!-- Inquire, if there is a NetCDF file from a previuos run. This should
+!-- be opened for extension, if its dimensions and variables match the
+!-- actual run.
+ INQUIRE( FILE=filename, EXIST=netcdf_extend )
+
+ IF ( netcdf_extend ) THEN
+!
+!-- Open an existing NetCDF file for output
+ nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 35 )
+!
+!-- Read header information and set all ids. If there is a mismatch
+!-- between the previuos and the actual run, netcdf_extend is returned
+!-- as .FALSE.
+ CALL define_netcdf_header( '3d', netcdf_extend, av )
+
+!
+!-- Remove the local file, if it can not be extended
+ IF ( .NOT. netcdf_extend ) THEN
+ nc_stat = NF90_CLOSE( id_set_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 36 )
+ CALL local_system('rm ' // TRIM( filename ) )
+ ENDIF
+
+ ENDIF
+
+ IF ( .NOT. netcdf_extend ) THEN
+!
+!-- Create a new NetCDF output file
+ IF ( netcdf_64bit_3d ) THEN
+#if defined( __netcdf_64bit )
+ nc_stat = NF90_CREATE( filename, &
+ OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+ id_set_3d(av) )
+#else
+ IF ( myid == 0 ) PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+ 'offset allowed on this machine'
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_3d(av) )
+#endif
+ ELSE
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_3d(av) )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 37 )
+!
+!-- Define the header
+ CALL define_netcdf_header( '3d', netcdf_extend, av )
+
+ ENDIF
+
+
+ CASE ( 107 )
+!
+!-- Set filename
+ filename = 'DATA_1D_SP_NETCDF' // coupling_char
+
+!
+!-- Inquire, if there is a NetCDF file from a previuos run. This should
+!-- be opened for extension, if its variables match the actual run.
+ INQUIRE( FILE=filename, EXIST=netcdf_extend )
+
+ IF ( netcdf_extend ) THEN
+!
+!-- Open an existing NetCDF file for output
+ nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 38 )
+!
+!-- Read header information and set all ids. If there is a mismatch
+!-- between the previuos and the actual run, netcdf_extend is returned
+!-- as .FALSE.
+ CALL define_netcdf_header( 'sp', netcdf_extend, 0 )
+
+!
+!-- Remove the local file, if it can not be extended
+ IF ( .NOT. netcdf_extend ) THEN
+ nc_stat = NF90_CLOSE( id_set_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 39 )
+ CALL local_system( 'rm ' // TRIM( filename ) )
+ ENDIF
+
+ ENDIF
+
+ IF ( .NOT. netcdf_extend ) THEN
+!
+!-- Create a new NetCDF output file
+ IF ( netcdf_64bit ) THEN
+#if defined( __netcdf_64bit )
+ nc_stat = NF90_CREATE( filename, &
+ OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+ id_set_sp )
+#else
+ IF ( myid == 0 ) PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+ 'offset allowed on this machine'
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_sp )
+#endif
+ ELSE
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_sp )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 40 )
+!
+!-- Define the header
+ CALL define_netcdf_header( 'sp', netcdf_extend, 0 )
+
+ ENDIF
+
+
+ CASE ( 108 )
+
+ IF ( myid_char == '' ) THEN
+ filename = 'DATA_PRT_NETCDF' // coupling_char
+ ELSE
+ filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char ) // '/' // &
+ myid_char
+ ENDIF
+!
+!-- Inquire, if there is a NetCDF file from a previuos run. This should
+!-- be opened for extension, if its variables match the actual run.
+ INQUIRE( FILE=filename, EXIST=netcdf_extend )
+
+ IF ( netcdf_extend ) THEN
+!
+!-- Open an existing NetCDF file for output
+ nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_prt )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 41 )
+!
+!-- Read header information and set all ids. If there is a mismatch
+!-- between the previuos and the actual run, netcdf_extend is returned
+!-- as .FALSE.
+ CALL define_netcdf_header( 'pt', netcdf_extend, 0 )
+
+!
+!-- Remove the local file, if it can not be extended
+ IF ( .NOT. netcdf_extend ) THEN
+ nc_stat = NF90_CLOSE( id_set_prt )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 42 )
+ CALL local_system( 'rm ' // filename )
+ ENDIF
+
+ ENDIF
+
+ IF ( .NOT. netcdf_extend ) THEN
+
+!
+!-- For runs on multiple processors create the subdirectory
+ IF ( myid_char /= '' ) THEN
+ IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) &
+ THEN ! needs modification in case of non-extendable sets
+ CALL local_system( 'mkdir DATA_PRT_NETCDF' // &
+ TRIM( coupling_char ) // '/' )
+ ENDIF
+#if defined( __parallel )
+!
+!-- Set a barrier in order to allow that all other processors in the
+!-- directory created by PE0 can open their file
+ CALL MPI_BARRIER( comm2d, ierr )
+#endif
+ ENDIF
+
+!
+!-- Create a new NetCDF output file
+ IF ( netcdf_64bit ) THEN
+#if defined( __netcdf_64bit )
+ nc_stat = NF90_CREATE( filename, &
+ OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+ id_set_prt )
+#else
+ IF ( myid == 0 ) PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+ 'offset allowed on this machine'
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_prt )
+#endif
+ ELSE
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_prt )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 43 )
+
+!
+!-- Define the header
+ CALL define_netcdf_header( 'pt', netcdf_extend, 0 )
+
+ ENDIF
+
+ CASE ( 109 )
+!
+!-- Set filename
+ filename = 'DATA_1D_PTS_NETCDF' // coupling_char
+
+!
+!-- Inquire, if there is a NetCDF file from a previuos run. This should
+!-- be opened for extension, if its variables match the actual run.
+ INQUIRE( FILE=filename, EXIST=netcdf_extend )
+
+ IF ( netcdf_extend ) THEN
+!
+!-- Open an existing NetCDF file for output
+ nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set_pts )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 393 )
+!
+!-- Read header information and set all ids. If there is a mismatch
+!-- between the previuos and the actual run, netcdf_extend is returned
+!-- as .FALSE.
+ CALL define_netcdf_header( 'ps', netcdf_extend, 0 )
+
+!
+!-- Remove the local file, if it can not be extended
+ IF ( .NOT. netcdf_extend ) THEN
+ nc_stat = NF90_CLOSE( id_set_pts )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 394 )
+ CALL local_system( 'rm ' // TRIM( filename ) )
+ ENDIF
+
+ ENDIF
+
+ IF ( .NOT. netcdf_extend ) THEN
+!
+!-- Create a new NetCDF output file
+ IF ( netcdf_64bit ) THEN
+#if defined( __netcdf_64bit )
+ nc_stat = NF90_CREATE( filename, &
+ OR( NF90_NOCLOBBER, NF90_64BIT_OFFSET ),&
+ id_set_pts )
+#else
+ IF ( myid == 0 ) PRINT*, '+++ WARNING: NetCDF: no 64-bit ', &
+ 'offset allowed on this machine'
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_pts )
+#endif
+ ELSE
+ nc_stat = NF90_CREATE( filename, NF90_NOCLOBBER, id_set_pts )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 395 )
+!
+!-- Define the header
+ CALL define_netcdf_header( 'ps', netcdf_extend, 0 )
+
+ ENDIF
+#else
+
+ CASE ( 101:109, 111:113, 116 )
+
+!
+!-- Nothing is done in case of missing netcdf support
+ RETURN
+
+#endif
+
+ CASE DEFAULT
+
+ PRINT*,'+++ check_open: no OPEN-statement for file-id ',file_id
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ CALL local_stop
+#endif
+
+ END SELECT
+
+!
+!-- Set open flag
+ openfile(file_id)%opened = .TRUE.
+
+!
+!-- Formats
+3300 FORMAT ('#'/ &
+ 'coord 1 file=',A,' filetype=unformatted'/ &
+ 'coord 2 file=',A,' filetype=unformatted skip=',I6/ &
+ 'coord 3 file=',A,' filetype=unformatted skip=',I6/ &
+ '#')
+4000 FORMAT ('# ',A)
+5000 FORMAT ('# ',A/ &
+ '#1 E'/'#2 E*'/'#3 dt'/'#4 u*'/'#5 th*'/'#6 umax'/'#7 vmax'/ &
+ '#8 wmax'/'#9 div_new'/'#10 div_old'/'#11 z_i_wpt'/'#12 z_i_pt'/ &
+ '#13 w*'/'#14 w''pt''0'/'#15 w''pt'''/'#16 wpt'/'#17 pt(0)'/ &
+ '#18 pt(zp)'/'#19 splptx'/'#20 splpty'/'#21 splptz')
+8000 FORMAT (A/ &
+ ' step time # of parts lPE sent/recv rPE sent/recv ',&
+ 'sPE sent/recv nPE sent/recv max # of parts'/ &
+ 103('-'))
+
+ END SUBROUTINE check_open
Index: /palm/tags/release-3.4a/SOURCE/check_parameters.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/check_parameters.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/check_parameters.f90 (revision 141)
@@ -0,0 +1,3081 @@
+ SUBROUTINE check_parameters
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 138 2007-11-28 10:03:58Z letzel
+! Plant canopy added
+! Allow new case bc_uv_t = 'dirichlet_0' for channel flow.
+! Multigrid solver allows topography, checking of dt_sort_particles
+! Bugfix: initializing u_init and v_init in case of ocean runs
+!
+! 109 2007-08-28 15:26:47Z letzel
+! Check coupling_mode and set default (obligatory) values (like boundary
+! conditions for temperature and fluxes) in case of coupled runs.
+! +profiles for w*p* and w"e
+! Bugfix: Error message concerning output of particle concentration (pc)
+! modified
+! More checks and more default values for coupled runs
+! allow data_output_pr= q, wq, w"q", w*q* for humidity = .T. (instead of
+! cloud_physics = .T.)
+! Rayleigh damping for ocean fixed.
+! Check and, if necessary, set default value for dt_coupling
+!
+! 97 2007-06-21 08:23:15Z raasch
+! Initial salinity profile is calculated, salinity boundary conditions are
+! checked,
+! z_max_do1d is checked only in case of ocean = .f.,
+! +initial temperature and geostrophic velocity profiles for the ocean version,
+! use_pt_reference renamed use_reference
+!
+! 89 2007-05-25 12:08:31Z raasch
+! Check for user-defined profiles
+!
+! 75 2007-03-22 09:54:05Z raasch
+! "by_user" allowed as initializing action, -data_output_ts,
+! leapfrog with non-flat topography not allowed any more, loop_optimization
+! and pt_reference are checked, moisture renamed humidity,
+! output of precipitation amount/rate and roughnes length + check
+! possible negative humidities are avoided in initial profile,
+! dirichlet/neumann changed to dirichlet/radiation, etc.,
+! revision added to run_description_header
+!
+! 20 2007-02-26 00:12:32Z raasch
+! Temperature and humidity gradients at top are now calculated for nzt+1,
+! top_heatflux and respective boundary condition bc_pt_t is checked
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.61 2006/08/04 14:20:25 raasch
+! do2d_unit and do3d_unit now defined as 2d-arrays, check of
+! use_upstream_for_tke, default value for dt_dopts,
+! generation of file header moved from routines palm and header to here
+!
+! Revision 1.1 1997/08/26 06:29:23 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Check control parameters and deduce further quantities.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE constants
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE model_1d
+ USE netcdf_control
+ USE particle_attributes
+ USE pegrid
+ USE profil_parameter
+ USE statistics
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=1) :: sq
+ CHARACTER (LEN=6) :: var
+ CHARACTER (LEN=7) :: unit
+ CHARACTER (LEN=8) :: date
+ CHARACTER (LEN=10) :: time
+ CHARACTER (LEN=40) :: coupling_string
+ CHARACTER (LEN=100) :: action
+
+ INTEGER :: i, ilen, intervals, iremote = 0, iter, j, k, nnxh, nnyh, &
+ position, prec
+ LOGICAL :: found, ldum
+ REAL :: gradient, maxn, maxp, remote = 0.0
+
+!
+!-- Warning, if host is not set
+ IF ( host(1:1) == ' ' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ WARNING: check_parameters:'
+ PRINT*, ' "host" is not set. Please check that environment', &
+ ' variable "localhost"'
+ PRINT*, ' is set before running PALM'
+ ENDIF
+ ENDIF
+
+!
+!-- Check the coupling mode
+ IF ( coupling_mode /= 'uncoupled' .AND. &
+ coupling_mode /= 'atmosphere_to_ocean' .AND. &
+ coupling_mode /= 'ocean_to_atmosphere' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' illegal coupling mode: ', TRIM( coupling_mode )
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Check dt_coupling, restart_time, dt_restart, end_time, dx, dy, nx and ny
+ IF ( coupling_mode /= 'uncoupled' ) THEN
+ IF ( dt_coupling == 9999999.9 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' dt_coupling is not set but required for coupling ', &
+ 'mode: ', TRIM( coupling_mode )
+ ENDIF
+ CALL local_stop
+ ENDIF
+#if defined( __parallel ) && defined( __mpi2 )
+ CALL MPI_SEND( dt_coupling, 1, MPI_REAL, myid, 11, comm_inter, ierr )
+ CALL MPI_RECV( remote, 1, MPI_REAL, myid, 11, comm_inter, status, ierr )
+ IF ( dt_coupling /= remote ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' TRIM( coupling_mode ): dt_coupling = ', dt_coupling
+ PRINT*, ' is not equal to dt_coupling_remote = ', remote
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( dt_coupling <= 0.0 ) THEN
+ CALL MPI_SEND( dt_max, 1, MPI_REAL, myid, 19, comm_inter, ierr )
+ CALL MPI_RECV( remote, 1, MPI_REAL, myid, 19, comm_inter, status, &
+ ierr )
+ dt_coupling = MAX( dt_max, remote )
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' TRIM( coupling_mode ): dt_coupling <= 0.0'
+ PRINT*, ' is not allowed and is reset to MAX(dt_max(A,O)) = ', &
+ dt_coupling
+ ENDIF
+ ENDIF
+ CALL MPI_SEND( restart_time, 1, MPI_REAL, myid, 12, comm_inter, ierr )
+ CALL MPI_RECV( remote, 1, MPI_REAL, myid, 12, comm_inter, status, ierr )
+ IF ( restart_time /= remote ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' TRIM( coupling_mode ): restart_time = ', restart_time
+ PRINT*, ' is not equal to restart_time_remote = ', remote
+ ENDIF
+ CALL local_stop
+ ENDIF
+ CALL MPI_SEND( dt_restart, 1, MPI_REAL, myid, 13, comm_inter, ierr )
+ CALL MPI_RECV( remote, 1, MPI_REAL, myid, 13, comm_inter, status, ierr )
+ IF ( dt_restart /= remote ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' TRIM( coupling_mode ): dt_restart = ', dt_restart
+ PRINT*, ' is not equal to dt_restart_remote = ', remote
+ ENDIF
+ CALL local_stop
+ ENDIF
+ CALL MPI_SEND( end_time, 1, MPI_REAL, myid, 14, comm_inter, ierr )
+ CALL MPI_RECV( remote, 1, MPI_REAL, myid, 14, comm_inter, status, ierr )
+ IF ( end_time /= remote ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' TRIM( coupling_mode ): end_time = ', end_time
+ PRINT*, ' is not equal to end_time_remote = ', remote
+ ENDIF
+ CALL local_stop
+ ENDIF
+ CALL MPI_SEND( dx, 1, MPI_REAL, myid, 15, comm_inter, ierr )
+ CALL MPI_RECV( remote, 1, MPI_REAL, myid, 15, comm_inter, status, ierr )
+ IF ( dx /= remote ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' TRIM( coupling_mode ): dx = ', dx
+ PRINT*, ' is not equal to dx_remote = ', remote
+ ENDIF
+ CALL local_stop
+ ENDIF
+ CALL MPI_SEND( dy, 1, MPI_REAL, myid, 16, comm_inter, ierr )
+ CALL MPI_RECV( remote, 1, MPI_REAL, myid, 16, comm_inter, status, ierr )
+ IF ( dy /= remote ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' TRIM( coupling_mode ): dy = ', dy
+ PRINT*, ' is not equal to dy_remote = ', remote
+ ENDIF
+ CALL local_stop
+ ENDIF
+ CALL MPI_SEND( nx, 1, MPI_INTEGER, myid, 17, comm_inter, ierr )
+ CALL MPI_RECV( iremote, 1, MPI_INTEGER, myid, 17, comm_inter, status, &
+ ierr )
+ IF ( nx /= iremote ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' TRIM( coupling_mode ): nx = ', nx
+ PRINT*, ' is not equal to nx_remote = ', iremote
+ ENDIF
+ CALL local_stop
+ ENDIF
+ CALL MPI_SEND( ny, 1, MPI_INTEGER, myid, 18, comm_inter, ierr )
+ CALL MPI_RECV( iremote, 1, MPI_INTEGER, myid, 18, comm_inter, status, &
+ ierr )
+ IF ( ny /= iremote ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' TRIM( coupling_mode ): ny = ', ny
+ PRINT*, ' is not equal to ny_remote = ', iremote
+ ENDIF
+ CALL local_stop
+ ENDIF
+#endif
+ ENDIF
+
+#if defined( __parallel ) && defined( __mpi2 )
+!
+!-- Exchange via intercommunicator
+ IF ( coupling_mode == 'atmosphere_to_ocean' ) THEN
+ CALL MPI_SEND( humidity, &
+ 1, MPI_LOGICAL, myid, 19, comm_inter, ierr )
+ ELSEIF ( coupling_mode == 'ocean_to_atmosphere' ) THEN
+ CALL MPI_RECV( humidity_remote, &
+ 1, MPI_LOGICAL, myid, 19, comm_inter, status, ierr )
+ ENDIF
+#endif
+
+
+!
+!-- Generate the file header which is used as a header for most of PALM's
+!-- output files
+ CALL DATE_AND_TIME( date, time )
+ run_date = date(7:8)//'-'//date(5:6)//'-'//date(3:4)
+ run_time = time(1:2)//':'//time(3:4)//':'//time(5:6)
+ IF ( coupling_mode == 'uncoupled' ) THEN
+ coupling_string = ''
+ ELSEIF ( coupling_mode == 'atmosphere_to_ocean' ) THEN
+ coupling_string = ' coupled (atmosphere)'
+ ELSEIF ( coupling_mode == 'ocean_to_atmosphere' ) THEN
+ coupling_string = ' coupled (ocean)'
+ ENDIF
+
+ WRITE ( run_description_header, &
+ '(A,2X,A,2X,A,A,A,I2.2,A,2X,A,A,2X,A,1X,A)' ) &
+ TRIM( version ), TRIM( revision ), 'run: ', &
+ TRIM( run_identifier ), '.', runnr, TRIM( coupling_string ), &
+ 'host: ', TRIM( host ), run_date, run_time
+
+!
+!-- Check the general loop optimization method
+ IF ( loop_optimization == 'default' ) THEN
+ IF ( host(1:3) == 'nec' ) THEN
+ loop_optimization = 'vector'
+ ELSE
+ loop_optimization = 'cache'
+ ENDIF
+ ENDIF
+ IF ( loop_optimization /= 'noopt' .AND. loop_optimization /= 'cache' &
+ .AND. loop_optimization /= 'vector' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' illegal value given for loop_optimization: ', &
+ TRIM( loop_optimization )
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Check topography setting (check for illegal parameter combinations)
+ IF ( topography /= 'flat' ) THEN
+ action = ' '
+ IF ( scalar_advec /= 'pw-scheme' ) THEN
+ WRITE( action, '(A,A)' ) 'scalar_advec = ', scalar_advec
+ ENDIF
+ IF ( momentum_advec /= 'pw-scheme' ) THEN
+ WRITE( action, '(A,A)' ) 'momentum_advec = ', momentum_advec
+ ENDIF
+ IF ( timestep_scheme(1:8) == 'leapfrog' ) THEN
+ WRITE( action, '(A,A)' ) 'timestep_scheme = ', timestep_scheme
+ ENDIF
+ IF ( psolver == 'sor' ) THEN
+ WRITE( action, '(A,A)' ) 'psolver = ', psolver
+ ENDIF
+ IF ( sloping_surface ) THEN
+ WRITE( action, '(A)' ) 'sloping surface = .TRUE.'
+ ENDIF
+ IF ( galilei_transformation ) THEN
+ WRITE( action, '(A)' ) 'galilei_transformation = .TRUE.'
+ ENDIF
+ IF ( cloud_physics ) THEN
+ WRITE( action, '(A)' ) 'cloud_physics = .TRUE.'
+ ENDIF
+ IF ( cloud_droplets ) THEN
+ WRITE( action, '(A)' ) 'cloud_droplets = .TRUE.'
+ ENDIF
+ IF ( humidity ) THEN
+ WRITE( action, '(A)' ) 'humidity = .TRUE.'
+ ENDIF
+ IF ( .NOT. prandtl_layer ) THEN
+ WRITE( action, '(A)' ) 'prandtl_layer = .FALSE.'
+ ENDIF
+ IF ( action /= ' ' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' a non-flat topography does not allow ', TRIM( action )
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+
+!
+!-- Check ocean setting
+ IF ( ocean ) THEN
+ action = ' '
+ IF ( timestep_scheme(1:8) == 'leapfrog' ) THEN
+ WRITE( action, '(A,A)' ) 'timestep_scheme = ', timestep_scheme
+ ENDIF
+ IF ( momentum_advec == 'ups-scheme' ) THEN
+ WRITE( action, '(A,A)' ) 'momentum_advec = ', momentum_advec
+ ENDIF
+ IF ( action /= ' ' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' ocean = .T. does not allow ', TRIM( action )
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+
+!
+!-- Check whether there are any illegal values
+!-- Pressure solver:
+ IF ( psolver /= 'poisfft' .AND. psolver /= 'poisfft_hybrid' .AND. &
+ psolver /= 'sor' .AND. psolver /= 'multigrid' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown solver for perturbation pressure: psolver=', &
+ psolver
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+#if defined( __parallel )
+ IF ( psolver == 'poisfft_hybrid' .AND. pdims(2) /= 1 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' psolver="', TRIM( psolver ), '" only works for a ', &
+ '1d domain-decomposition along x'
+ PRINT*, ' please do not set npey/=1 in the parameter file'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( ( psolver == 'poisfft_hybrid' .OR. psolver == 'multigrid' ) .AND. &
+ ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' psolver="', TRIM( psolver ), '" does not work for ', &
+ 'subdomains with unequal size'
+ PRINT*, ' please set grid_matching = ''strict'' in the parameter',&
+ ' file'
+ ENDIF
+ CALL local_stop
+ ENDIF
+#else
+ IF ( psolver == 'poisfft_hybrid' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' psolver="', TRIM( psolver ), '" only works for a ', &
+ 'parallel environment'
+ ENDIF
+ CALL local_stop
+ ENDIF
+#endif
+
+ IF ( psolver == 'multigrid' ) THEN
+ IF ( cycle_mg == 'w' ) THEN
+ gamma_mg = 2
+ ELSEIF ( cycle_mg == 'v' ) THEN
+ gamma_mg = 1
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown multigrid cycle: cycle_mg=', cycle_mg
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+
+ IF ( fft_method /= 'singleton-algorithm' .AND. &
+ fft_method /= 'temperton-algorithm' .AND. &
+ fft_method /= 'system-specific' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown fft-algorithm: fft_method=', fft_method
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Advection schemes:
+ IF ( momentum_advec /= 'pw-scheme' .AND. momentum_advec /= 'ups-scheme' ) &
+ THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: unknown advection ', &
+ 'scheme: momentum_advec=', momentum_advec
+ CALL local_stop
+ ENDIF
+ IF ( ( momentum_advec == 'ups-scheme' .OR. scalar_advec == 'ups-scheme' )&
+ .AND. timestep_scheme /= 'euler' ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: momentum_advec=', &
+ momentum_advec, ' is not allowed with ', &
+ 'timestep_scheme=', timestep_scheme
+ CALL local_stop
+ ENDIF
+
+ IF ( scalar_advec /= 'pw-scheme' .AND. scalar_advec /= 'bc-scheme' .AND.&
+ scalar_advec /= 'ups-scheme' ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: unknown advection ', &
+ 'scheme: scalar_advec=', scalar_advec
+ CALL local_stop
+ ENDIF
+
+ IF ( use_sgs_for_particles .AND. .NOT. use_upstream_for_tke ) THEN
+ use_upstream_for_tke = .TRUE.
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ WARNING: check_parameters: use_upstream_for_tke set ', &
+ '.TRUE. because use_sgs_for_particles = .TRUE.'
+ ENDIF
+ ENDIF
+
+ IF ( use_upstream_for_tke .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: use_upstream_for_tke = .TRUE. ', &
+ 'not allowed with timestep_scheme=', timestep_scheme
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Timestep schemes:
+ SELECT CASE ( TRIM( timestep_scheme ) )
+
+ CASE ( 'euler' )
+ intermediate_timestep_count_max = 1
+ asselin_filter_factor = 0.0
+
+ CASE ( 'leapfrog', 'leapfrog+euler' )
+ intermediate_timestep_count_max = 1
+
+ CASE ( 'runge-kutta-2' )
+ intermediate_timestep_count_max = 2
+ asselin_filter_factor = 0.0
+
+ CASE ( 'runge-kutta-3' )
+ intermediate_timestep_count_max = 3
+ asselin_filter_factor = 0.0
+
+ CASE DEFAULT
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: unknown timestep ',&
+ 'scheme: timestep_scheme=', timestep_scheme
+ CALL local_stop
+
+ END SELECT
+
+ IF ( scalar_advec == 'ups-scheme' .AND. timestep_scheme(1:5) == 'runge' )&
+ THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: scalar advection scheme "', &
+ TRIM( scalar_advec ), '"'
+ PRINT*, ' does not work with timestep_scheme "', &
+ TRIM( timestep_scheme ), '"'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ IF ( momentum_advec /= 'pw-scheme' .AND. timestep_scheme(1:5) == 'runge' ) &
+ THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: momentum advection scheme "', &
+ TRIM( momentum_advec ), '"'
+ PRINT*, ' does not work with timestep_scheme "', &
+ TRIM( timestep_scheme ), '"'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+
+ IF ( initializing_actions == ' ' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check parameters:'
+ PRINT*, ' no value found for initializing_actions'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
+!
+!-- No model continuation run; several initialising actions are possible
+ action = initializing_actions
+ DO WHILE ( TRIM( action ) /= '' )
+ position = INDEX( action, ' ' )
+ SELECT CASE ( action(1:position-1) )
+
+ CASE ( 'set_constant_profiles', 'set_1d-model_profiles', &
+ 'by_user', 'initialize_vortex', 'initialize_ptanom' )
+ action = action(position+1:)
+
+ CASE DEFAULT
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: initializi', &
+ 'ng_action unkown or not allowed: action = "', &
+ TRIM(action), '"'
+ CALL local_stop
+
+ END SELECT
+ ENDDO
+ ENDIF
+ IF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 .AND. &
+ INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: initializing_actions', &
+ '"set_constant_profiles" and "set_1d-model_profiles" are not', &
+ ' allowed simultaneously'
+ CALL local_stop
+ ENDIF
+ IF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 .AND. &
+ INDEX( initializing_actions, 'by_user' ) /= 0 ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: initializing_actions', &
+ '"set_constant_profiles" and "by_user" are not', &
+ ' allowed simultaneously'
+ CALL local_stop
+ ENDIF
+ IF ( INDEX( initializing_actions, 'by_user' ) /= 0 .AND. &
+ INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: initializing_actions', &
+ '"by_user" and "set_1d-model_profiles" are not', &
+ ' allowed simultaneously'
+ CALL local_stop
+ ENDIF
+
+ IF ( cloud_physics .AND. .NOT. humidity ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: cloud_physics =', &
+ cloud_physics, ' is not allowed with ', &
+ 'humidity =', humidity
+ CALL local_stop
+ ENDIF
+
+ IF ( precipitation .AND. .NOT. cloud_physics ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: precipitation =', &
+ precipitation, ' is not allowed with ', &
+ 'cloud_physics =', cloud_physics
+ CALL local_stop
+ ENDIF
+
+ IF ( humidity .AND. sloping_surface ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: humidity = TRUE', &
+ 'and hang = TRUE are not', &
+ ' allowed simultaneously'
+ CALL local_stop
+ ENDIF
+
+ IF ( humidity .AND. scalar_advec == 'ups-scheme' ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: UPS-scheme', &
+ 'is not implemented for humidity'
+ CALL local_stop
+ ENDIF
+
+ IF ( passive_scalar .AND. humidity ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: humidity = TRUE and', &
+ 'passive_scalar = TRUE is not allowed ', &
+ 'simultaneously'
+ CALL local_stop
+ ENDIF
+
+ IF ( passive_scalar .AND. scalar_advec == 'ups-scheme' ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: UPS-scheme', &
+ 'is not implemented for passive_scalar'
+ CALL local_stop
+ ENDIF
+
+ IF ( grid_matching /= 'strict' .AND. grid_matching /= 'match' ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: illegal value "', &
+ TRIM( grid_matching ), &
+ '" found for parameter grid_matching'
+ CALL local_stop
+ ENDIF
+
+ IF ( plant_canopy .AND. ( drag_coefficient == 0.0 ) ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: plant_canopy = TRUE', &
+ 'requires a non-zero drag_coefficient'
+ CALL local_stop
+ ENDIF
+
+!
+!-- In case of no model continuation run, check initialising parameters and
+!-- deduce further quantities
+ IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
+
+!
+!-- Initial profiles for 1D and 3D model, respectively
+ u_init = ug_surface
+ v_init = vg_surface
+ pt_init = pt_surface
+ IF ( humidity ) q_init = q_surface
+ IF ( ocean ) sa_init = sa_surface
+ IF ( passive_scalar ) q_init = s_surface
+ IF ( plant_canopy ) lad = 0.0
+
+!
+!--
+!-- If required, compute initial profile of the geostrophic wind
+!-- (component ug)
+ i = 1
+ gradient = 0.0
+
+ IF ( .NOT. ocean ) THEN
+
+ ug_vertical_gradient_level_ind(1) = 0
+ ug(0) = ug_surface
+ DO k = 1, nzt+1
+ IF ( ug_vertical_gradient_level(i) < zu(k) .AND. &
+ ug_vertical_gradient_level(i) >= 0.0 ) THEN
+ gradient = ug_vertical_gradient(i) / 100.0
+ ug_vertical_gradient_level_ind(i) = k - 1
+ i = i + 1
+ IF ( i > 10 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: upper bound 10 of array', &
+ ' "ug_vertical_gradient_level_ind" exceeded'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+ IF ( gradient /= 0.0 ) THEN
+ IF ( k /= 1 ) THEN
+ ug(k) = ug(k-1) + dzu(k) * gradient
+ ELSE
+ ug(k) = ug_surface + 0.5 * dzu(k) * gradient
+ ENDIF
+ ELSE
+ ug(k) = ug(k-1)
+ ENDIF
+ ENDDO
+
+ ELSE
+
+ ug_vertical_gradient_level_ind(1) = nzt+1
+ ug(nzt+1) = ug_surface
+ DO k = nzt, 0, -1
+ IF ( ug_vertical_gradient_level(i) > zu(k) .AND. &
+ ug_vertical_gradient_level(i) <= 0.0 ) THEN
+ gradient = ug_vertical_gradient(i) / 100.0
+ ug_vertical_gradient_level_ind(i) = k + 1
+ i = i + 1
+ IF ( i > 10 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: upper bound 10 of array', &
+ ' "ug_vertical_gradient_level_ind" exceeded'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+ IF ( gradient /= 0.0 ) THEN
+ IF ( k /= nzt ) THEN
+ ug(k) = ug(k+1) - dzu(k+1) * gradient
+ ELSE
+ ug(k) = ug_surface - 0.5 * dzu(k+1) * gradient
+ ug(k+1) = ug_surface + 0.5 * dzu(k+1) * gradient
+ ENDIF
+ ELSE
+ ug(k) = ug(k+1)
+ ENDIF
+ ENDDO
+
+ ENDIF
+
+ u_init = ug
+
+!
+!-- In case of no given gradients for ug, choose a vanishing gradient
+ IF ( ug_vertical_gradient_level(1) == -9999999.9 ) THEN
+ ug_vertical_gradient_level(1) = 0.0
+ ENDIF
+
+!
+!--
+!-- If required, compute initial profile of the geostrophic wind
+!-- (component vg)
+ i = 1
+ gradient = 0.0
+
+ IF ( .NOT. ocean ) THEN
+
+ vg_vertical_gradient_level_ind(1) = 0
+ vg(0) = vg_surface
+ DO k = 1, nzt+1
+ IF ( vg_vertical_gradient_level(i) < zu(k) .AND. &
+ vg_vertical_gradient_level(i) >= 0.0 ) THEN
+ gradient = vg_vertical_gradient(i) / 100.0
+ vg_vertical_gradient_level_ind(i) = k - 1
+ i = i + 1
+ IF ( i > 10 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: upper bound 10 of array', &
+ ' "vg_vertical_gradient_level_ind" exceeded'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+ IF ( gradient /= 0.0 ) THEN
+ IF ( k /= 1 ) THEN
+ vg(k) = vg(k-1) + dzu(k) * gradient
+ ELSE
+ vg(k) = vg_surface + 0.5 * dzu(k) * gradient
+ ENDIF
+ ELSE
+ vg(k) = vg(k-1)
+ ENDIF
+ ENDDO
+
+ ELSE
+
+ vg_vertical_gradient_level_ind(1) = nzt+1
+ vg(nzt+1) = vg_surface
+ DO k = nzt, 0, -1
+ IF ( vg_vertical_gradient_level(i) > zu(k) .AND. &
+ vg_vertical_gradient_level(i) <= 0.0 ) THEN
+ gradient = vg_vertical_gradient(i) / 100.0
+ vg_vertical_gradient_level_ind(i) = k + 1
+ i = i + 1
+ IF ( i > 10 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: upper bound 10 of array', &
+ ' "vg_vertical_gradient_level_ind" exceeded'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+ IF ( gradient /= 0.0 ) THEN
+ IF ( k /= nzt ) THEN
+ vg(k) = vg(k+1) - dzu(k+1) * gradient
+ ELSE
+ vg(k) = vg_surface - 0.5 * dzu(k+1) * gradient
+ vg(k+1) = vg_surface + 0.5 * dzu(k+1) * gradient
+ ENDIF
+ ELSE
+ vg(k) = vg(k+1)
+ ENDIF
+ ENDDO
+
+ ENDIF
+
+ v_init = vg
+
+!
+!-- In case of no given gradients for vg, choose a vanishing gradient
+ IF ( vg_vertical_gradient_level(1) == -9999999.9 ) THEN
+ vg_vertical_gradient_level(1) = 0.0
+ ENDIF
+
+!
+!-- Compute initial temperature profile using the given temperature gradients
+ i = 1
+ gradient = 0.0
+
+ IF ( .NOT. ocean ) THEN
+
+ pt_vertical_gradient_level_ind(1) = 0
+ DO k = 1, nzt+1
+ IF ( pt_vertical_gradient_level(i) < zu(k) .AND. &
+ pt_vertical_gradient_level(i) >= 0.0 ) THEN
+ gradient = pt_vertical_gradient(i) / 100.0
+ pt_vertical_gradient_level_ind(i) = k - 1
+ i = i + 1
+ IF ( i > 10 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: upper bound 10 of array', &
+ ' "pt_vertical_gradient_level_ind" exceeded'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+ IF ( gradient /= 0.0 ) THEN
+ IF ( k /= 1 ) THEN
+ pt_init(k) = pt_init(k-1) + dzu(k) * gradient
+ ELSE
+ pt_init(k) = pt_surface + 0.5 * dzu(k) * gradient
+ ENDIF
+ ELSE
+ pt_init(k) = pt_init(k-1)
+ ENDIF
+ ENDDO
+
+ ELSE
+
+ pt_vertical_gradient_level_ind(1) = nzt+1
+ DO k = nzt, 0, -1
+ IF ( pt_vertical_gradient_level(i) > zu(k) .AND. &
+ pt_vertical_gradient_level(i) <= 0.0 ) THEN
+ gradient = pt_vertical_gradient(i) / 100.0
+ pt_vertical_gradient_level_ind(i) = k + 1
+ i = i + 1
+ IF ( i > 10 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: upper bound 10 of array', &
+ ' "pt_vertical_gradient_level_ind" exceeded'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+ IF ( gradient /= 0.0 ) THEN
+ IF ( k /= nzt ) THEN
+ pt_init(k) = pt_init(k+1) - dzu(k+1) * gradient
+ ELSE
+ pt_init(k) = pt_surface - 0.5 * dzu(k+1) * gradient
+ pt_init(k+1) = pt_surface + 0.5 * dzu(k+1) * gradient
+ ENDIF
+ ELSE
+ pt_init(k) = pt_init(k+1)
+ ENDIF
+ ENDDO
+
+ ENDIF
+
+!
+!-- In case of no given temperature gradients, choose gradient of neutral
+!-- stratification
+ IF ( pt_vertical_gradient_level(1) == -9999999.9 ) THEN
+ pt_vertical_gradient_level(1) = 0.0
+ ENDIF
+
+!
+!-- Store temperature gradient at the top boundary for possible Neumann
+!-- boundary condition
+ bc_pt_t_val = ( pt_init(nzt+1) - pt_init(nzt) ) / dzu(nzt+1)
+
+!
+!-- If required, compute initial humidity or scalar profile using the given
+!-- humidity/scalar gradient. In case of scalar transport, initially store
+!-- values of the scalar parameters on humidity parameters
+ IF ( passive_scalar ) THEN
+ bc_q_b = bc_s_b
+ bc_q_t = bc_s_t
+ q_surface = s_surface
+ q_surface_initial_change = s_surface_initial_change
+ q_vertical_gradient = s_vertical_gradient
+ q_vertical_gradient_level = s_vertical_gradient_level
+ surface_waterflux = surface_scalarflux
+ ENDIF
+
+ IF ( humidity .OR. passive_scalar ) THEN
+
+ i = 1
+ gradient = 0.0
+ q_vertical_gradient_level_ind(1) = 0
+ DO k = 1, nzt+1
+ IF ( q_vertical_gradient_level(i) < zu(k) .AND. &
+ q_vertical_gradient_level(i) >= 0.0 ) THEN
+ gradient = q_vertical_gradient(i) / 100.0
+ q_vertical_gradient_level_ind(i) = k - 1
+ i = i + 1
+ IF ( i > 10 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: upper bound 10 of arr', &
+ 'ay "q_vertical_gradient_level_ind" exceeded'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+ IF ( gradient /= 0.0 ) THEN
+ IF ( k /= 1 ) THEN
+ q_init(k) = q_init(k-1) + dzu(k) * gradient
+ ELSE
+ q_init(k) = q_init(k-1) + 0.5 * dzu(k) * gradient
+ ENDIF
+ ELSE
+ q_init(k) = q_init(k-1)
+ ENDIF
+!
+!-- Avoid negative humidities
+ IF ( q_init(k) < 0.0 ) THEN
+ q_init(k) = 0.0
+ ENDIF
+ ENDDO
+
+!
+!-- In case of no given humidity gradients, choose zero gradient
+!-- conditions
+ IF ( q_vertical_gradient_level(1) == -1.0 ) THEN
+ q_vertical_gradient_level(1) = 0.0
+ ENDIF
+
+!
+!-- Store humidity gradient at the top boundary for possile Neumann
+!-- boundary condition
+ bc_q_t_val = ( q_init(nzt+1) - q_init(nzt) ) / dzu(nzt+1)
+
+ ENDIF
+
+!
+!-- If required, compute initial salinity profile using the given salinity
+!-- gradients
+ IF ( ocean ) THEN
+
+ i = 1
+ gradient = 0.0
+
+ sa_vertical_gradient_level_ind(1) = nzt+1
+ DO k = nzt, 0, -1
+ IF ( sa_vertical_gradient_level(i) > zu(k) .AND. &
+ sa_vertical_gradient_level(i) <= 0.0 ) THEN
+ gradient = sa_vertical_gradient(i) / 100.0
+ sa_vertical_gradient_level_ind(i) = k + 1
+ i = i + 1
+ IF ( i > 10 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: upper bound 10 of array', &
+ ' "sa_vertical_gradient_level_ind" exceeded'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+ IF ( gradient /= 0.0 ) THEN
+ IF ( k /= nzt ) THEN
+ sa_init(k) = sa_init(k+1) - dzu(k+1) * gradient
+ ELSE
+ sa_init(k) = sa_surface - 0.5 * dzu(k+1) * gradient
+ sa_init(k+1) = sa_surface + 0.5 * dzu(k+1) * gradient
+ ENDIF
+ ELSE
+ sa_init(k) = sa_init(k+1)
+ ENDIF
+ ENDDO
+
+ ENDIF
+
+!
+!-- If required compute the profile of leaf area density used in the plant canopy model
+ IF ( plant_canopy ) THEN
+
+ i = 1
+ gradient = 0.0
+
+ IF ( .NOT. ocean ) THEN
+
+ lad_vertical_gradient_level_ind(1) = 0
+ DO k = 1, pch_index
+ IF ( lad_vertical_gradient_level(i) < zu(k) .AND. &
+ lad_vertical_gradient_level(i) >= 0.0 ) THEN
+ gradient = lad_vertical_gradient(i)
+ lad_vertical_gradient_level_ind(i) = k - 1
+ i = i + 1
+ IF ( i > 10 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ user_init_3d_model: upper bound 10 of array', &
+ ' "lad_vertical_gradient_level" exceeded'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+ IF ( gradient /= 0.0 ) THEN
+ IF ( k /= 1 ) THEN
+ lad(k) = lad(k-1) + dzu(k) * gradient
+ ELSE
+ lad(k) = lad_surface + 0.5 * dzu(k) *gradient
+ ENDIF
+ ELSE
+ lad(k) = lad(k-1)
+ ENDIF
+ ENDDO
+
+ ENDIF
+
+!
+!-- In case of no given leaf area density gradients, choose a vanishing gradient
+ IF ( lad_vertical_gradient_level(1) == -9999999.9 ) THEN
+ lad_vertical_gradient_level(1) = 0.0
+ ENDIF
+
+ ENDIF
+
+ ENDIF
+
+!
+!-- Compute Coriolis parameter
+ f = 2.0 * omega * SIN( phi / 180.0 * pi )
+ fs = 2.0 * omega * COS( phi / 180.0 * pi )
+
+!
+!-- Ocean runs always use reference values in the buoyancy term. Therefore
+!-- set the reference temperature equal to the surface temperature.
+ IF ( ocean .AND. pt_reference == 9999999.9 ) pt_reference = pt_surface
+
+!
+!-- Reference value has to be used in buoyancy terms
+ IF ( pt_reference /= 9999999.9 ) use_reference = .TRUE.
+
+!
+!-- Sign of buoyancy/stability terms
+ IF ( ocean ) atmos_ocean_sign = -1.0
+
+!
+!-- Ocean version must use flux boundary conditions at the top
+ IF ( ocean .AND. .NOT. use_top_fluxes ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: use_top_fluxes ',&
+ 'must be .TRUE. in ocean version'
+ CALL local_stop
+ ENDIF
+
+!
+!-- In case of a given slope, compute the relevant quantities
+ IF ( alpha_surface /= 0.0 ) THEN
+ IF ( ABS( alpha_surface ) > 90.0 ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: ABS( alpha_surface',&
+ '=', alpha_surface, ' ) must be < 90.0'
+ CALL local_stop
+ ENDIF
+ sloping_surface = .TRUE.
+ cos_alpha_surface = COS( alpha_surface / 180.0 * pi )
+ sin_alpha_surface = SIN( alpha_surface / 180.0 * pi )
+ ENDIF
+
+!
+!-- Check time step and cfl_factor
+ IF ( dt /= -1.0 ) THEN
+ IF ( dt <= 0.0 .AND. dt /= -1.0 ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: dt=', dt, ' <= 0.0'
+ CALL local_stop
+ ENDIF
+ dt_3d = dt
+ dt_fixed = .TRUE.
+ ENDIF
+
+ IF ( cfl_factor <= 0.0 .OR. cfl_factor > 1.0 ) THEN
+ IF ( cfl_factor == -1.0 ) THEN
+ IF ( momentum_advec == 'ups-scheme' .OR. &
+ scalar_advec == 'ups-scheme' ) THEN
+ cfl_factor = 0.8
+ ELSE
+ IF ( timestep_scheme == 'runge-kutta-2' ) THEN
+ cfl_factor = 0.8
+ ELSEIF ( timestep_scheme == 'runge-kutta-3' ) THEN
+ cfl_factor = 0.9
+ ELSE
+ cfl_factor = 0.1
+ ENDIF
+ ENDIF
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: cfl_factor=', cfl_factor, &
+ ' out of range'
+ PRINT*, '+++ 0.0 < cfl_factor <= 1.0 is required'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+
+!
+!-- Store simulated time at begin
+ simulated_time_at_begin = simulated_time
+
+!
+!-- Set wind speed in the Galilei-transformed system
+ IF ( galilei_transformation ) THEN
+ IF ( use_ug_for_galilei_tr .AND. &
+ ug_vertical_gradient_level(1) == 0.0 .AND. &
+ vg_vertical_gradient_level(1) == 0.0 ) THEN
+ u_gtrans = ug_surface
+ v_gtrans = vg_surface
+ ELSEIF ( use_ug_for_galilei_tr .AND. &
+ ug_vertical_gradient_level(1) /= 0.0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' baroclinicity (ug) not allowed'
+ PRINT*, ' simultaneously with galilei transformation'
+ ENDIF
+ CALL local_stop
+ ELSEIF ( use_ug_for_galilei_tr .AND. &
+ vg_vertical_gradient_level(1) /= 0.0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' baroclinicity (vg) not allowed'
+ PRINT*, ' simultaneously with galilei transformation'
+ ENDIF
+ CALL local_stop
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ WARNING: check_parameters:'
+ PRINT*, ' variable translation speed used for galilei-tran' // &
+ 'sformation, which'
+ PRINT*, ' may cause instabilities in stably stratified regions'
+ ENDIF
+ ENDIF
+ ENDIF
+
+!
+!-- In case of using a prandtl-layer, calculated (or prescribed) surface
+!-- fluxes have to be used in the diffusion-terms
+ IF ( prandtl_layer ) use_surface_fluxes = .TRUE.
+
+!
+!-- Check boundary conditions and set internal variables:
+!-- Lateral boundary conditions
+ IF ( bc_lr /= 'cyclic' .AND. bc_lr /= 'dirichlet/radiation' .AND. &
+ bc_lr /= 'radiation/dirichlet' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown boundary condition: bc_lr = ', bc_lr
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( bc_ns /= 'cyclic' .AND. bc_ns /= 'dirichlet/radiation' .AND. &
+ bc_ns /= 'radiation/dirichlet' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown boundary condition: bc_ns = ', bc_ns
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Non-cyclic lateral boundaries require the multigrid method and Piascek-
+!-- Willimas advection scheme. Several schemes and tools do not work with
+!-- non-cyclic boundary conditions.
+ IF ( bc_lr /= 'cyclic' .OR. bc_ns /= 'cyclic' ) THEN
+ IF ( psolver /= 'multigrid' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' non-cyclic lateral boundaries do not allow', &
+ ' psolver = ', psolver
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( momentum_advec /= 'pw-scheme' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' non-cyclic lateral boundaries do not allow', &
+ ' momentum_advec = ', momentum_advec
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( scalar_advec /= 'pw-scheme' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' non-cyclic lateral boundaries do not allow', &
+ ' scalar_advec = ', scalar_advec
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( galilei_transformation ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' non-cyclic lateral boundaries do not allow', &
+ ' galilei_transformation = .T.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+! IF ( conserve_volume_flow ) THEN
+! IF ( myid == 0 ) THEN
+! PRINT*, '+++ check_parameters:'
+! PRINT*, ' non-cyclic lateral boundaries do not allow', &
+! ' conserve_volume_flow = .T.'
+! ENDIF
+! CALL local_stop
+! ENDIF
+ ENDIF
+
+!
+!-- Bottom boundary condition for the turbulent Kinetic energy
+ IF ( bc_e_b == 'neumann' ) THEN
+ ibc_e_b = 1
+ IF ( adjust_mixing_length .AND. prandtl_layer ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ WARNING: check_parameters:'
+ PRINT*, ' adjust_mixing_length = TRUE and bc_e_b = ', bc_e_b
+ ENDIF
+ ENDIF
+ ELSEIF ( bc_e_b == '(u*)**2+neumann' ) THEN
+ ibc_e_b = 2
+ IF ( .NOT. adjust_mixing_length .AND. prandtl_layer ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ WARNING: check_parameters:'
+ PRINT*, ' adjust_mixing_length = FALSE and bc_e_b = ', bc_e_b
+ ENDIF
+ ENDIF
+ IF ( .NOT. prandtl_layer ) THEN
+ bc_e_b = 'neumann'
+ ibc_e_b = 1
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ WARNING: check_parameters:'
+ PRINT*, ' boundary condition bc_e_b changed to "', bc_e_b, '"'
+ ENDIF
+ ENDIF
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown boundary condition: bc_e_b = ', bc_e_b
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Boundary conditions for perturbation pressure
+ IF ( bc_p_b == 'dirichlet' ) THEN
+ ibc_p_b = 0
+ ELSEIF ( bc_p_b == 'neumann' ) THEN
+ ibc_p_b = 1
+ ELSEIF ( bc_p_b == 'neumann+inhomo' ) THEN
+ ibc_p_b = 2
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown boundary condition: bc_p_b = ', bc_p_b
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( ibc_p_b == 2 .AND. .NOT. prandtl_layer ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' boundary condition: bc_p_b = ', TRIM( bc_p_b ), &
+ ' not allowed with'
+ PRINT*, ' prandtl_layer = .FALSE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( bc_p_t == 'dirichlet' ) THEN
+ ibc_p_t = 0
+ ELSEIF ( bc_p_t == 'neumann' ) THEN
+ ibc_p_t = 1
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown boundary condition: bc_p_t = ', bc_p_t
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Boundary conditions for potential temperature
+ IF ( coupling_mode == 'atmosphere_to_ocean' ) THEN
+ ibc_pt_b = 2
+ ELSE
+ IF ( bc_pt_b == 'dirichlet' ) THEN
+ ibc_pt_b = 0
+ ELSEIF ( bc_pt_b == 'neumann' ) THEN
+ ibc_pt_b = 1
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown boundary condition: bc_pt_b = ', bc_pt_b
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+
+ IF ( bc_pt_t == 'dirichlet' ) THEN
+ ibc_pt_t = 0
+ ELSEIF ( bc_pt_t == 'neumann' ) THEN
+ ibc_pt_t = 1
+ ELSEIF ( bc_pt_t == 'initial_gradient' ) THEN
+ ibc_pt_t = 2
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown boundary condition: bc_pt_t = ', bc_pt_t
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ IF ( surface_heatflux == 9999999.9 ) constant_heatflux = .FALSE.
+ IF ( top_heatflux == 9999999.9 ) constant_top_heatflux = .FALSE.
+ IF ( top_momentumflux_u /= 9999999.9 .AND. &
+ top_momentumflux_v /= 9999999.9 ) THEN
+ constant_top_momentumflux = .TRUE.
+ ELSEIF ( .NOT. ( top_momentumflux_u == 9999999.9 .AND. &
+ top_momentumflux_v == 9999999.9 ) ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' both, top_momentumflux_u AND top_momentumflux_v'
+ PRINT*, ' must be set'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- A given surface temperature implies Dirichlet boundary condition for
+!-- temperature. In this case specification of a constant heat flux is
+!-- forbidden.
+ IF ( ibc_pt_b == 0 .AND. constant_heatflux .AND. &
+ surface_heatflux /= 0.0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' boundary_condition: bc_pt_b = ', bc_pt_b
+ PRINT*, ' is not allowed with constant_heatflux = .TRUE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( constant_heatflux .AND. pt_surface_initial_change /= 0.0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: constant_heatflux = .TRUE. is not'
+ PRINT*, ' allowed with pt_surface_initial_change (/=0) = ', &
+ pt_surface_initial_change
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- A given temperature at the top implies Dirichlet boundary condition for
+!-- temperature. In this case specification of a constant heat flux is
+!-- forbidden.
+ IF ( ibc_pt_t == 0 .AND. constant_top_heatflux .AND. &
+ top_heatflux /= 0.0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' boundary_condition: bc_pt_t = ', bc_pt_t
+ PRINT*, ' is not allowed with constant_top_heatflux = .TRUE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Boundary conditions for salinity
+ IF ( ocean ) THEN
+ IF ( bc_sa_t == 'dirichlet' ) THEN
+ ibc_sa_t = 0
+ ELSEIF ( bc_sa_t == 'neumann' ) THEN
+ ibc_sa_t = 1
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown boundary condition: bc_sa_t = ', bc_sa_t
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ IF ( top_salinityflux == 9999999.9 ) constant_top_salinityflux = .FALSE.
+ IF ( ibc_sa_t == 1 .AND. top_salinityflux == 9999999.9 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' boundary_condition: bc_sa_t = ', bc_sa_t
+ PRINT*, ' requires to set top_salinityflux '
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- A fixed salinity at the top implies Dirichlet boundary condition for
+!-- salinity. In this case specification of a constant salinity flux is
+!-- forbidden.
+ IF ( ibc_sa_t == 0 .AND. constant_top_salinityflux .AND. &
+ top_salinityflux /= 0.0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' boundary_condition: bc_sa_t = ', bc_sa_t
+ PRINT*, ' is not allowed with constant_top_salinityflux = ', &
+ '.TRUE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ ENDIF
+
+!
+!-- In case of humidity or passive scalar, set boundary conditions for total
+!-- water content / scalar
+ IF ( humidity .OR. passive_scalar ) THEN
+ IF ( humidity ) THEN
+ sq = 'q'
+ ELSE
+ sq = 's'
+ ENDIF
+ IF ( bc_q_b == 'dirichlet' ) THEN
+ ibc_q_b = 0
+ ELSEIF ( bc_q_b == 'neumann' ) THEN
+ ibc_q_b = 1
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown boundary condition: bc_', sq, '_b = ', bc_q_b
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( bc_q_t == 'dirichlet' ) THEN
+ ibc_q_t = 0
+ ELSEIF ( bc_q_t == 'neumann' ) THEN
+ ibc_q_t = 1
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown boundary condition: bc_', sq, '_t = ', bc_q_t
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ IF ( surface_waterflux == 0.0 ) constant_waterflux = .FALSE.
+
+!
+!-- A given surface humidity implies Dirichlet boundary condition for
+!-- humidity. In this case specification of a constant water flux is
+!-- forbidden.
+ IF ( ibc_q_b == 0 .AND. constant_waterflux ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' boundary_condition: bc_', sq, '_b = ', bc_q_b
+ PRINT*, ' is not allowed with prescribed surface flux'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( constant_waterflux .AND. q_surface_initial_change /= 0.0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: a prescribed surface flux is not'
+ PRINT*, ' allowed with ', sq, '_surface_initial_change (/=0)', &
+ ' = ', q_surface_initial_change
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ ENDIF
+
+!
+!-- Boundary conditions for horizontal components of wind speed
+ IF ( bc_uv_b == 'dirichlet' ) THEN
+ ibc_uv_b = 0
+ ELSEIF ( bc_uv_b == 'neumann' ) THEN
+ ibc_uv_b = 1
+ IF ( prandtl_layer ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' boundary condition: bc_uv_b = ', TRIM( bc_uv_b ), &
+ ' is not allowed with'
+ PRINT*, ' prandtl_layer = .TRUE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown boundary condition: bc_uv_b = ', bc_uv_b
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( coupling_mode == 'ocean_to_atmosphere' ) THEN
+ bc_uv_t = 'neumann'
+ ibc_uv_t = 1
+ ELSE
+ IF ( bc_uv_t == 'dirichlet' .OR. bc_uv_t == 'dirichlet_0' ) THEN
+ ibc_uv_t = 0
+ ELSEIF ( bc_uv_t == 'neumann' ) THEN
+ ibc_uv_t = 1
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown boundary condition: bc_uv_t = ', bc_uv_t
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+
+!
+!-- Compute and check, respectively, the Rayleigh Damping parameter
+ IF ( rayleigh_damping_factor == -1.0 ) THEN
+ IF ( momentum_advec == 'ups-scheme' ) THEN
+ rayleigh_damping_factor = 0.01
+ ELSE
+ rayleigh_damping_factor = 0.0
+ ENDIF
+ ELSE
+ IF ( rayleigh_damping_factor < 0.0 .OR. rayleigh_damping_factor > 1.0 ) &
+ THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' rayleigh_damping_factor = ', rayleigh_damping_factor,&
+ ' out of range [0.0,1.0]'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+
+ IF ( rayleigh_damping_height == -1.0 ) THEN
+ IF ( .NOT. ocean ) THEN
+ rayleigh_damping_height = 0.66666666666 * zu(nzt)
+ ELSE
+ rayleigh_damping_height = 0.66666666666 * zu(nzb)
+ ENDIF
+ ELSE
+ IF ( .NOT. ocean ) THEN
+ IF ( rayleigh_damping_height < 0.0 .OR. &
+ rayleigh_damping_height > zu(nzt) ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' rayleigh_damping_height = ', rayleigh_damping_height,&
+ ' out of range [0.0,', zu(nzt), ']'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ELSE
+ IF ( rayleigh_damping_height > 0.0 .OR. &
+ rayleigh_damping_height < zu(nzb) ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' rayleigh_damping_height = ', rayleigh_damping_height,&
+ ' out of range [0.0,', zu(nzb), ']'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+ ENDIF
+
+!
+!-- Check limiters for Upstream-Spline scheme
+ IF ( overshoot_limit_u < 0.0 .OR. overshoot_limit_v < 0.0 .OR. &
+ overshoot_limit_w < 0.0 .OR. overshoot_limit_pt < 0.0 .OR. &
+ overshoot_limit_e < 0.0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' overshoot_limit_... < 0.0 is not allowed'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( ups_limit_u < 0.0 .OR. ups_limit_v < 0.0 .OR. ups_limit_w < 0.0 .OR. &
+ ups_limit_pt < 0.0 .OR. ups_limit_e < 0.0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' ups_limit_... < 0.0 is not allowed'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Check number of chosen statistic regions. More than 10 regions are not
+!-- allowed, because so far no more than 10 corresponding output files can
+!-- be opened (cf. check_open)
+ IF ( statistic_regions > 9 .OR. statistic_regions < 0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: Number of statistic_regions = ', &
+ statistic_regions+1
+ PRINT*, ' Only 10 regions are allowed'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( normalizing_region > statistic_regions .OR. &
+ normalizing_region < 0) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: normalizing_region = ', &
+ normalizing_region, ' is unknown'
+ PRINT*, ' Must be <= ', statistic_regions
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Check the interval for sorting particles.
+!-- Using particles as cloud droplets requires sorting after each timestep.
+ IF ( dt_sort_particles /= 0.0 .AND. cloud_droplets ) THEN
+ dt_sort_particles = 0.0
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ WARNING: check_parameters:'
+ PRINT*, ' dt_sort_particles is reset to 0.0 because ', &
+ 'of cloud_droplets = .TRUE.'
+ ENDIF
+ ENDIF
+
+!
+!-- Set the default intervals for data output, if necessary
+!-- NOTE: dt_dosp has already been set in package_parin
+ IF ( dt_data_output /= 9999999.9 ) THEN
+ IF ( dt_dopr == 9999999.9 ) dt_dopr = dt_data_output
+ IF ( dt_dopts == 9999999.9 ) dt_dopts = dt_data_output
+ IF ( dt_do2d_xy == 9999999.9 ) dt_do2d_xy = dt_data_output
+ IF ( dt_do2d_xz == 9999999.9 ) dt_do2d_xz = dt_data_output
+ IF ( dt_do2d_yz == 9999999.9 ) dt_do2d_yz = dt_data_output
+ IF ( dt_do3d == 9999999.9 ) dt_do3d = dt_data_output
+ IF ( dt_data_output_av == 9999999.9 ) dt_data_output_av = dt_data_output
+ ENDIF
+
+!
+!-- Set the default skip time intervals for data output, if necessary
+ IF ( skip_time_dopr == 9999999.9 ) &
+ skip_time_dopr = skip_time_data_output
+ IF ( skip_time_dosp == 9999999.9 ) &
+ skip_time_dosp = skip_time_data_output
+ IF ( skip_time_do2d_xy == 9999999.9 ) &
+ skip_time_do2d_xy = skip_time_data_output
+ IF ( skip_time_do2d_xz == 9999999.9 ) &
+ skip_time_do2d_xz = skip_time_data_output
+ IF ( skip_time_do2d_yz == 9999999.9 ) &
+ skip_time_do2d_yz = skip_time_data_output
+ IF ( skip_time_do3d == 9999999.9 ) &
+ skip_time_do3d = skip_time_data_output
+ IF ( skip_time_data_output_av == 9999999.9 ) &
+ skip_time_data_output_av = skip_time_data_output
+
+!
+!-- Check the average intervals (first for 3d-data, then for profiles and
+!-- spectra)
+ IF ( averaging_interval > dt_data_output_av ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: average_interval=', &
+ averaging_interval, ' must be <= dt_data_output=', &
+ dt_data_output
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ IF ( averaging_interval_pr == 9999999.9 ) THEN
+ averaging_interval_pr = averaging_interval
+ ENDIF
+
+ IF ( averaging_interval_pr > dt_dopr ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: averaging_interval_pr=', &
+ averaging_interval_pr, ' must be <= dt_dopr=', dt_dopr
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ IF ( averaging_interval_sp == 9999999.9 ) THEN
+ averaging_interval_sp = averaging_interval
+ ENDIF
+
+ IF ( averaging_interval_sp > dt_dosp ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: averaging_interval_sp=', &
+ averaging_interval_sp, ' must be <= dt_dosp=', dt_dosp
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Set the default interval for profiles entering the temporal average
+ IF ( dt_averaging_input_pr == 9999999.9 ) THEN
+ dt_averaging_input_pr = dt_averaging_input
+ ENDIF
+
+!
+!-- Set the default interval for the output of timeseries to a reasonable
+!-- value (tries to minimize the number of calls of flow_statistics)
+ IF ( dt_dots == 9999999.9 ) THEN
+ IF ( averaging_interval_pr == 0.0 ) THEN
+ dt_dots = MIN( dt_run_control, dt_dopr )
+ ELSE
+ dt_dots = MIN( dt_run_control, dt_averaging_input_pr )
+ ENDIF
+ ENDIF
+
+!
+!-- Check the sample rate for averaging (first for 3d-data, then for profiles)
+ IF ( dt_averaging_input > averaging_interval ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: dt_averaging_input=', &
+ dt_averaging_input, ' must be <= averaging_interval=', &
+ averaging_interval
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ IF ( dt_averaging_input_pr > averaging_interval_pr ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: dt_averaging_input_pr=', &
+ dt_averaging_input_pr, &
+ ' must be <= averaging_interval_pr=', &
+ averaging_interval_pr
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Set the default value for the integration interval of precipitation amount
+ IF ( precipitation ) THEN
+ IF ( precipitation_amount_interval == 9999999.9 ) THEN
+ precipitation_amount_interval = dt_do2d_xy
+ ELSE
+ IF ( precipitation_amount_interval > dt_do2d_xy ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: ', &
+ 'precipitation_amount_interval =', &
+ precipitation_amount_interval, &
+ ' must not be larger than dt_do2d_xy', &
+ ' = ', dt_do2d_xy
+ CALL local_stop
+ ENDIF
+ ENDIF
+ ENDIF
+
+!
+!-- Determine the number of output profiles and check whether they are
+!-- permissible
+ DO WHILE ( data_output_pr(dopr_n+1) /= ' ' )
+
+ dopr_n = dopr_n + 1
+ i = dopr_n
+
+!
+!-- Determine internal profile number (for hom, homs)
+!-- and store height levels
+ SELECT CASE ( TRIM( data_output_pr(i) ) )
+
+ CASE ( 'u', '#u' )
+ dopr_index(i) = 1
+ dopr_unit(i) = 'm/s'
+ hom(:,2,1,:) = SPREAD( zu, 2, statistic_regions+1 )
+ IF ( data_output_pr(i)(1:1) == '#' ) THEN
+ dopr_initial_index(i) = 5
+ hom(:,2,5,:) = SPREAD( zu, 2, statistic_regions+1 )
+ data_output_pr(i) = data_output_pr(i)(2:)
+ ENDIF
+
+ CASE ( 'v', '#v' )
+ dopr_index(i) = 2
+ dopr_unit(i) = 'm/s'
+ hom(:,2,2,:) = SPREAD( zu, 2, statistic_regions+1 )
+ IF ( data_output_pr(i)(1:1) == '#' ) THEN
+ dopr_initial_index(i) = 6
+ hom(:,2,6,:) = SPREAD( zu, 2, statistic_regions+1 )
+ data_output_pr(i) = data_output_pr(i)(2:)
+ ENDIF
+
+ CASE ( 'w' )
+ dopr_index(i) = 3
+ dopr_unit(i) = 'm/s'
+ hom(:,2,3,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'pt', '#pt' )
+ IF ( .NOT. cloud_physics ) THEN
+ dopr_index(i) = 4
+ dopr_unit(i) = 'K'
+ hom(:,2,4,:) = SPREAD( zu, 2, statistic_regions+1 )
+ IF ( data_output_pr(i)(1:1) == '#' ) THEN
+ dopr_initial_index(i) = 7
+ hom(:,2,7,:) = SPREAD( zu, 2, statistic_regions+1 )
+ hom(nzb,2,7,:) = 0.0 ! because zu(nzb) is negative
+ data_output_pr(i) = data_output_pr(i)(2:)
+ ENDIF
+ ELSE
+ dopr_index(i) = 43
+ dopr_unit(i) = 'K'
+ hom(:,2,43,:) = SPREAD( zu, 2, statistic_regions+1 )
+ IF ( data_output_pr(i)(1:1) == '#' ) THEN
+ dopr_initial_index(i) = 28
+ hom(:,2,28,:) = SPREAD( zu, 2, statistic_regions+1 )
+ hom(nzb,2,28,:) = 0.0 ! because zu(nzb) is negative
+ data_output_pr(i) = data_output_pr(i)(2:)
+ ENDIF
+ ENDIF
+
+ CASE ( 'e' )
+ dopr_index(i) = 8
+ dopr_unit(i) = 'm2/s2'
+ hom(:,2,8,:) = SPREAD( zu, 2, statistic_regions+1 )
+ hom(nzb,2,8,:) = 0.0
+
+ CASE ( 'km', '#km' )
+ dopr_index(i) = 9
+ dopr_unit(i) = 'm2/s'
+ hom(:,2,9,:) = SPREAD( zu, 2, statistic_regions+1 )
+ hom(nzb,2,9,:) = 0.0
+ IF ( data_output_pr(i)(1:1) == '#' ) THEN
+ dopr_initial_index(i) = 23
+ hom(:,2,23,:) = hom(:,2,9,:)
+ data_output_pr(i) = data_output_pr(i)(2:)
+ ENDIF
+
+ CASE ( 'kh', '#kh' )
+ dopr_index(i) = 10
+ dopr_unit(i) = 'm2/s'
+ hom(:,2,10,:) = SPREAD( zu, 2, statistic_regions+1 )
+ hom(nzb,2,10,:) = 0.0
+ IF ( data_output_pr(i)(1:1) == '#' ) THEN
+ dopr_initial_index(i) = 24
+ hom(:,2,24,:) = hom(:,2,10,:)
+ data_output_pr(i) = data_output_pr(i)(2:)
+ ENDIF
+
+ CASE ( 'l', '#l' )
+ dopr_index(i) = 11
+ dopr_unit(i) = 'm'
+ hom(:,2,11,:) = SPREAD( zu, 2, statistic_regions+1 )
+ hom(nzb,2,11,:) = 0.0
+ IF ( data_output_pr(i)(1:1) == '#' ) THEN
+ dopr_initial_index(i) = 25
+ hom(:,2,25,:) = hom(:,2,11,:)
+ data_output_pr(i) = data_output_pr(i)(2:)
+ ENDIF
+
+ CASE ( 'w"u"' )
+ dopr_index(i) = 12
+ dopr_unit(i) = 'm2/s2'
+ hom(:,2,12,:) = SPREAD( zw, 2, statistic_regions+1 )
+ IF ( prandtl_layer ) hom(nzb,2,12,:) = zu(1)
+
+ CASE ( 'w*u*' )
+ dopr_index(i) = 13
+ dopr_unit(i) = 'm2/s2'
+ hom(:,2,13,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'w"v"' )
+ dopr_index(i) = 14
+ dopr_unit(i) = 'm2/s2'
+ hom(:,2,14,:) = SPREAD( zw, 2, statistic_regions+1 )
+ IF ( prandtl_layer ) hom(nzb,2,14,:) = zu(1)
+
+ CASE ( 'w*v*' )
+ dopr_index(i) = 15
+ dopr_unit(i) = 'm2/s2'
+ hom(:,2,15,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'w"pt"' )
+ dopr_index(i) = 16
+ dopr_unit(i) = 'K m/s'
+ hom(:,2,16,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'w*pt*' )
+ dopr_index(i) = 17
+ dopr_unit(i) = 'K m/s'
+ hom(:,2,17,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'wpt' )
+ dopr_index(i) = 18
+ dopr_unit(i) = 'K m/s'
+ hom(:,2,18,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'wu' )
+ dopr_index(i) = 19
+ dopr_unit(i) = 'm2/s2'
+ hom(:,2,19,:) = SPREAD( zw, 2, statistic_regions+1 )
+ IF ( prandtl_layer ) hom(nzb,2,19,:) = zu(1)
+
+ CASE ( 'wv' )
+ dopr_index(i) = 20
+ dopr_unit(i) = 'm2/s2'
+ hom(:,2,20,:) = SPREAD( zw, 2, statistic_regions+1 )
+ IF ( prandtl_layer ) hom(nzb,2,20,:) = zu(1)
+
+ CASE ( 'w*pt*BC' )
+ dopr_index(i) = 21
+ dopr_unit(i) = 'K m/s'
+ hom(:,2,21,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'wptBC' )
+ dopr_index(i) = 22
+ dopr_unit(i) = 'K m/s'
+ hom(:,2,22,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'sa', '#sa' )
+ IF ( .NOT. ocean ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for ocean = FALSE'
+ ENDIF
+ CALL local_stop
+ ELSE
+ dopr_index(i) = 23
+ dopr_unit(i) = 'psu'
+ hom(:,2,23,:) = SPREAD( zu, 2, statistic_regions+1 )
+ IF ( data_output_pr(i)(1:1) == '#' ) THEN
+ dopr_initial_index(i) = 26
+ hom(:,2,26,:) = SPREAD( zu, 2, statistic_regions+1 )
+ hom(nzb,2,26,:) = 0.0 ! weil zu(nzb) negativ ist
+ data_output_pr(i) = data_output_pr(i)(2:)
+ ENDIF
+ ENDIF
+
+ CASE ( 'u*2' )
+ dopr_index(i) = 30
+ dopr_unit(i) = 'm2/s2'
+ hom(:,2,30,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+ CASE ( 'v*2' )
+ dopr_index(i) = 31
+ dopr_unit(i) = 'm2/s2'
+ hom(:,2,31,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+ CASE ( 'w*2' )
+ dopr_index(i) = 32
+ dopr_unit(i) = 'm2/s2'
+ hom(:,2,32,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'pt*2' )
+ dopr_index(i) = 33
+ dopr_unit(i) = 'K2'
+ hom(:,2,33,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+ CASE ( 'e*' )
+ dopr_index(i) = 34
+ dopr_unit(i) = 'm2/s2'
+ hom(:,2,34,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+ CASE ( 'w*2pt*' )
+ dopr_index(i) = 35
+ dopr_unit(i) = 'K m2/s2'
+ hom(:,2,35,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'w*pt*2' )
+ dopr_index(i) = 36
+ dopr_unit(i) = 'K2 m/s'
+ hom(:,2,36,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'w*e*' )
+ dopr_index(i) = 37
+ dopr_unit(i) = 'm3/s3'
+ hom(:,2,37,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'w*3' )
+ dopr_index(i) = 38
+ dopr_unit(i) = 'm3/s3'
+ hom(:,2,38,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'Sw' )
+ dopr_index(i) = 39
+ dopr_unit(i) = 'none'
+ hom(:,2,39,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'q', '#q' )
+ IF ( .NOT. humidity ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for humidity = FALSE'
+ ENDIF
+ CALL local_stop
+ ELSE
+ dopr_index(i) = 41
+ dopr_unit(i) = 'kg/kg'
+ hom(:,2,41,:) = SPREAD( zu, 2, statistic_regions+1 )
+ IF ( data_output_pr(i)(1:1) == '#' ) THEN
+ dopr_initial_index(i) = 26
+ hom(:,2,26,:) = SPREAD( zu, 2, statistic_regions+1 )
+ hom(nzb,2,26,:) = 0.0 ! weil zu(nzb) negativ ist
+ data_output_pr(i) = data_output_pr(i)(2:)
+ ENDIF
+ ENDIF
+
+ CASE ( 's', '#s' )
+ IF ( .NOT. passive_scalar ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for passive_scalar = FALSE'
+ ENDIF
+ CALL local_stop
+ ELSE
+ dopr_index(i) = 41
+ dopr_unit(i) = 'kg/m3'
+ hom(:,2,41,:) = SPREAD( zu, 2, statistic_regions+1 )
+ IF ( data_output_pr(i)(1:1) == '#' ) THEN
+ dopr_initial_index(i) = 26
+ hom(:,2,26,:) = SPREAD( zu, 2, statistic_regions+1 )
+ hom(nzb,2,26,:) = 0.0 ! weil zu(nzb) negativ ist
+ data_output_pr(i) = data_output_pr(i)(2:)
+ ENDIF
+ ENDIF
+
+ CASE ( 'qv', '#qv' )
+ IF ( .NOT. cloud_physics ) THEN
+ dopr_index(i) = 41
+ dopr_unit(i) = 'kg/kg'
+ hom(:,2,41,:) = SPREAD( zu, 2, statistic_regions+1 )
+ IF ( data_output_pr(i)(1:1) == '#' ) THEN
+ dopr_initial_index(i) = 26
+ hom(:,2,26,:) = SPREAD( zu, 2, statistic_regions+1 )
+ hom(nzb,2,26,:) = 0.0 ! weil zu(nzb) negativ ist
+ data_output_pr(i) = data_output_pr(i)(2:)
+ ENDIF
+ ELSE
+ dopr_index(i) = 42
+ dopr_unit(i) = 'kg/kg'
+ hom(:,2,42,:) = SPREAD( zu, 2, statistic_regions+1 )
+ IF ( data_output_pr(i)(1:1) == '#' ) THEN
+ dopr_initial_index(i) = 27
+ hom(:,2,27,:) = SPREAD( zu, 2, statistic_regions+1 )
+ hom(nzb,2,27,:) = 0.0 ! weil zu(nzb) negativ ist
+ data_output_pr(i) = data_output_pr(i)(2:)
+ ENDIF
+ ENDIF
+
+ CASE ( 'lpt', '#lpt' )
+ IF ( .NOT. cloud_physics ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for cloud_physics = FALSE'
+ ENDIF
+ CALL local_stop
+ ELSE
+ dopr_index(i) = 4
+ dopr_unit(i) = 'K'
+ hom(:,2,4,:) = SPREAD( zu, 2, statistic_regions+1 )
+ IF ( data_output_pr(i)(1:1) == '#' ) THEN
+ dopr_initial_index(i) = 7
+ hom(:,2,7,:) = SPREAD( zu, 2, statistic_regions+1 )
+ hom(nzb,2,7,:) = 0.0 ! weil zu(nzb) negativ ist
+ data_output_pr(i) = data_output_pr(i)(2:)
+ ENDIF
+ ENDIF
+
+ CASE ( 'vpt', '#vpt' )
+ dopr_index(i) = 44
+ dopr_unit(i) = 'K'
+ hom(:,2,44,:) = SPREAD( zu, 2, statistic_regions+1 )
+ IF ( data_output_pr(i)(1:1) == '#' ) THEN
+ dopr_initial_index(i) = 29
+ hom(:,2,29,:) = SPREAD( zu, 2, statistic_regions+1 )
+ hom(nzb,2,29,:) = 0.0 ! weil zu(nzb) negativ ist
+ data_output_pr(i) = data_output_pr(i)(2:)
+ ENDIF
+
+ CASE ( 'w"vpt"' )
+ dopr_index(i) = 45
+ dopr_unit(i) = 'K m/s'
+ hom(:,2,45,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'w*vpt*' )
+ dopr_index(i) = 46
+ dopr_unit(i) = 'K m/s'
+ hom(:,2,46,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'wvpt' )
+ dopr_index(i) = 47
+ dopr_unit(i) = 'K m/s'
+ hom(:,2,47,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'w"q"' )
+ IF ( .NOT. humidity ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for humidity = FALSE'
+ ENDIF
+ CALL local_stop
+ ELSE
+ dopr_index(i) = 48
+ dopr_unit(i) = 'kg/kg m/s'
+ hom(:,2,48,:) = SPREAD( zw, 2, statistic_regions+1 )
+ ENDIF
+
+ CASE ( 'w*q*' )
+ IF ( .NOT. humidity ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for humidity = FALSE'
+ ENDIF
+ CALL local_stop
+ ELSE
+ dopr_index(i) = 49
+ dopr_unit(i) = 'kg/kg m/s'
+ hom(:,2,49,:) = SPREAD( zw, 2, statistic_regions+1 )
+ ENDIF
+
+ CASE ( 'wq' )
+ IF ( .NOT. humidity ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for humidity = FALSE'
+ ENDIF
+ CALL local_stop
+ ELSE
+ dopr_index(i) = 50
+ dopr_unit(i) = 'kg/kg m/s'
+ hom(:,2,50,:) = SPREAD( zw, 2, statistic_regions+1 )
+ ENDIF
+
+ CASE ( 'w"s"' )
+ IF ( .NOT. passive_scalar ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for passive_scalar = FALSE'
+ ENDIF
+ CALL local_stop
+ ELSE
+ dopr_index(i) = 48
+ dopr_unit(i) = 'kg/m3 m/s'
+ hom(:,2,48,:) = SPREAD( zw, 2, statistic_regions+1 )
+ ENDIF
+
+ CASE ( 'w*s*' )
+ IF ( .NOT. passive_scalar ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for passive_scalar = FALSE'
+ ENDIF
+ CALL local_stop
+ ELSE
+ dopr_index(i) = 49
+ dopr_unit(i) = 'kg/m3 m/s'
+ hom(:,2,49,:) = SPREAD( zw, 2, statistic_regions+1 )
+ ENDIF
+
+ CASE ( 'ws' )
+ IF ( .NOT. passive_scalar ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for passive_scalar = FALSE'
+ ENDIF
+ CALL local_stop
+ ELSE
+ dopr_index(i) = 50
+ dopr_unit(i) = 'kg/m3 m/s'
+ hom(:,2,50,:) = SPREAD( zw, 2, statistic_regions+1 )
+ ENDIF
+
+ CASE ( 'w"qv"' )
+ IF ( humidity .AND. .NOT. cloud_physics ) &
+ THEN
+ dopr_index(i) = 48
+ dopr_unit(i) = 'kg/kg m/s'
+ hom(:,2,48,:) = SPREAD( zw, 2, statistic_regions+1 )
+ ELSEIF( humidity .AND. cloud_physics ) THEN
+ dopr_index(i) = 51
+ dopr_unit(i) = 'kg/kg m/s'
+ hom(:,2,51,:) = SPREAD( zw, 2, statistic_regions+1 )
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for cloud_physics = FALSE', &
+ ' and humidity = FALSE'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ CASE ( 'w*qv*' )
+ IF ( humidity .AND. .NOT. cloud_physics ) &
+ THEN
+ dopr_index(i) = 49
+ dopr_unit(i) = 'kg/kg m/s'
+ hom(:,2,49,:) = SPREAD( zw, 2, statistic_regions+1 )
+ ELSEIF( humidity .AND. cloud_physics ) THEN
+ dopr_index(i) = 52
+ dopr_unit(i) = 'kg/kg m/s'
+ hom(:,2,52,:) = SPREAD( zw, 2, statistic_regions+1 )
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for cloud_physics = FALSE', &
+ ' and humidity = FALSE'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ CASE ( 'wqv' )
+ IF ( humidity .AND. .NOT. cloud_physics ) &
+ THEN
+ dopr_index(i) = 50
+ dopr_unit(i) = 'kg/kg m/s'
+ hom(:,2,50,:) = SPREAD( zw, 2, statistic_regions+1 )
+ ELSEIF( humidity .AND. cloud_physics ) THEN
+ dopr_index(i) = 53
+ dopr_unit(i) = 'kg/kg m/s'
+ hom(:,2,53,:) = SPREAD( zw, 2, statistic_regions+1 )
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for cloud_physics = FALSE', &
+ ' and humidity = FALSE'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ CASE ( 'ql' )
+ IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for cloud_physics = FALSE'
+ ENDIF
+ CALL local_stop
+ ELSE
+ dopr_index(i) = 54
+ dopr_unit(i) = 'kg/kg'
+ hom(:,2,54,:) = SPREAD( zu, 2, statistic_regions+1 )
+ ENDIF
+
+ CASE ( 'w*u*u*/dz' )
+ dopr_index(i) = 55
+ dopr_unit(i) = 'm2/s3'
+ hom(:,2,55,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+ CASE ( 'w*p*/dz' )
+ dopr_index(i) = 56
+ dopr_unit(i) = 'm2/s3'
+ hom(:,2,56,:) = SPREAD( zw, 2, statistic_regions+1 )
+
+ CASE ( 'w"e/dz' )
+ dopr_index(i) = 57
+ dopr_unit(i) = 'm2/s3'
+ hom(:,2,57,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+ CASE ( 'u"pt"' )
+ dopr_index(i) = 58
+ dopr_unit(i) = 'K m/s'
+ hom(:,2,58,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+ CASE ( 'u*pt*' )
+ dopr_index(i) = 59
+ dopr_unit(i) = 'K m/s'
+ hom(:,2,59,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+ CASE ( 'upt_t' )
+ dopr_index(i) = 60
+ dopr_unit(i) = 'K m/s'
+ hom(:,2,60,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+ CASE ( 'v"pt"' )
+ dopr_index(i) = 61
+ dopr_unit(i) = 'K m/s'
+ hom(:,2,61,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+ CASE ( 'v*pt*' )
+ dopr_index(i) = 62
+ dopr_unit(i) = 'K m/s'
+ hom(:,2,62,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+ CASE ( 'vpt_t' )
+ dopr_index(i) = 63
+ dopr_unit(i) = 'K m/s'
+ hom(:,2,63,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+ CASE ( 'rho' )
+ dopr_index(i) = 64
+ dopr_unit(i) = 'kg/m3'
+ hom(:,2,64,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+ CASE ( 'w"sa"' )
+ IF ( .NOT. ocean ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for ocean = FALSE'
+ ENDIF
+ CALL local_stop
+ ELSE
+ dopr_index(i) = 65
+ dopr_unit(i) = 'psu m/s'
+ hom(:,2,65,:) = SPREAD( zw, 2, statistic_regions+1 )
+ ENDIF
+
+ CASE ( 'w*sa*' )
+ IF ( .NOT. ocean ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for ocean = FALSE'
+ ENDIF
+ CALL local_stop
+ ELSE
+ dopr_index(i) = 66
+ dopr_unit(i) = 'psu m/s'
+ hom(:,2,66,:) = SPREAD( zw, 2, statistic_regions+1 )
+ ENDIF
+
+ CASE ( 'wsa' )
+ IF ( .NOT. ocean ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: data_output_pr = ', &
+ data_output_pr(i), &
+ ' is not implemented for ocean = FALSE'
+ ENDIF
+ CALL local_stop
+ ELSE
+ dopr_index(i) = 67
+ dopr_unit(i) = 'psu m/s'
+ hom(:,2,67,:) = SPREAD( zw, 2, statistic_regions+1 )
+ ENDIF
+
+ CASE ( 'w*p*' )
+ dopr_index(i) = 68
+ dopr_unit(i) = 'm3/s3'
+ hom(:,2,68,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+ CASE ( 'w"e' )
+ dopr_index(i) = 69
+ dopr_unit(i) = 'm3/s3'
+ hom(:,2,69,:) = SPREAD( zu, 2, statistic_regions+1 )
+
+
+ CASE DEFAULT
+
+ CALL user_check_data_output_pr( data_output_pr(i), i, unit )
+
+ IF ( unit == 'illegal' ) THEN
+ IF ( myid == 0 ) THEN
+ IF ( data_output_pr_user(1) /= ' ' ) THEN
+ PRINT*, '+++ check_parameters: illegal value for data_',&
+ 'output_pr or data_output_pr_user: "', &
+ TRIM( data_output_pr(i) ), '"'
+ ELSE
+ PRINT*, '+++ check_parameters: illegal value for data_',&
+ 'output_pr: "', TRIM( data_output_pr(i) ),'"'
+ ENDIF
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ END SELECT
+!
+!-- Check to which of the predefined coordinate systems the profile belongs
+ DO k = 1, crmax
+ IF ( INDEX( cross_profiles(k), ' '//TRIM( data_output_pr(i) )//' ' ) &
+ /=0 ) &
+ THEN
+ dopr_crossindex(i) = k
+ EXIT
+ ENDIF
+ ENDDO
+!
+!-- Generate the text for the labels of the PROFIL output file. "-characters
+!-- must be substituted, otherwise PROFIL would interpret them as TeX
+!-- control characters
+ dopr_label(i) = data_output_pr(i)
+ position = INDEX( dopr_label(i) , '"' )
+ DO WHILE ( position /= 0 )
+ dopr_label(i)(position:position) = ''''
+ position = INDEX( dopr_label(i) , '"' )
+ ENDDO
+
+ ENDDO
+
+!
+!-- y-value range of the coordinate system (PROFIL).
+!-- x-value range determined in plot_1d.
+ IF ( .NOT. ocean ) THEN
+ cross_uymin = 0.0
+ IF ( z_max_do1d == -1.0 ) THEN
+ cross_uymax = zu(nzt+1)
+ ELSEIF ( z_max_do1d < zu(nzb+1) .OR. z_max_do1d > zu(nzt+1) ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: z_max_do1d=', &
+ z_max_do1d,' must be >= ', zu(nzb+1), &
+ ' or <= ', zu(nzt+1)
+ CALL local_stop
+ ELSE
+ cross_uymax = z_max_do1d
+ ENDIF
+ ENDIF
+
+!
+!-- Check whether the chosen normalizing factor for the coordinate systems is
+!-- permissible
+ DO i = 1, crmax
+ SELECT CASE ( TRIM( cross_normalized_x(i) ) ) ! TRIM required on IBM
+
+ CASE ( '', 'wpt0', 'ws2', 'tsw2', 'ws3', 'ws2tsw', 'wstsw2' )
+ j = 0
+
+ CASE DEFAULT
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: unknown normalize method'
+ PRINT*, ' cross_normalized_x="',cross_normalized_x(i),'"'
+ ENDIF
+ CALL local_stop
+
+ END SELECT
+ SELECT CASE ( TRIM( cross_normalized_y(i) ) ) ! TRIM required on IBM
+
+ CASE ( '', 'z_i' )
+ j = 0
+
+ CASE DEFAULT
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: unknown normalize method'
+ PRINT*, ' cross_normalized_y="',cross_normalized_y(i),'"'
+ ENDIF
+ CALL local_stop
+
+ END SELECT
+ ENDDO
+!
+!-- Check normalized y-value range of the coordinate system (PROFIL)
+ IF ( z_max_do1d_normalized /= -1.0 .AND. z_max_do1d_normalized <= 0.0 ) &
+ THEN
+ IF ( myid == 0 ) PRINT*,'+++ check_parameters: z_max_do1d_normalize', &
+ 'd=', z_max_do1d_normalized, ' must be >= 0.0'
+ CALL local_stop
+ ENDIF
+
+
+!
+!-- Append user-defined data output variables to the standard data output
+ IF ( data_output_user(1) /= ' ' ) THEN
+ i = 1
+ DO WHILE ( data_output(i) /= ' ' .AND. i <= 100 )
+ i = i + 1
+ ENDDO
+ j = 1
+ DO WHILE ( data_output_user(j) /= ' ' .AND. j <= 100 )
+ IF ( i > 100 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: number of output quantitities', &
+ ' given by data_output and data_output_user'
+ PRINT*, ' exceeds the limit of 100'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ data_output(i) = data_output_user(j)
+ i = i + 1
+ j = j + 1
+ ENDDO
+ ENDIF
+
+!
+!-- Check and set steering parameters for 2d/3d data output and averaging
+ i = 1
+ DO WHILE ( data_output(i) /= ' ' .AND. i <= 100 )
+!
+!-- Check for data averaging
+ ilen = LEN_TRIM( data_output(i) )
+ j = 0 ! no data averaging
+ IF ( ilen > 3 ) THEN
+ IF ( data_output(i)(ilen-2:ilen) == '_av' ) THEN
+ j = 1 ! data averaging
+ data_output(i) = data_output(i)(1:ilen-3)
+ ENDIF
+ ENDIF
+!
+!-- Check for cross section or volume data
+ ilen = LEN_TRIM( data_output(i) )
+ k = 0 ! 3d data
+ var = data_output(i)(1:ilen)
+ IF ( ilen > 3 ) THEN
+ IF ( data_output(i)(ilen-2:ilen) == '_xy' .OR. &
+ data_output(i)(ilen-2:ilen) == '_xz' .OR. &
+ data_output(i)(ilen-2:ilen) == '_yz' ) THEN
+ k = 1 ! 2d data
+ var = data_output(i)(1:ilen-3)
+ ENDIF
+ ENDIF
+!
+!-- Check for allowed value and set units
+ SELECT CASE ( TRIM( var ) )
+
+ CASE ( 'e' )
+ IF ( constant_diffusion ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+ '" requires constant_diffusion = .FALSE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ unit = 'm2/s2'
+
+ CASE ( 'pc', 'pr' )
+ IF ( .NOT. particle_advection ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+ '" requires a "particles_par"-NAMELIST'
+ PRINT*, ' in the parameter file (PARIN)'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( TRIM( var ) == 'pc' ) unit = 'number'
+ IF ( TRIM( var ) == 'pr' ) unit = 'm'
+
+ CASE ( 'q', 'vpt' )
+ IF ( .NOT. humidity ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+ '" requires humidity = .TRUE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( TRIM( var ) == 'q' ) unit = 'kg/kg'
+ IF ( TRIM( var ) == 'vpt' ) unit = 'K'
+
+ CASE ( 'ql' )
+ IF ( .NOT. ( cloud_physics .OR. cloud_droplets ) ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+ '" requires cloud_physics = .TRUE.'
+ PRINT*, ' or cloud_droplets = .TRUE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ unit = 'kg/kg'
+
+ CASE ( 'ql_c', 'ql_v', 'ql_vp' )
+ IF ( .NOT. cloud_droplets ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+ '" requires cloud_droplets = .TRUE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( TRIM( var ) == 'ql_c' ) unit = 'kg/kg'
+ IF ( TRIM( var ) == 'ql_v' ) unit = 'm3'
+ IF ( TRIM( var ) == 'ql_vp' ) unit = 'none'
+
+ CASE ( 'qv' )
+ IF ( .NOT. cloud_physics ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+ '" requires cloud_physics = .TRUE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ unit = 'kg/kg'
+
+ CASE ( 'rho' )
+ IF ( .NOT. ocean ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+ '" requires ocean = .TRUE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ unit = 'kg/m3'
+
+ CASE ( 's' )
+ IF ( .NOT. passive_scalar ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+ '" requires passive_scalar = .TRUE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ unit = 'conc'
+
+ CASE ( 'sa' )
+ IF ( .NOT. ocean ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+ '" requires ocean = .TRUE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ unit = 'psu'
+
+ CASE ( 'u*', 't*', 'lwp*', 'pra*', 'prr*', 'z0*' )
+ IF ( k == 0 .OR. data_output(i)(ilen-2:ilen) /= '_xy' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: illegal value for data_',&
+ 'output: "', TRIM( var ), '" is only allowed'
+ PRINT*, ' for horizontal cross section'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( TRIM( var ) == 'lwp*' .AND. .NOT. cloud_physics ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+ '" requires cloud_physics = .TRUE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( TRIM( var ) == 'pra*' .AND. .NOT. precipitation ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+ '" requires precipitation = .TRUE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( TRIM( var ) == 'pra*' .AND. j == 1 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: temporal averaging of ', &
+ ' precipitation amount "', TRIM( var ), &
+ '" not possible'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( TRIM( var ) == 'prr*' .AND. .NOT. precipitation ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: output of "', TRIM( var ), &
+ '" requires precipitation = .TRUE.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+
+ IF ( TRIM( var ) == 'u*' ) unit = 'm/s'
+ IF ( TRIM( var ) == 't*' ) unit = 'K'
+ IF ( TRIM( var ) == 'lwp*' ) unit = 'kg/kg*m'
+ IF ( TRIM( var ) == 'pra*' ) unit = 'mm'
+ IF ( TRIM( var ) == 'prr*' ) unit = 'mm/s'
+ IF ( TRIM( var ) == 'z0*' ) unit = 'm'
+
+ CASE ( 'p', 'pt', 'u', 'v', 'w' )
+ IF ( TRIM( var ) == 'p' ) unit = 'Pa'
+ IF ( TRIM( var ) == 'pt' ) unit = 'K'
+ IF ( TRIM( var ) == 'u' ) unit = 'm/s'
+ IF ( TRIM( var ) == 'v' ) unit = 'm/s'
+ IF ( TRIM( var ) == 'w' ) unit = 'm/s'
+ CONTINUE
+
+ CASE DEFAULT
+ CALL user_check_data_output( var, unit )
+
+ IF ( unit == 'illegal' ) THEN
+ IF ( myid == 0 ) THEN
+ IF ( data_output_user(1) /= ' ' ) THEN
+ PRINT*, '+++ check_parameters: illegal value for data_',&
+ 'output or data_output_user: "', &
+ TRIM( data_output(i) ), '"'
+ ELSE
+ PRINT*, '+++ check_parameters: illegal value for data_',&
+ 'output: "', TRIM( data_output(i) ), '"'
+ ENDIF
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ END SELECT
+!
+!-- Set the internal steering parameters appropriately
+ IF ( k == 0 ) THEN
+ do3d_no(j) = do3d_no(j) + 1
+ do3d(j,do3d_no(j)) = data_output(i)
+ do3d_unit(j,do3d_no(j)) = unit
+ ELSE
+ do2d_no(j) = do2d_no(j) + 1
+ do2d(j,do2d_no(j)) = data_output(i)
+ do2d_unit(j,do2d_no(j)) = unit
+ IF ( data_output(i)(ilen-2:ilen) == '_xy' ) THEN
+ data_output_xy(j) = .TRUE.
+ ENDIF
+ IF ( data_output(i)(ilen-2:ilen) == '_xz' ) THEN
+ data_output_xz(j) = .TRUE.
+ ENDIF
+ IF ( data_output(i)(ilen-2:ilen) == '_yz' ) THEN
+ data_output_yz(j) = .TRUE.
+ ENDIF
+ ENDIF
+
+ IF ( j == 1 ) THEN
+!
+!-- Check, if variable is already subject to averaging
+ found = .FALSE.
+ DO k = 1, doav_n
+ IF ( TRIM( doav(k) ) == TRIM( var ) ) found = .TRUE.
+ ENDDO
+
+ IF ( .NOT. found ) THEN
+ doav_n = doav_n + 1
+ doav(doav_n) = var
+ ENDIF
+ ENDIF
+
+ i = i + 1
+ ENDDO
+
+!
+!-- Store sectional planes in one shared array
+ section(:,1) = section_xy
+ section(:,2) = section_xz
+ section(:,3) = section_yz
+
+!
+!-- Upper plot limit (grid point value) for 1D profiles
+ IF ( z_max_do1d == -1.0 ) THEN
+ nz_do1d = nzt+1
+ ELSE
+ DO k = nzb+1, nzt+1
+ nz_do1d = k
+ IF ( zw(k) > z_max_do1d ) EXIT
+ ENDDO
+ ENDIF
+
+!
+!-- Upper plot limit for 2D vertical sections
+ IF ( z_max_do2d == -1.0 ) z_max_do2d = zu(nzt)
+ IF ( z_max_do2d < zu(nzb+1) .OR. z_max_do2d > zu(nzt) ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: z_max_do2d=', &
+ z_max_do2d, ' must be >= ', zu(nzb+1), &
+ '(zu(nzb+1)) and <= ', zu(nzt), ' (zu(nzt))'
+ CALL local_stop
+ ENDIF
+
+!
+!-- Upper plot limit for 3D arrays
+ IF ( nz_do3d == -9999 ) nz_do3d = nzt + 1
+
+!
+!-- Determine and check accuracy for compressed 3D plot output
+ IF ( do3d_compress ) THEN
+!
+!-- Compression only permissible on T3E machines
+ IF ( host(1:3) /= 't3e' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: do3d_compress = .TRUE. not allow', &
+ 'ed on host "', TRIM( host ), '"'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ i = 1
+ DO WHILE ( do3d_comp_prec(i) /= ' ' )
+
+ ilen = LEN_TRIM( do3d_comp_prec(i) )
+ IF ( LLT( do3d_comp_prec(i)(ilen:ilen), '0' ) .OR. &
+ LGT( do3d_comp_prec(i)(ilen:ilen), '9' ) ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: illegal precision: ', &
+ 'do3d_comp_prec(', i, ')="', TRIM(do3d_comp_prec(i)),'"'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ prec = IACHAR( do3d_comp_prec(i)(ilen:ilen) ) - IACHAR( '0' )
+ var = do3d_comp_prec(i)(1:ilen-1)
+
+ SELECT CASE ( var )
+
+ CASE ( 'u' )
+ j = 1
+ CASE ( 'v' )
+ j = 2
+ CASE ( 'w' )
+ j = 3
+ CASE ( 'p' )
+ j = 4
+ CASE ( 'pt' )
+ j = 5
+
+ CASE DEFAULT
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: unknown variable in ', &
+ 'assignment'
+ PRINT*, ' do3d_comp_prec(', i, ')="', &
+ TRIM( do3d_comp_prec(i) ),'"'
+ ENDIF
+ CALL local_stop
+
+ END SELECT
+
+ plot_3d_precision(j)%precision = prec
+ i = i + 1
+
+ ENDDO
+ ENDIF
+
+!
+!-- Check the data output format(s)
+ IF ( data_output_format(1) == ' ' ) THEN
+!
+!-- Default value
+ netcdf_output = .TRUE.
+ ELSE
+ i = 1
+ DO WHILE ( data_output_format(i) /= ' ' )
+
+ SELECT CASE ( data_output_format(i) )
+
+ CASE ( 'netcdf' )
+ netcdf_output = .TRUE.
+ CASE ( 'iso2d' )
+ iso2d_output = .TRUE.
+ CASE ( 'profil' )
+ profil_output = .TRUE.
+ CASE ( 'avs' )
+ avs_output = .TRUE.
+
+ CASE DEFAULT
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown value for data_output_format "', &
+ TRIM( data_output_format(i) ),'"'
+ ENDIF
+ CALL local_stop
+
+ END SELECT
+
+ i = i + 1
+ IF ( i > 10 ) EXIT
+
+ ENDDO
+
+ ENDIF
+
+!
+!-- Check netcdf precison
+ ldum = .FALSE.
+ CALL define_netcdf_header( 'ch', ldum, 0 )
+
+!
+!-- Check, whether a constant diffusion coefficient shall be used
+ IF ( km_constant /= -1.0 ) THEN
+ IF ( km_constant < 0.0 ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: km_constant=', &
+ km_constant, ' < 0.0'
+ CALL local_stop
+ ELSE
+ IF ( prandtl_number < 0.0 ) THEN
+ IF ( myid == 0 ) PRINT*,'+++ check_parameters: prandtl_number=',&
+ prandtl_number, ' < 0.0'
+ CALL local_stop
+ ENDIF
+ constant_diffusion = .TRUE.
+
+ IF ( prandtl_layer ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: prandtl_layer ',&
+ 'is not allowed with fixed value of km'
+ CALL local_stop
+ ENDIF
+ ENDIF
+ ENDIF
+
+!
+!-- In case of non-cyclic lateral boundaries, set the default maximum value
+!-- for the horizontal diffusivity used within the outflow damping layer,
+!-- and check/set the width of the damping layer
+ IF ( bc_lr /= 'cyclic' ) THEN
+ IF ( km_damp_max == -1.0 ) THEN
+ km_damp_max = 0.5 * dx
+ ENDIF
+ IF ( outflow_damping_width == -1.0 ) THEN
+ outflow_damping_width = MIN( 20, nx/2 )
+ ENDIF
+ IF ( outflow_damping_width <= 0 .OR. outflow_damping_width > nx ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: outflow_damping w',&
+ 'idth out of range'
+ CALL local_stop
+ ENDIF
+ ENDIF
+
+ IF ( bc_ns /= 'cyclic' ) THEN
+ IF ( km_damp_max == -1.0 ) THEN
+ km_damp_max = 0.5 * dy
+ ENDIF
+ IF ( outflow_damping_width == -1.0 ) THEN
+ outflow_damping_width = MIN( 20, ny/2 )
+ ENDIF
+ IF ( outflow_damping_width <= 0 .OR. outflow_damping_width > ny ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: outflow_damping w',&
+ 'idth out of range'
+ CALL local_stop
+ ENDIF
+ ENDIF
+
+!
+!-- Check value range for rif
+ IF ( rif_min >= rif_max ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: rif_min=', rif_min, &
+ ' must be less than rif_max=', rif_max
+ CALL local_stop
+ ENDIF
+
+!
+!-- Determine upper and lower hight level indices for random perturbations
+ IF ( disturbance_level_b == -9999999.9 ) THEN
+ IF ( ocean ) THEN
+ disturbance_level_b = zu((nzt*2)/3)
+ disturbance_level_ind_b = ( nzt * 2 ) / 3
+ ELSE
+ disturbance_level_b = zu(nzb+3)
+ disturbance_level_ind_b = nzb + 3
+ ENDIF
+ ELSEIF ( disturbance_level_b < zu(3) ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: disturbance_level_b=',&
+ disturbance_level_b, ' must be >= ',zu(3), &
+ '(zu(3))'
+ CALL local_stop
+ ELSEIF ( disturbance_level_b > zu(nzt-2) ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: disturbance_level_b=',&
+ disturbance_level_b, ' must be <= ',zu(nzt-2),&
+ '(zu(nzt-2))'
+ CALL local_stop
+ ELSE
+ DO k = 3, nzt-2
+ IF ( disturbance_level_b <= zu(k) ) THEN
+ disturbance_level_ind_b = k
+ EXIT
+ ENDIF
+ ENDDO
+ ENDIF
+
+ IF ( disturbance_level_t == -9999999.9 ) THEN
+ IF ( ocean ) THEN
+ disturbance_level_t = zu(nzt-3)
+ disturbance_level_ind_t = nzt - 3
+ ELSE
+ disturbance_level_t = zu(nzt/3)
+ disturbance_level_ind_t = nzt / 3
+ ENDIF
+ ELSEIF ( disturbance_level_t > zu(nzt-2) ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: disturbance_level_t=',&
+ disturbance_level_t, ' must be <= ',zu(nzt-2),&
+ '(zu(nzt-2))'
+ CALL local_stop
+ ELSEIF ( disturbance_level_t < disturbance_level_b ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: disturbance_level_t=',&
+ disturbance_level_t, ' must be >= ', &
+ 'disturbance_level_b=', disturbance_level_b
+ CALL local_stop
+ ELSE
+ DO k = 3, nzt-2
+ IF ( disturbance_level_t <= zu(k) ) THEN
+ disturbance_level_ind_t = k
+ EXIT
+ ENDIF
+ ENDDO
+ ENDIF
+
+!
+!-- Check again whether the levels determined this way are ok.
+!-- Error may occur at automatic determination and too few grid points in
+!-- z-direction.
+ IF ( disturbance_level_ind_t < disturbance_level_ind_b ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: ', &
+ 'disturbance_level_ind_t=', &
+ disturbance_level_ind_t, ' must be >= ', &
+ 'disturbance_level_ind_b=', &
+ disturbance_level_ind_b
+ CALL local_stop
+ ENDIF
+
+!
+!-- Determine the horizontal index range for random perturbations.
+!-- In case of non-cyclic horizontal boundaries, no perturbations are imposed
+!-- near the inflow and the perturbation area is further limited to ...(1)
+!-- after the initial phase of the flow.
+ dist_nxl = 0; dist_nxr = nx
+ dist_nys = 0; dist_nyn = ny
+ IF ( bc_lr /= 'cyclic' ) THEN
+ IF ( inflow_disturbance_begin == -1 ) THEN
+ inflow_disturbance_begin = MIN( 10, nx/2 )
+ ENDIF
+ IF ( inflow_disturbance_begin < 0 .OR. inflow_disturbance_begin > nx )&
+ THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: inflow_disturbance',&
+ '_begin out of range'
+ CALL local_stop
+ ENDIF
+ IF ( inflow_disturbance_end == -1 ) THEN
+ inflow_disturbance_end = MIN( 100, 3*nx/4 )
+ ENDIF
+ IF ( inflow_disturbance_end < 0 .OR. inflow_disturbance_end > nx ) &
+ THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: inflow_disturbance',&
+ '_end out of range'
+ CALL local_stop
+ ENDIF
+ ELSEIF ( bc_ns /= 'cyclic' ) THEN
+ IF ( inflow_disturbance_begin == -1 ) THEN
+ inflow_disturbance_begin = MIN( 10, ny/2 )
+ ENDIF
+ IF ( inflow_disturbance_begin < 0 .OR. inflow_disturbance_begin > ny )&
+ THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: inflow_disturbance',&
+ '_begin out of range'
+ CALL local_stop
+ ENDIF
+ IF ( inflow_disturbance_end == -1 ) THEN
+ inflow_disturbance_end = MIN( 100, 3*ny/4 )
+ ENDIF
+ IF ( inflow_disturbance_end < 0 .OR. inflow_disturbance_end > ny ) &
+ THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: inflow_disturbance',&
+ '_end out of range'
+ CALL local_stop
+ ENDIF
+ ENDIF
+
+ IF ( bc_lr == 'radiation/dirichlet' ) THEN
+ dist_nxr = nx - inflow_disturbance_begin
+ dist_nxl(1) = nx - inflow_disturbance_end
+ ELSEIF ( bc_lr == 'dirichlet/radiation' ) THEN
+ dist_nxl = inflow_disturbance_begin
+ dist_nxr(1) = inflow_disturbance_end
+ ENDIF
+ IF ( bc_ns == 'dirichlet/radiation' ) THEN
+ dist_nyn = ny - inflow_disturbance_begin
+ dist_nys(1) = ny - inflow_disturbance_end
+ ELSEIF ( bc_ns == 'radiation/dirichlet' ) THEN
+ dist_nys = inflow_disturbance_begin
+ dist_nyn(1) = inflow_disturbance_end
+ ENDIF
+
+!
+!-- Check random generator
+ IF ( random_generator /= 'system-specific' .AND. &
+ random_generator /= 'numerical-recipes' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters:'
+ PRINT*, ' unknown random generator: random_generator=', &
+ random_generator
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Determine damping level index for 1D model
+ IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 ) THEN
+ IF ( damp_level_1d == -1.0 ) THEN
+ damp_level_1d = zu(nzt+1)
+ damp_level_ind_1d = nzt + 1
+ ELSEIF ( damp_level_1d < 0.0 .OR. damp_level_1d > zu(nzt+1) ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: damp_level_1d=', &
+ damp_level_1d, ' must be > 0.0 and < ', &
+ 'zu(nzt+1)', zu(nzt+1)
+ CALL local_stop
+ ELSE
+ DO k = 1, nzt+1
+ IF ( damp_level_1d <= zu(k) ) THEN
+ damp_level_ind_1d = k
+ EXIT
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+!
+!-- Check some other 1d-model parameters
+ IF ( TRIM( mixing_length_1d ) /= 'as_in_3d_model' .AND. &
+ TRIM( mixing_length_1d ) /= 'blackadar' ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: mixing_length_1d = "', &
+ TRIM( mixing_length_1d ), '" is unknown'
+ CALL local_stop
+ ENDIF
+ IF ( TRIM( dissipation_1d ) /= 'as_in_3d_model' .AND. &
+ TRIM( dissipation_1d ) /= 'detering' ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ check_parameters: dissipation_1d = "', &
+ TRIM( dissipation_1d ), '" is unknown'
+ CALL local_stop
+ ENDIF
+
+!
+!-- Set time for the next user defined restart (time_restart is the
+!-- internal parameter for steering restart events)
+ IF ( restart_time /= 9999999.9 ) THEN
+ IF ( restart_time > simulated_time ) time_restart = restart_time
+ ELSE
+!
+!-- In case of a restart run, set internal parameter to default (no restart)
+!-- if the NAMELIST-parameter restart_time is omitted
+ time_restart = 9999999.9
+ ENDIF
+
+!
+!-- Set default value of the time needed to terminate a model run
+ IF ( termination_time_needed == -1.0 ) THEN
+ IF ( host(1:3) == 'ibm' ) THEN
+ termination_time_needed = 300.0
+ ELSE
+ termination_time_needed = 35.0
+ ENDIF
+ ENDIF
+
+!
+!-- Check the time needed to terminate a model run
+ IF ( host(1:3) == 't3e' ) THEN
+!
+!-- Time needed must be at least 30 seconds on all CRAY machines, because
+!-- MPP_TREMAIN gives the remaining CPU time only in steps of 30 seconds
+ IF ( termination_time_needed <= 30.0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ check_parameters: termination_time_needed', &
+ termination_time_needed
+ PRINT*, ' must be > 30.0 on host "', host, &
+ '"'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ELSEIF ( host(1:3) == 'ibm' ) THEN
+!
+!-- On IBM-regatta machines the time should be at least 300 seconds,
+!-- because the job time consumed before executing palm (for compiling,
+!-- copying of files, etc.) has to be regarded
+ IF ( termination_time_needed < 300.0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ WARNING: check_parameters: termination_time_', &
+ 'needed', termination_time_needed
+ PRINT*, ' should be >= 300.0', &
+ ' on host "', host, '"'
+ ENDIF
+ ENDIF
+ ENDIF
+
+
+ END SUBROUTINE check_parameters
Index: /palm/tags/release-3.4a/SOURCE/close_file.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/close_file.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/close_file.f90 (revision 141)
@@ -0,0 +1,519 @@
+ SUBROUTINE close_file( file_id )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.10 2006/08/22 13:50:01 raasch
+! xz and yz cross sections now up to nzt+1
+!
+! Revision 1.1 2001/01/02 17:23:41 raasch
+! Initial revision
+!
+! Last revision before renaming subroutine 2001/01/01 raasch
+! Subroutine name changed from close_files to close_file. Closing of a single
+! file is allowed by passing its file-id as an argument. Variable openfile now
+! is of type file_status and contains a flag which indicates if a file has
+! been opened before. Old revision remarks deleted.
+!
+! Revision 1.13 (close_files) 2000/12/20 09:10:24 letzel
+! All comments translated into English.
+!
+! Revision 1.12 (close_files) 1999/03/02 09:22:46 raasch
+! FLD-Header fuer komprimierte 3D-Daten
+!
+! Revision 1.1 (close_files) 1997/08/11 06:11:18 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Close specified file or all open files, if "0" has been given as the
+! calling argument. In that case, execute last actions for certain unit
+! numbers, if required.
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE netcdf_control
+ USE pegrid
+ USE profil_parameter
+ USE statistics
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=2) :: suffix
+ CHARACTER (LEN=10) :: datform = 'lit_endian'
+ CHARACTER (LEN=80) :: rtext, title, utext = '', xtext = '', ytext = ''
+
+ INTEGER :: anzzeile, cranz, cross_count, cross_numbers, dimx, dimy, &
+ fid, file_id, j, k, legpos = 1, planz, timodex = 1
+ INTEGER, DIMENSION(100) :: klist, lstyle, cucol
+
+ LOGICAL :: checkuf = .TRUE., datleg = .TRUE., dp = .FALSE., &
+ grid = .TRUE., rand = .TRUE., swap, twoxa = .TRUE., &
+ twoya = .TRUE.
+
+ REAL :: ansx = -999.999, ansy = -999.999, gwid = 0.1, rlegfak, &
+ sizex, sizey, texfac, utmove = 50.0, uxmax, uxmin, uymax, &
+ uymin, yright
+ REAL, DIMENSION(100) :: lwid, normx, normy
+
+ NAMELIST /CROSS/ ansx, ansy, cucol, grid, gwid, klist, legpos, lstyle, &
+ lwid, normx, normy, rand, rlegfak, sizex, sizey, &
+ texfac, timodex, twoxa, twoya, utext, utmove, uxmax, &
+ uxmin, uymax, uymin, xtext, ytext
+ NAMELIST /GLOBAL/ checkuf, datform, dimx, dimy, dp, planz, sizex, sizey, &
+ title, yright
+ NAMELIST /RAHMEN/ anzzeile, cranz, datleg, rtext, swap
+
+!
+!-- Close specified unit number (if opened) and set a flag that it has
+!-- been opened one time at least
+ IF ( file_id /= 0 ) THEN
+ IF ( openfile(file_id)%opened ) THEN
+ CLOSE ( file_id )
+ openfile(file_id)%opened = .FALSE.
+ openfile(file_id)%opened_before = .TRUE.
+ ENDIF
+ RETURN
+ ENDIF
+
+!
+!-- Close all open unit numbers
+ DO fid = 1, 116
+
+ IF ( openfile(fid)%opened .OR. openfile(fid)%opened_before ) THEN
+!
+!-- Last actions for certain unit numbers
+ SELECT CASE ( fid )
+
+ CASE ( 21 )
+!
+!-- Write ISO2D global parameters
+ IF ( myid == 0 .AND. iso2d_output ) THEN
+ planz = do2d_xy_n
+ dimx = nx + 2
+ dimy = ny + 2
+ sizex = 100.0
+ sizey = 100.0
+ title = run_description_header
+ yright = ( ny + 1.0 ) * dy
+ IF ( host(1:3) == 'ibm' .OR. host(1:3) == 't3e' ) THEN
+ checkuf = .FALSE.; dp = .TRUE.
+ ENDIF
+ IF ( host(1:3) == 'ibm' .OR. host(1:3) == 'nec' ) THEN
+ datform = 'big_endian'
+ ENDIF
+ OPEN ( 90, FILE='PLOT2D_XY_GLOBAL', FORM='FORMATTED', &
+ DELIM='APOSTROPHE' )
+ WRITE ( 90, GLOBAL )
+ CLOSE ( 90 )
+ ENDIF
+
+ CASE ( 22 )
+!
+!-- Write ISO2D global parameters
+ IF ( myid == 0 ) THEN
+ planz = do2d_xz_n
+ dimx = nx + 2
+ dimy = nz + 2
+ sizex = 100.0
+ sizey = 65.0
+ title = run_description_header
+ yright = z_max_do2d
+ IF ( host(1:3) == 'ibm' .OR. host(1:3) == 't3e' ) THEN
+ checkuf = .FALSE.; dp = .TRUE.
+ ENDIF
+ IF ( host(1:3) == 'ibm' .OR. host(1:3) == 'nec' ) THEN
+ datform = 'big_endian'
+ ENDIF
+ OPEN ( 90, FILE='PLOT2D_XZ_GLOBAL', FORM='FORMATTED', &
+ DELIM='APOSTROPHE' )
+ WRITE ( 90, GLOBAL )
+ CLOSE ( 90 )
+ ENDIF
+
+ CASE ( 23 )
+!
+!-- Write ISO2D global parameters
+ IF ( myid == 0 ) THEN
+ planz = do2d_yz_n
+ dimx = ny + 2
+ dimy = nz + 2
+ sizex = 100.0
+ sizey = 65.0
+ title = run_description_header
+ yright = z_max_do2d
+ IF ( host(1:3) == 'ibm' .OR. host(1:3) == 't3e' ) THEN
+ checkuf = .FALSE.; dp = .TRUE.
+ ENDIF
+ IF ( host(1:3) == 'ibm' .OR. host(1:3) == 'nec' ) THEN
+ datform = 'big_endian'
+ ENDIF
+ OPEN ( 90, FILE='PLOT2D_YZ_GLOBAL', FORM='FORMATTED', &
+ DELIM='APOSTROPHE' )
+ WRITE ( 90, GLOBAL )
+ CLOSE ( 90 )
+ ENDIF
+
+ CASE ( 32 )
+!
+!-- Write header for FLD-file
+ IF ( do3d_compress ) THEN
+ WRITE ( 32, 3200) ' compressed ', &
+ TRIM( run_description_header ), nx+2, &
+ ny+2, nz_do3d+1, do3d_avs_n
+ ELSE
+ WRITE ( 32, 3200) ' ', TRIM( run_description_header ), &
+ nx+2, ny+2, nz_do3d+1, do3d_avs_n
+ ENDIF
+
+ CASE ( 40:49 )
+!
+!-- Write PROFIL namelist parameters for 1D profiles.
+!-- First determine, how many crosses are to be drawn.
+ IF ( myid == 0 ) THEN
+ cross_numbers = 0
+ DO j = 1, crmax
+ IF ( cross_profile_number_count(j) /= 0 ) THEN
+ cross_numbers = cross_numbers + 1
+ ENDIF
+ ENDDO
+
+ IF ( cross_numbers /= 0 ) THEN
+!
+!-- Determine remaining RAHMEN parameters
+ swap = .FALSE.
+ rtext = '\0.5 ' // TRIM( run_description_header ) // &
+ ' ' // TRIM( region( fid - 40 ) )
+!
+!-- Write RAHMEN parameters
+ IF ( statistic_regions == 0 .AND. fid == 40 ) THEN
+ suffix = ''
+ ELSE
+ WRITE ( suffix, '(''_'',I1)' ) fid - 40
+ ENDIF
+ OPEN ( 90, FILE='PLOT1D_PAR' // TRIM( suffix ), &
+ FORM='FORMATTED', DELIM='APOSTROPHE' )
+!
+!-- Subtitle for crosses with time averaging
+ IF ( averaging_interval_pr /= 0.0 ) THEN
+ WRITE ( utext, 4000 ) averaging_interval_pr
+ ENDIF
+!
+!-- Determine and write CROSS parameters for each individual
+!-- cross
+ cross_count = 0
+ DO j = 1, crmax
+ k = cross_profile_number_count(j)
+ IF ( k /= 0 ) THEN
+ cross_count = cross_count + 1
+!
+!-- Write RAHMEN parameters
+ IF ( MOD( cross_count-1, &
+ profile_rows*profile_columns ) == 0 ) &
+ THEN
+!
+!-- Determine number of crosses still to be drawn
+ cranz = MIN( cross_numbers - cross_count + 1, &
+ profile_rows * profile_columns )
+!
+!-- If the first line cannot be filled with crosses
+!-- completely, the default number of crosses per
+!-- line has to be reduced.
+ IF ( cranz < profile_columns ) THEN
+ anzzeile = cranz
+ ELSE
+ anzzeile = profile_columns
+ ENDIF
+
+ WRITE ( 90, RAHMEN )
+
+ ENDIF
+!
+!-- Store graph numbers
+ klist(1:k) = cross_profile_numbers(1:k,j)
+ klist(k+1:100) = 999999
+!
+!-- Store graph attributes
+ cucol = cross_linecolors(:,j)
+ lstyle = cross_linestyles(:,j)
+ lwid = 0.6
+!
+!-- Sizes, text etc.
+ sizex = 100.0; sizey = 120.0
+ rlegfak = 0.7; texfac = 1.0
+!
+!-- Determine range of x-axis values
+ IF ( cross_normalized_x(j) == ' ' ) THEN
+!
+!-- Non-normalized profiles
+ IF ( cross_uxmin(j) == 0.0 .AND. &
+ cross_uxmax(j) == 0.0 ) THEN
+ uxmin = cross_uxmin_computed(j)
+ uxmax = cross_uxmax_computed(j)
+ IF ( uxmin == uxmax ) uxmax = uxmin + 1.0
+ ELSE
+!
+!-- Values set in check_parameters are used here
+ uxmin = cross_uxmin(j); uxmax = cross_uxmax(j)
+ ENDIF
+ ELSE
+!
+!-- Normalized profiles
+ IF ( cross_uxmin_normalized(j) == 0.0 .AND. &
+ cross_uxmax_normalized(j) == 0.0 ) THEN
+ uxmin = cross_uxmin_normalized_computed(j)
+ uxmax = cross_uxmax_normalized_computed(j)
+ IF ( uxmin == uxmax ) uxmax = uxmin + 1.0
+ ELSE
+!
+!-- Values set in check_parameters are used here
+ uxmin = cross_uxmin_normalized(j)
+ uxmax = cross_uxmax_normalized(j)
+ ENDIF
+ ENDIF
+!
+!-- Range of y-axis values
+!-- may be re-adjusted during normalization if required
+ uymin = cross_uymin(j); uymax = cross_uymax(j)
+ ytext = 'height in m'
+!
+!-- Normalization of the axes
+ normx = cross_normx_factor(:,j)
+ normy = cross_normy_factor(:,j)
+!
+!-- Labelling of the axes
+ IF ( cross_normalized_x(j) == ' ' ) THEN
+ xtext = cross_xtext(j)
+ ELSE
+ xtext = TRIM( cross_xtext(j) ) // ' / ' // &
+ cross_normalized_x(j)
+ ENDIF
+ IF ( cross_normalized_y(j) == ' ' ) THEN
+ ytext = 'height in m'
+ ELSE
+ ytext = 'height in m' // ' / ' // &
+ cross_normalized_y(j)
+!
+!-- Determine upper limit of value range
+ IF ( z_max_do1d_normalized /= -1.0 ) THEN
+ uymax = z_max_do1d_normalized
+ ENDIF
+ ENDIF
+
+ WRITE ( 90, CROSS )
+
+ ENDIF
+ ENDDO
+
+ CLOSE ( 90 )
+ ENDIF
+ ENDIF
+
+ CASE ( 50:59 )
+!
+!-- Write PROFIL namelist parameters for time series
+!-- first determine number of crosses to be drawn
+ IF ( myid == 0 ) THEN
+ cranz = 0
+ DO j = 1, 12
+ IF ( cross_ts_number_count(j) /= 0 ) cranz = cranz+1
+ ENDDO
+
+ IF ( cranz /= 0 ) THEN
+!
+!-- Determine RAHMEN parameters
+ anzzeile = 1
+ swap = .TRUE.
+ rtext = '\1.0 ' // TRIM( run_description_header ) // &
+ ' ' // TRIM( region( fid - 50 ) )
+!
+!-- Write RAHMEN parameters
+ IF ( statistic_regions == 0 .AND. fid == 50 ) THEN
+ suffix = ''
+ ELSE
+ WRITE ( suffix, '(''_'',I1)' ) fid - 50
+ ENDIF
+ OPEN ( 90, FILE='PLOTTS_PAR' // TRIM( suffix ), &
+ FORM='FORMATTED', DELIM='APOSTROPHE' )
+ WRITE ( 90, RAHMEN )
+!
+!-- Determine and write CROSS parameters for each individual
+!-- cross
+ DO j = 1, 12
+ k = cross_ts_number_count(j)
+ IF ( k /= 0 ) THEN
+!
+!-- Store graph numbers
+ klist(1:k) = cross_ts_numbers(1:k,j)
+ klist(k+1:100) = 999999
+!
+!-- Store graph attributes
+ cucol(1:k) = linecolors(1:k)
+ lstyle(1:k) = linestyles(1:k)
+ lwid = 0.4
+!
+!-- Sizes, text etc.
+ sizex = 250.0; sizey = 40.0
+ rlegfak = 1.5; texfac = 1.5
+ xtext = 'time in s'
+ ytext = ''
+ utext = ''
+!
+!-- Determine range of y-axis values
+ IF ( cross_ts_uymin(j) == 999.999 ) THEN
+ uymin = cross_ts_uymin_computed(j)
+ ELSE
+ uymin = cross_ts_uymin(j)
+ ENDIF
+ IF ( cross_ts_uymax(j) == 999.999 ) THEN
+ uymax = cross_ts_uymax_computed(j)
+ ELSE
+ uymax = cross_ts_uymax(j)
+ ENDIF
+ IF ( uymin == uymax ) uymax = uymin + 1.0
+!
+!-- Range of x-axis values
+ uxmin = 0.0; uxmax = simulated_time
+!
+!-- Normalizations
+ normx = 1.0; normy = 1.0
+
+ WRITE ( 90, CROSS )
+
+ ENDIF
+ ENDDO
+
+ CLOSE ( 90 )
+ ENDIF
+ ENDIF
+
+#if defined( __netcdf )
+ CASE ( 101 )
+
+ IF ( myid == 0 .AND. netcdf_output ) THEN
+ nc_stat = NF90_CLOSE( id_set_xy(0) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 44 )
+ ENDIF
+
+ CASE ( 102 )
+
+ IF ( myid == 0 .AND. netcdf_output ) THEN
+ nc_stat = NF90_CLOSE( id_set_xz(0) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 45 )
+ ENDIF
+
+ CASE ( 103 )
+
+ IF ( myid == 0 .AND. netcdf_output ) THEN
+ nc_stat = NF90_CLOSE( id_set_yz(0) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 46 )
+ ENDIF
+
+ CASE ( 104 )
+
+ IF ( myid == 0 .AND. netcdf_output ) THEN
+ nc_stat = NF90_CLOSE( id_set_pr )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 47 )
+ ENDIF
+
+ CASE ( 105 )
+
+ IF ( myid == 0 .AND. netcdf_output ) THEN
+ nc_stat = NF90_CLOSE( id_set_ts )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 48 )
+ ENDIF
+
+ CASE ( 106 )
+
+ IF ( myid == 0 .AND. netcdf_output ) THEN
+ nc_stat = NF90_CLOSE( id_set_3d(0) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 49 )
+ ENDIF
+
+ CASE ( 107 )
+
+ IF ( myid == 0 .AND. netcdf_output ) THEN
+ nc_stat = NF90_CLOSE( id_set_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 50 )
+ ENDIF
+
+ CASE ( 108 )
+
+ IF ( netcdf_output ) THEN
+ nc_stat = NF90_CLOSE( id_set_prt )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 51 )
+ ENDIF
+
+ CASE ( 109 )
+
+ IF ( netcdf_output ) THEN
+ nc_stat = NF90_CLOSE( id_set_pts )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 412 )
+ ENDIF
+
+ CASE ( 111 )
+
+ IF ( myid == 0 .AND. netcdf_output ) THEN
+ nc_stat = NF90_CLOSE( id_set_xy(1) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 52 )
+ ENDIF
+
+ CASE ( 112 )
+
+ IF ( myid == 0 .AND. netcdf_output ) THEN
+ nc_stat = NF90_CLOSE( id_set_xz(1) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 352 )
+ ENDIF
+
+ CASE ( 113 )
+
+ IF ( myid == 0 .AND. netcdf_output ) THEN
+ nc_stat = NF90_CLOSE( id_set_yz(1) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 353 )
+ ENDIF
+
+ CASE ( 116 )
+
+ IF ( myid == 0 .AND. netcdf_output ) THEN
+ nc_stat = NF90_CLOSE( id_set_3d(1) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 353 )
+ ENDIF
+
+#endif
+
+ END SELECT
+!
+!-- Close file
+ IF ( openfile(fid)%opened ) CLOSE ( fid )
+
+ ENDIF
+
+ ENDDO
+
+!
+!-- Formats
+3200 FORMAT ('# AVS',A,'field file'/ &
+ '#'/ &
+ '# ',A/ &
+ 'ndim=3'/ &
+ 'dim1=',I5/ &
+ 'dim2=',I5/ &
+ 'dim3=',I5/ &
+ 'nspace=3'/ &
+ 'veclen=',I5/ &
+ 'data=xdr_float'/ &
+ 'field=rectilinear')
+4000 FORMAT ('time averaged over',F7.1,' s')
+
+
+ END SUBROUTINE close_file
Index: /palm/tags/release-3.4a/SOURCE/compute_vpt.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/compute_vpt.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/compute_vpt.f90 (revision 141)
@@ -0,0 +1,43 @@
+ SUBROUTINE compute_vpt
+
+!-------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.5 2001/03/30 06:58:52 raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.1 2000/04/13 14:40:53 schroeter
+! Initial revision
+!
+!
+! Description:
+! -------------
+! Computation of the virtual potential temperature
+!-------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE indices
+ USE cloud_parameters
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ INTEGER :: k
+
+ IF ( .NOT. cloud_physics ) THEN
+ vpt = pt * ( 1.0 + 0.61 * q )
+ ELSE
+ DO k = nzb, nzt+1
+ vpt(k,:,:) = ( pt(k,:,:) + pt_d_t(k) * l_d_cp * ql(k,:,:) ) * &
+ ( 1.0 + 0.61 * q(k,:,:) - 1.61 * ql(k,:,:) )
+ ENDDO
+ ENDIF
+
+ END SUBROUTINE compute_vpt
Index: /palm/tags/release-3.4a/SOURCE/coriolis.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/coriolis.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/coriolis.f90 (revision 141)
@@ -0,0 +1,176 @@
+ MODULE coriolis_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 106 2007-08-16 14:30:26Z raasch
+! loops for u and v are starting from index nxlu, nysv, respectively (needed
+! for non-cyclic boundary conditions)
+!
+! 75 2007-03-22 09:54:05Z raasch
+! uxrp, vynp eliminated
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.12 2006/02/23 10:08:57 raasch
+! nzb_2d replaced by nzb_u/v/w_inner
+!
+! Revision 1.1 1997/08/29 08:57:38 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Computation of all Coriolis terms in the equations of motion.
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC coriolis
+
+ INTERFACE coriolis
+ MODULE PROCEDURE coriolis
+ MODULE PROCEDURE coriolis_ij
+ END INTERFACE coriolis
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE coriolis( component )
+
+ USE arrays_3d
+ USE control_parameters
+ USE indices
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: component, i, j, k
+
+
+!
+!-- Compute Coriolis terms for the three velocity components
+ SELECT CASE ( component )
+
+!
+!-- u-component
+ CASE ( 1 )
+ DO i = nxlu, nxr
+ DO j = nys, nyn
+ DO k = nzb_u_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) + f * ( 0.25 * &
+ ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &
+ v(k,j+1,i) ) - vg(k) ) &
+ - fs * ( 0.25 * &
+ ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
+ w(k,j,i) ) &
+ )
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- v-component
+ CASE ( 2 )
+ DO i = nxl, nxr
+ DO j = nysv, nyn
+ DO k = nzb_v_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) - f * ( 0.25 * &
+ ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
+ u(k,j,i+1) ) - ug(k) )
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- w-component
+ CASE ( 3 )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_w_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) + fs * 0.25 * &
+ ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
+ u(k+1,j,i+1) )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE DEFAULT
+
+ IF ( myid == 0 ) PRINT*,'+++ coriolis: wrong component: ', &
+ component
+ CALL local_stop
+
+ END SELECT
+
+ END SUBROUTINE coriolis
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE coriolis_ij( i, j, component )
+
+ USE arrays_3d
+ USE control_parameters
+ USE indices
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: component, i, j, k
+
+!
+!-- Compute Coriolis terms for the three velocity components
+ SELECT CASE ( component )
+
+!
+!-- u-component
+ CASE ( 1 )
+ DO k = nzb_u_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) + f * ( 0.25 * &
+ ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) + &
+ v(k,j+1,i) ) - vg(k) ) &
+ - fs * ( 0.25 * &
+ ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
+ w(k,j,i) ) &
+ )
+ ENDDO
+
+!
+!-- v-component
+ CASE ( 2 )
+ DO k = nzb_v_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) - f * ( 0.25 * &
+ ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
+ u(k,j,i+1) ) - ug(k) )
+ ENDDO
+
+!
+!-- w-component
+ CASE ( 3 )
+ DO k = nzb_w_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) + fs * 0.25 * &
+ ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
+ u(k+1,j,i+1) )
+ ENDDO
+
+ CASE DEFAULT
+
+ IF ( myid == 0 ) PRINT*,'+++ coriolis: wrong component: ', &
+ component
+ CALL local_stop
+
+ END SELECT
+
+ END SUBROUTINE coriolis_ij
+
+ END MODULE coriolis_mod
Index: /palm/tags/release-3.4a/SOURCE/cpu_log.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/cpu_log.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/cpu_log.f90 (revision 141)
@@ -0,0 +1,114 @@
+ SUBROUTINE cpu_log( log_event, place, modus, barrierwait )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 82 2007-04-16 15:40:52Z raasch
+! Preprocessor strings for different linux clusters changed to "lc",
+! preprocessor directives for old systems removed
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.24 2006/06/02 15:12:17 raasch
+! cpp-directives extended for lctit
+!
+! Revision 1.1 1997/07/24 11:12:29 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Cpu-time measurements for any program part whatever.
+!------------------------------------------------------------------------------!
+
+ USE cpulog
+ USE pegrid
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: modus, place
+ CHARACTER (LEN=*), OPTIONAL :: barrierwait
+ LOGICAL, SAVE :: first = .TRUE.
+ REAL :: mtime = 0.0, mtimevec = 0.0
+ TYPE(logpoint) :: log_event
+
+#if defined( __lc ) || defined( __decalpha ) || defined( __nec )
+ INTEGER :: count, count_rate
+#elif defined( __ibm )
+ INTEGER(8) :: IRTC
+#endif
+
+
+!
+!-- Initialize and check, respectively, point of measurement
+ IF ( log_event%place == ' ' ) THEN
+ log_event%place = place
+ ELSEIF ( log_event%place /= place ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ cpu_log: wrong argument'
+ PRINT*,' expected: ',log_event%place,' given: ', place
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Take current time
+#if defined( __lc ) || defined( __decalpha ) || defined( __nec )
+ CALL SYSTEM_CLOCK( count, count_rate )
+ mtime = REAL( count ) / REAL( count_rate )
+#elif defined( __ibm )
+ mtime = IRTC( ) * 1E-9
+#else
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ cpu_log: no time measurement defined on this host'
+ ENDIF
+ CALL local_stop
+#endif
+
+!
+!-- Start, stop or pause measurement
+ IF ( modus == 'start' .OR. modus == 'continue' ) THEN
+ log_event%mtime = mtime
+ log_event%mtimevec = mtimevec
+ ELSEIF ( modus == 'pause' ) THEN
+ IF ( ( mtime - log_event%mtime ) < 0.0 .AND. first ) THEN
+ PRINT*,'+++ WARNING: cpu_log: negative time interval occured'
+ PRINT*,'+++ PE',myid,' L=PAUSE "',TRIM(log_event%place),'" new=', &
+ mtime,' last=',log_event%mtime
+ first = .FALSE.
+ ENDIF
+ log_event%isum = log_event%isum + mtime - log_event%mtime
+ log_event%ivect = log_event%ivect + mtimevec - log_event%mtimevec
+ ELSEIF ( modus == 'stop' ) THEN
+ IF ( ( mtime - log_event%mtime + log_event%isum ) < 0.0 .AND. &
+ first ) THEN
+ PRINT*,'+++ WARNING: cpu_log: negative time interval occured'
+ PRINT*,'+++ PE',myid,' L=STOP "',TRIM(log_event%place),'" new=', &
+ mtime,' last=',log_event%mtime,' isum=',log_event%isum
+ first = .FALSE.
+ ENDIF
+ log_event%mtime = mtime - log_event%mtime + log_event%isum
+ log_event%mtimevec = mtimevec - log_event%mtimevec + log_event%ivect
+ log_event%sum = log_event%sum + log_event%mtime
+ IF ( log_event%sum < 0.0 .AND. first ) THEN
+ PRINT*,'+++ WARNING: cpu_log: negative time interval occured'
+ PRINT*,'+++ PE',myid,' L=STOP "',TRIM(log_event%place),'" sum=', &
+ log_event%sum,' mtime=',log_event%mtime
+ first = .FALSE.
+ ENDIF
+ log_event%vector = log_event%vector + log_event%mtimevec
+ log_event%counts = log_event%counts + 1
+ log_event%isum = 0.0
+ log_event%ivect = 0.0
+ ELSE
+ PRINT*, '+++ unknown modus of time measurement: ', modus
+ ENDIF
+
+
+ END SUBROUTINE cpu_log
Index: /palm/tags/release-3.4a/SOURCE/cpu_statistics.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/cpu_statistics.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/cpu_statistics.f90 (revision 141)
@@ -0,0 +1,269 @@
+ SUBROUTINE cpu_statistics
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 82 2007-04-16 15:40:52Z raasch
+! Preprocessor directives for old systems removed
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.13 2006/04/26 12:10:51 raasch
+! Output of number of threads per task, max = min in case of 1 PE
+!
+! Revision 1.1 1997/07/24 11:11:11 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Analysis and output of the cpu-times measured. All PE results are collected
+! on PE0 in order to calculate the mean cpu-time over all PEs and other
+! statistics. The output is sorted according to the amount of cpu-time consumed
+! and output on PE0.
+!------------------------------------------------------------------------------!
+
+ USE cpulog
+ USE pegrid
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ INTEGER :: i, ii(1), iii, lp, sender
+ REAL, SAVE :: norm = 1.0
+ REAL, DIMENSION(:), ALLOCATABLE :: pe_max, pe_min, pe_rms, sum
+ REAL, DIMENSION(:,:), ALLOCATABLE :: pe_log_points
+
+
+!
+!-- Compute cpu-times in seconds
+ log_point%mtime = log_point%mtime / norm
+ log_point%sum = log_point%sum / norm
+ log_point%vector = log_point%vector / norm
+ WHERE ( log_point%counts /= 0 )
+ log_point%mean = log_point%sum / log_point%counts
+ END WHERE
+
+
+!
+!-- Collect cpu-times from all PEs and calculate statistics
+ IF ( myid == 0 ) THEN
+!
+!-- Allocate and initialize temporary arrays needed for statistics
+ ALLOCATE( pe_max( SIZE( log_point ) ), pe_min( SIZE( log_point ) ), &
+ pe_rms( SIZE( log_point ) ), &
+ pe_log_points( SIZE( log_point ), 0:numprocs-1 ) )
+ pe_min = log_point%sum
+ pe_max = log_point%sum ! need to be set in case of 1 PE
+ pe_rms = 0.0
+
+#if defined( __parallel )
+!
+!-- Receive data from all PEs
+ DO i = 1, numprocs-1
+ CALL MPI_RECV( pe_max(1), SIZE( log_point ), MPI_REAL, &
+ MPI_ANY_SOURCE, MPI_ANY_TAG, comm2d, status, ierr )
+ sender = status(MPI_SOURCE)
+ pe_log_points(:,sender) = pe_max
+ ENDDO
+ pe_log_points(:,0) = log_point%sum ! Results from PE0
+!
+!-- Calculate mean of all PEs, store it on log_point%sum
+!-- and find minimum and maximum
+ DO iii = 1, SIZE( log_point )
+ DO i = 1, numprocs-1
+ log_point(iii)%sum = log_point(iii)%sum + pe_log_points(iii,i)
+ pe_min(iii) = MIN( pe_min(iii), pe_log_points(iii,i) )
+ pe_max(iii) = MAX( pe_max(iii), pe_log_points(iii,i) )
+ ENDDO
+ log_point(iii)%sum = log_point(iii)%sum / numprocs
+!
+!-- Calculate rms
+ DO i = 0, numprocs-1
+! IF ( log_point(iii)%place == 'run_control' ) THEN
+! PRINT*, 'pe_rms=',pe_rms(iii),' plp=',pe_log_points(iii,i), &
+! ' lps=',log_point(iii)%sum
+! ENDIF
+ pe_rms(iii) = pe_rms(iii) + ( &
+ pe_log_points(iii,i) - log_point(iii)%sum &
+ )**2
+ ENDDO
+ pe_rms(iii) = SQRT( pe_rms(iii) / numprocs )
+ ENDDO
+ ELSE
+!
+!-- Send data to PE0 (pe_max is used as temporary storage to send
+!-- the data in order to avoid sending the data type log)
+ ALLOCATE( pe_max( SIZE( log_point ) ) )
+ pe_max = log_point%sum
+ CALL MPI_SEND( pe_max(1), SIZE( log_point ), MPI_REAL, 0, 0, comm2d, &
+ ierr )
+#endif
+
+ ENDIF
+
+!
+!-- Write cpu-times
+ IF ( myid == 0 ) THEN
+!
+!-- Re-store sums
+ ALLOCATE( sum( SIZE( log_point ) ) )
+ WHERE ( log_point%counts /= 0 )
+ sum = log_point%sum
+ ELSEWHERE
+ sum = -1.0
+ ENDWHERE
+
+!
+!-- Write cpu-times sorted by size
+ CALL check_open( 18 )
+ WRITE ( 18, 100 ) TRIM( run_description_header ), &
+ numprocs * threads_per_task, numprocs, &
+ threads_per_task
+ DO
+ ii = MAXLOC( sum )
+ i = ii(1)
+ IF ( sum(i) /= -1.0 ) THEN
+ WRITE ( 18, 102 ) &
+ log_point(i)%place, log_point(i)%sum, &
+ log_point(i)%sum / log_point(1)%sum * 100.0, &
+ log_point(i)%counts, pe_min(i), pe_max(i), pe_rms(i)
+ sum(i) = -1.0
+ ELSE
+ EXIT
+ ENDIF
+ ENDDO
+ ENDIF
+
+
+!
+!-- The same procedure again for the individual measurements.
+!
+!-- Compute cpu-times in seconds
+ log_point_s%mtime = log_point_s%mtime / norm
+ log_point_s%sum = log_point_s%sum / norm
+ log_point_s%vector = log_point_s%vector / norm
+ WHERE ( log_point_s%counts /= 0 )
+ log_point_s%mean = log_point_s%sum / log_point_s%counts
+ END WHERE
+
+!
+!-- Collect cpu-times from all PEs and calculate statistics
+#if defined( __parallel )
+!
+!-- Set barrier in order to avoid that PE0 receives log_point_s-data
+!-- while still busy with receiving log_point-data (see above)
+ CALL MPI_BARRIER( comm2d, ierr )
+#endif
+ IF ( myid == 0 ) THEN
+!
+!-- Initialize temporary arrays needed for statistics
+ pe_min = log_point_s%sum
+ pe_max = log_point_s%sum ! need to be set in case of 1 PE
+ pe_rms = 0.0
+
+#if defined( __parallel )
+!
+!-- Receive data from all PEs
+ DO i = 1, numprocs-1
+ CALL MPI_RECV( pe_max(1), SIZE( log_point ), MPI_REAL, &
+ MPI_ANY_SOURCE, MPI_ANY_TAG, comm2d, status, ierr )
+ sender = status(MPI_SOURCE)
+ pe_log_points(:,sender) = pe_max
+ ENDDO
+ pe_log_points(:,0) = log_point_s%sum ! Results from PE0
+!
+!-- Calculate mean of all PEs, store it on log_point_s%sum
+!-- and find minimum and maximum
+ DO iii = 1, SIZE( log_point )
+ DO i = 1, numprocs-1
+ log_point_s(iii)%sum = log_point_s(iii)%sum + pe_log_points(iii,i)
+ pe_min(iii) = MIN( pe_min(iii), pe_log_points(iii,i) )
+ pe_max(iii) = MAX( pe_max(iii), pe_log_points(iii,i) )
+ ENDDO
+ log_point_s(iii)%sum = log_point_s(iii)%sum / numprocs
+!
+!-- Calculate rms
+ DO i = 0, numprocs-1
+ pe_rms(iii) = pe_rms(iii) + ( &
+ pe_log_points(iii,i) - log_point_s(iii)%sum &
+ )**2
+ ENDDO
+ pe_rms(iii) = SQRT( pe_rms(iii) / numprocs )
+ ENDDO
+ ELSE
+!
+!-- Send data to PE0 (pe_max is used as temporary storage to send
+!-- the data in order to avoid sending the data type log)
+ pe_max = log_point_s%sum
+ CALL MPI_SEND( pe_max(1), SIZE( log_point ), MPI_REAL, 0, 0, comm2d, &
+ ierr )
+#endif
+
+ ENDIF
+
+!
+!-- Write cpu-times
+ IF ( myid == 0 ) THEN
+!
+!-- Re-store sums
+ WHERE ( log_point_s%counts /= 0 )
+ sum = log_point_s%sum
+ ELSEWHERE
+ sum = -1.0
+ ENDWHERE
+
+!
+!-- Write cpu-times sorted by size
+ WRITE ( 18, 101 )
+ DO
+ ii = MAXLOC( sum )
+ i = ii(1)
+ IF ( sum(i) /= -1.0 ) THEN
+ WRITE ( 18, 102 ) &
+ log_point_s(i)%place, log_point_s(i)%sum, &
+ log_point_s(i)%sum / log_point(1)%sum * 100.0, &
+ log_point_s(i)%counts, pe_min(i), pe_max(i), pe_rms(i)
+ sum(i) = -1.0
+ ELSE
+ EXIT
+ ENDIF
+ ENDDO
+
+!
+!-- Empty lines in order to create a gap to the results of the model
+!-- continuation runs
+ WRITE ( 18, 103 )
+
+!
+!-- Unit 18 is not needed anymore
+ CALL close_file( 18 )
+
+ ENDIF
+
+
+100 FORMAT (A/11('-')//'CPU measures for ',I3,' PEs (',I3,' tasks *',I3, &
+ &' threads):'/ &
+ &'--------------------------------------------------'// &
+ &'place: mean counts min ', &
+ &' max rms'/ &
+ &' sec. % sec. ', &
+ &' sec. sec.'/ &
+ &'-----------------------------------------------------------', &
+ &'-------------------')
+
+101 FORMAT (/'special measures:'/ &
+ &'-----------------------------------------------------------', &
+ &'--------------------')
+
+102 FORMAT (A20,2X,F9.3,2X,F7.2,1X,I7,3(1X,F9.3))
+103 FORMAT (//)
+
+ END SUBROUTINE cpu_statistics
+
Index: /palm/tags/release-3.4a/SOURCE/data_log.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/data_log.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/data_log.f90 (revision 141)
@@ -0,0 +1,130 @@
+ SUBROUTINE data_log( array, i1, i2, j1, j2, k1, k2 )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.1 2006/02/23 10:09:29 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Complete logging of data
+!------------------------------------------------------------------------------!
+#if defined( __logging )
+
+ USE control_parameters
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: i1, i2, j1, j2, k1, k2
+
+ REAL, DIMENSION(i1:i2,j1:j2,k1:k2) :: array
+
+
+!
+!-- Open the file for data logging
+ CALL check_open( 20 )
+
+!
+!-- Write the message string
+ WRITE ( 20 ) log_message
+
+!
+!-- Write the simulated time and the array indices
+ WRITE ( 20 ) simulated_time, i1, i2, j1, j2, k1, k2
+
+!
+!-- Write the array
+ WRITE ( 20 ) array
+
+#endif
+ END SUBROUTINE data_log
+
+
+
+ SUBROUTINE data_log_2d( array, i1, i2, j1, j2)
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Same as above, for 2d arrays
+!------------------------------------------------------------------------------!
+#if defined( __logging )
+
+ USE control_parameters
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: i1, i2, j1, j2
+
+ REAL, DIMENSION(i1:i2,j1:j2) :: array
+
+
+!
+!-- Open the file for data logging
+ CALL check_open( 20 )
+
+!
+!-- Write the message string
+ WRITE ( 20 ) log_message
+
+!
+!-- Write the simulated time and the array indices
+ WRITE ( 20 ) simulated_time, i1, i2, j1, j2
+
+!
+!-- Write the array
+ WRITE ( 20 ) array
+
+#endif
+ END SUBROUTINE data_log_2d
+
+
+
+ SUBROUTINE data_log_2d_int( array, i1, i2, j1, j2)
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Same as above, for 2d integer arrays
+!------------------------------------------------------------------------------!
+#if defined( __logging )
+
+ USE control_parameters
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: i1, i2, j1, j2
+
+ INTEGER, DIMENSION(i1:i2,j1:j2) :: array
+
+
+!
+!-- Open the file for data logging
+ CALL check_open( 20 )
+
+!
+!-- Write the message string
+ WRITE ( 20 ) log_message
+
+!
+!-- Write the simulated time and the array indices
+ WRITE ( 20 ) simulated_time, i1, i2, j1, j2
+
+!
+!-- Write the array
+ WRITE ( 20 ) array
+
+#endif
+ END SUBROUTINE data_log_2d_int
Index: /palm/tags/release-3.4a/SOURCE/data_output_2d.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/data_output_2d.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/data_output_2d.f90 (revision 141)
@@ -0,0 +1,1190 @@
+ SUBROUTINE data_output_2d( mode, av )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 96 2007-06-04 08:07:41Z raasch
+! Output of density and salinity
+!
+! 75 2007-03-22 09:54:05Z raasch
+! Output of precipitation amount/rate and roughness length,
+! 2nd+3rd argument removed from exchange horiz
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.5 2006/08/22 13:50:29 raasch
+! xz and yz cross sections now up to nzt+1
+!
+! Revision 1.2 2006/02/23 10:19:22 raasch
+! Output of time-averaged data, output of averages along x, y, or z,
+! output of user-defined quantities,
+! section data are copied from local_pf to local_2d before they are output,
+! output of particle concentration and mean radius,
+! Former subroutine plot_2d renamed data_output_2d, pl2d.. renamed do2d..,
+! anz renamed ngp, ebene renamed section, pl2d_.._anz renamed do2d_.._n
+!
+! Revision 1.1 1997/08/11 06:24:09 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Data output of horizontal cross-sections in NetCDF format or binary format
+! compatible to old graphic software iso2d.
+! Attention: The position of the sectional planes is still not always computed
+! --------- correctly. (zu is used always)!
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE averaging
+ USE cloud_parameters
+ USE control_parameters
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE netcdf_control
+ USE particle_attributes
+ USE pegrid
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=2) :: do2d_mode, mode
+ CHARACTER (LEN=4) :: grid
+ CHARACTER (LEN=25) :: section_chr
+ CHARACTER (LEN=50) :: rtext
+ INTEGER :: av, ngp, file_id, i, if, is, j, k, l, layer_xy, n, psi, s, &
+ sender, &
+ ind(4)
+ LOGICAL :: found, resorted, two_d
+ REAL :: mean_r, s_r3, s_r4
+ REAL, DIMENSION(:), ALLOCATABLE :: level_z
+ REAL, DIMENSION(:,:), ALLOCATABLE :: local_2d, local_2d_l
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: local_pf
+#if defined( __parallel )
+ REAL, DIMENSION(:,:), ALLOCATABLE :: total_2d
+#endif
+ REAL, DIMENSION(:,:,:), POINTER :: to_be_resorted
+
+ NAMELIST /LOCAL/ rtext
+
+ CALL cpu_log (log_point(3),'data_output_2d','start')
+
+!
+!-- Immediate return, if no output is requested (no respective sections
+!-- found in parameter data_output)
+ IF ( mode == 'xy' .AND. .NOT. data_output_xy(av) ) RETURN
+ IF ( mode == 'xz' .AND. .NOT. data_output_xz(av) ) RETURN
+ IF ( mode == 'yz' .AND. .NOT. data_output_yz(av) ) RETURN
+
+ two_d = .FALSE. ! local variable to distinguish between output of pure 2D
+ ! arrays and cross-sections of 3D arrays.
+
+!
+!-- Depending on the orientation of the cross-section, the respective output
+!-- files have to be opened.
+ SELECT CASE ( mode )
+
+ CASE ( 'xy' )
+
+ s = 1
+ ALLOCATE( level_z(0:nzt+1), local_2d(nxl-1:nxr+1,nys-1:nyn+1) )
+
+#if defined( __netcdf )
+ IF ( myid == 0 .AND. netcdf_output ) CALL check_open( 101+av*10 )
+#endif
+
+ IF ( data_output_2d_on_each_pe ) THEN
+ CALL check_open( 21 )
+ ELSE
+ IF ( myid == 0 ) THEN
+ IF ( iso2d_output ) CALL check_open( 21 )
+#if defined( __parallel )
+ ALLOCATE( total_2d(-1:nx+1,-1:ny+1) )
+#endif
+ ENDIF
+ ENDIF
+
+ CASE ( 'xz' )
+
+ s = 2
+ ALLOCATE( local_2d(nxl-1:nxr+1,nzb:nzt+1) )
+
+#if defined( __netcdf )
+ IF ( myid == 0 .AND. netcdf_output ) CALL check_open( 102+av*10 )
+#endif
+
+ IF ( data_output_2d_on_each_pe ) THEN
+ CALL check_open( 22 )
+ ELSE
+ IF ( myid == 0 ) THEN
+ IF ( iso2d_output ) CALL check_open( 22 )
+#if defined( __parallel )
+ ALLOCATE( total_2d(-1:nx+1,nzb:nzt+1) )
+#endif
+ ENDIF
+ ENDIF
+
+ CASE ( 'yz' )
+
+ s = 3
+ ALLOCATE( local_2d(nys-1:nyn+1,nzb:nzt+1) )
+
+#if defined( __netcdf )
+ IF ( myid == 0 .AND. netcdf_output ) CALL check_open( 103+av*10 )
+#endif
+
+ IF ( data_output_2d_on_each_pe ) THEN
+ CALL check_open( 23 )
+ ELSE
+ IF ( myid == 0 ) THEN
+ IF ( iso2d_output ) CALL check_open( 23 )
+#if defined( __parallel )
+ ALLOCATE( total_2d(-1:ny+1,nzb:nzt+1) )
+#endif
+ ENDIF
+ ENDIF
+
+ CASE DEFAULT
+
+ PRINT*,'+++ data_output_2d: unknown cross-section: ',mode
+ CALL local_stop
+
+ END SELECT
+
+!
+!-- Allocate a temporary array for resorting (kji -> ijk).
+ ALLOCATE( local_pf(nxl-1:nxr+1,nys-1:nyn+1,nzb:nzt+1) )
+
+!
+!-- Loop of all variables to be written.
+!-- Output dimensions chosen
+ if = 1
+ l = MAX( 2, LEN_TRIM( do2d(av,if) ) )
+ do2d_mode = do2d(av,if)(l-1:l)
+
+ DO WHILE ( do2d(av,if)(1:1) /= ' ' )
+
+ IF ( do2d_mode == mode ) THEN
+!
+!-- Store the array chosen on the temporary array.
+ resorted = .FALSE.
+ SELECT CASE ( TRIM( do2d(av,if) ) )
+
+ CASE ( 'e_xy', 'e_xz', 'e_yz' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => e
+ ELSE
+ to_be_resorted => e_av
+ ENDIF
+ IF ( mode == 'xy' ) level_z = zu
+
+ CASE ( 'lwp*_xy' ) ! 2d-array
+ IF ( av == 0 ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ local_pf(i,j,nzb+1) = SUM( ql(nzb:nzt,j,i) * &
+ dzw(1:nzt+1) )
+ ENDDO
+ ENDDO
+ ELSE
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ local_pf(i,j,nzb+1) = lwp_av(j,i)
+ ENDDO
+ ENDDO
+ ENDIF
+ resorted = .TRUE.
+ two_d = .TRUE.
+ level_z(nzb+1) = zu(nzb+1)
+
+ CASE ( 'p_xy', 'p_xz', 'p_yz' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => p
+ ELSE
+ to_be_resorted => p_av
+ ENDIF
+ IF ( mode == 'xy' ) level_z = zu
+
+ CASE ( 'pc_xy', 'pc_xz', 'pc_yz' ) ! particle concentration
+ IF ( av == 0 ) THEN
+ tend = prt_count
+ CALL exchange_horiz( tend )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ local_pf(i,j,k) = tend(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ resorted = .TRUE.
+ ELSE
+ CALL exchange_horiz( pc_av )
+ to_be_resorted => pc_av
+ ENDIF
+
+ CASE ( 'pr_xy', 'pr_xz', 'pr_yz' ) ! mean particle radius
+ IF ( av == 0 ) THEN
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb, nzt+1
+ psi = prt_start_index(k,j,i)
+ s_r3 = 0.0
+ s_r4 = 0.0
+ DO n = psi, psi+prt_count(k,j,i)-1
+ s_r3 = s_r3 + particles(n)%radius**3
+ s_r4 = s_r4 + particles(n)%radius**4
+ ENDDO
+ IF ( s_r3 /= 0.0 ) THEN
+ mean_r = s_r4 / s_r3
+ ELSE
+ mean_r = 0.0
+ ENDIF
+ tend(k,j,i) = mean_r
+ ENDDO
+ ENDDO
+ ENDDO
+ CALL exchange_horiz( tend )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ local_pf(i,j,k) = tend(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ resorted = .TRUE.
+ ELSE
+ CALL exchange_horiz( pr_av )
+ to_be_resorted => pr_av
+ ENDIF
+
+ CASE ( 'pra*_xy' ) ! 2d-array / integral quantity => no av
+ CALL exchange_horiz_2d( precipitation_amount )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ local_pf(i,j,nzb+1) = precipitation_amount(j,i)
+ ENDDO
+ ENDDO
+ precipitation_amount = 0.0 ! reset for next integ. interval
+ resorted = .TRUE.
+ two_d = .TRUE.
+ level_z(nzb+1) = zu(nzb+1)
+
+ CASE ( 'prr*_xy' ) ! 2d-array
+ IF ( av == 0 ) THEN
+ CALL exchange_horiz_2d( precipitation_rate )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ local_pf(i,j,nzb+1) = precipitation_rate(j,i)
+ ENDDO
+ ENDDO
+ ELSE
+ CALL exchange_horiz_2d( precipitation_rate_av )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ local_pf(i,j,nzb+1) = precipitation_rate_av(j,i)
+ ENDDO
+ ENDDO
+ ENDIF
+ resorted = .TRUE.
+ two_d = .TRUE.
+ level_z(nzb+1) = zu(nzb+1)
+
+ CASE ( 'pt_xy', 'pt_xz', 'pt_yz' )
+ IF ( av == 0 ) THEN
+ IF ( .NOT. cloud_physics ) THEN
+ to_be_resorted => pt
+ ELSE
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ local_pf(i,j,k) = pt(k,j,i) + l_d_cp * &
+ pt_d_t(k) * &
+ ql(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ resorted = .TRUE.
+ ENDIF
+ ELSE
+ to_be_resorted => pt_av
+ ENDIF
+ IF ( mode == 'xy' ) level_z = zu
+
+ CASE ( 'q_xy', 'q_xz', 'q_yz' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => q
+ ELSE
+ to_be_resorted => q_av
+ ENDIF
+ IF ( mode == 'xy' ) level_z = zu
+
+ CASE ( 'ql_xy', 'ql_xz', 'ql_yz' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => ql
+ ELSE
+ to_be_resorted => ql_av
+ ENDIF
+ IF ( mode == 'xy' ) level_z = zu
+
+ CASE ( 'ql_c_xy', 'ql_c_xz', 'ql_c_yz' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => ql_c
+ ELSE
+ to_be_resorted => ql_c_av
+ ENDIF
+ IF ( mode == 'xy' ) level_z = zu
+
+ CASE ( 'ql_v_xy', 'ql_v_xz', 'ql_v_yz' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => ql_v
+ ELSE
+ to_be_resorted => ql_v_av
+ ENDIF
+ IF ( mode == 'xy' ) level_z = zu
+
+ CASE ( 'ql_vp_xy', 'ql_vp_xz', 'ql_vp_yz' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => ql_vp
+ ELSE
+ to_be_resorted => ql_vp_av
+ ENDIF
+ IF ( mode == 'xy' ) level_z = zu
+
+ CASE ( 'qv_xy', 'qv_xz', 'qv_yz' )
+ IF ( av == 0 ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ resorted = .TRUE.
+ ELSE
+ to_be_resorted => qv_av
+ ENDIF
+ IF ( mode == 'xy' ) level_z = zu
+
+ CASE ( 'rho_xy', 'rho_xz', 'rho_yz' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => rho
+ ELSE
+ to_be_resorted => rho_av
+ ENDIF
+
+ CASE ( 's_xy', 's_xz', 's_yz' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => q
+ ELSE
+ to_be_resorted => q_av
+ ENDIF
+
+ CASE ( 'sa_xy', 'sa_xz', 'sa_yz' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => sa
+ ELSE
+ to_be_resorted => sa_av
+ ENDIF
+
+ CASE ( 't*_xy' ) ! 2d-array
+ IF ( av == 0 ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ local_pf(i,j,nzb+1) = ts(j,i)
+ ENDDO
+ ENDDO
+ ELSE
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ local_pf(i,j,nzb+1) = ts_av(j,i)
+ ENDDO
+ ENDDO
+ ENDIF
+ resorted = .TRUE.
+ two_d = .TRUE.
+ level_z(nzb+1) = zu(nzb+1)
+
+ CASE ( 'u_xy', 'u_xz', 'u_yz' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => u
+ ELSE
+ to_be_resorted => u_av
+ ENDIF
+ IF ( mode == 'xy' ) level_z = zu
+!
+!-- Substitute the values generated by "mirror" boundary condition
+!-- at the bottom boundary by the real surface values.
+ IF ( do2d(av,if) == 'u_xz' .OR. do2d(av,if) == 'u_yz' ) THEN
+ IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0
+ ENDIF
+
+ CASE ( 'u*_xy' ) ! 2d-array
+ IF ( av == 0 ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ local_pf(i,j,nzb+1) = us(j,i)
+ ENDDO
+ ENDDO
+ ELSE
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ local_pf(i,j,nzb+1) = us_av(j,i)
+ ENDDO
+ ENDDO
+ ENDIF
+ resorted = .TRUE.
+ two_d = .TRUE.
+ level_z(nzb+1) = zu(nzb+1)
+
+ CASE ( 'v_xy', 'v_xz', 'v_yz' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => v
+ ELSE
+ to_be_resorted => v_av
+ ENDIF
+ IF ( mode == 'xy' ) level_z = zu
+!
+!-- Substitute the values generated by "mirror" boundary condition
+!-- at the bottom boundary by the real surface values.
+ IF ( do2d(av,if) == 'v_xz' .OR. do2d(av,if) == 'v_yz' ) THEN
+ IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0
+ ENDIF
+
+ CASE ( 'vpt_xy', 'vpt_xz', 'vpt_yz' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => vpt
+ ELSE
+ to_be_resorted => vpt_av
+ ENDIF
+ IF ( mode == 'xy' ) level_z = zu
+
+ CASE ( 'w_xy', 'w_xz', 'w_yz' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => w
+ ELSE
+ to_be_resorted => w_av
+ ENDIF
+ IF ( mode == 'xy' ) level_z = zw
+
+ CASE ( 'z0*_xy' ) ! 2d-array
+ IF ( av == 0 ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ local_pf(i,j,nzb+1) = z0(j,i)
+ ENDDO
+ ENDDO
+ ELSE
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ local_pf(i,j,nzb+1) = z0_av(j,i)
+ ENDDO
+ ENDDO
+ ENDIF
+ resorted = .TRUE.
+ two_d = .TRUE.
+ level_z(nzb+1) = zu(nzb+1)
+
+ CASE DEFAULT
+!
+!-- User defined quantity
+ CALL user_data_output_2d( av, do2d(av,if), found, grid, &
+ local_pf )
+ resorted = .TRUE.
+
+ IF ( grid == 'zu' ) THEN
+ IF ( mode == 'xy' ) level_z = zu
+ ELSEIF ( grid == 'zw' ) THEN
+ IF ( mode == 'xy' ) level_z = zw
+ ENDIF
+
+ IF ( .NOT. found ) THEN
+ PRINT*, '+++ data_output_2d: no output provided for: ', &
+ do2d(av,if)
+ ENDIF
+
+ END SELECT
+
+!
+!-- Resort the array to be output, if not done above
+ IF ( .NOT. resorted ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ local_pf(i,j,k) = to_be_resorted(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Output of the individual cross-sections, depending on the cross-
+!-- section mode chosen.
+ is = 1
+ loop1: DO WHILE ( section(is,s) /= -9999 .OR. two_d )
+
+ SELECT CASE ( mode )
+
+ CASE ( 'xy' )
+!
+!-- Determine the cross section index
+ IF ( two_d ) THEN
+ layer_xy = nzb+1
+ ELSE
+ layer_xy = section(is,s)
+ ENDIF
+
+!
+!-- Update the NetCDF xy cross section time axis
+ IF ( myid == 0 ) THEN
+ IF ( simulated_time /= do2d_xy_last_time(av) ) THEN
+ do2d_xy_time_count(av) = do2d_xy_time_count(av) + 1
+ do2d_xy_last_time(av) = simulated_time
+ IF ( .NOT. data_output_2d_on_each_pe .AND. &
+ netcdf_output ) THEN
+#if defined( __netcdf )
+ nc_stat = NF90_PUT_VAR( id_set_xy(av), &
+ id_var_time_xy(av), &
+ (/ simulated_time /), &
+ start = (/ do2d_xy_time_count(av) /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) THEN
+ CALL handle_netcdf_error( 53 )
+ ENDIF
+#endif
+ ENDIF
+ ENDIF
+ ENDIF
+!
+!-- If required, carry out averaging along z
+ IF ( section(is,s) == -1 ) THEN
+
+ local_2d = 0.0
+!
+!-- Carry out the averaging (all data are on the PE)
+ DO k = nzb, nzt+1
+ DO j = nys-1, nyn+1
+ DO i = nxl-1, nxr+1
+ local_2d(i,j) = local_2d(i,j) + local_pf(i,j,k)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ local_2d = local_2d / ( nzt -nzb + 2.0 )
+
+ ELSE
+!
+!-- Just store the respective section on the local array
+ local_2d = local_pf(:,:,layer_xy)
+
+ ENDIF
+
+#if defined( __parallel )
+ IF ( data_output_2d_on_each_pe ) THEN
+!
+!-- Output of partial arrays on each PE
+#if defined( __netcdf )
+ IF ( netcdf_output .AND. myid == 0 ) THEN
+ WRITE ( 21 ) simulated_time, do2d_xy_time_count(av), &
+ av
+ ENDIF
+#endif
+ WRITE ( 21 ) nxl-1, nxr+1, nys-1, nyn+1
+ WRITE ( 21 ) local_2d
+
+ ELSE
+!
+!-- PE0 receives partial arrays from all processors and then
+!-- outputs them. Here a barrier has to be set, because
+!-- otherwise "-MPI- FATAL: Remote protocol queue full" may
+!-- occur.
+ CALL MPI_BARRIER( comm2d, ierr )
+
+ ngp = ( nxr-nxl+3 ) * ( nyn-nys+3 )
+ IF ( myid == 0 ) THEN
+!
+!-- Local array can be relocated directly.
+ total_2d(nxl-1:nxr+1,nys-1:nyn+1) = local_2d
+!
+!-- Receive data from all other PEs.
+ DO n = 1, numprocs-1
+!
+!-- Receive index limits first, then array.
+!-- Index limits are received in arbitrary order from
+!-- the PEs.
+ CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
+ MPI_ANY_SOURCE, 0, comm2d, status, &
+ ierr )
+ sender = status(MPI_SOURCE)
+ DEALLOCATE( local_2d )
+ ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
+ CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
+ MPI_REAL, sender, 1, comm2d, &
+ status, ierr )
+ total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
+ ENDDO
+!
+!-- Output of the total cross-section.
+ IF ( iso2d_output ) WRITE (21) total_2d(0:nx+1,0:ny+1)
+!
+!-- Relocate the local array for the next loop increment
+ DEALLOCATE( local_2d )
+ ALLOCATE( local_2d(nxl-1:nxr+1,nys-1:nyn+1) )
+
+#if defined( __netcdf )
+ IF ( netcdf_output ) THEN
+ IF ( two_d ) THEN
+ nc_stat = NF90_PUT_VAR( id_set_xy(av), &
+ id_var_do2d(av,if), &
+ total_2d(0:nx+1,0:ny+1), &
+ start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
+ count = (/ nx+2, ny+2, 1, 1 /) )
+ ELSE
+ nc_stat = NF90_PUT_VAR( id_set_xy(av), &
+ id_var_do2d(av,if), &
+ total_2d(0:nx+1,0:ny+1), &
+ start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
+ count = (/ nx+2, ny+2, 1, 1 /) )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) &
+ CALL handle_netcdf_error( 54 )
+ ENDIF
+#endif
+
+ ELSE
+!
+!-- First send the local index limits to PE0
+ ind(1) = nxl-1; ind(2) = nxr+1
+ ind(3) = nys-1; ind(4) = nyn+1
+ CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, &
+ ierr )
+!
+!-- Send data to PE0
+ CALL MPI_SEND( local_2d(nxl-1,nys-1), ngp, MPI_REAL, &
+ 0, 1, comm2d, ierr )
+ ENDIF
+!
+!-- A barrier has to be set, because otherwise some PEs may
+!-- proceed too fast so that PE0 may receive wrong data on
+!-- tag 0
+ CALL MPI_BARRIER( comm2d, ierr )
+ ENDIF
+#else
+ IF ( iso2d_output ) THEN
+ WRITE (21) local_2d(nxl:nxr+1,nys:nyn+1)
+ ENDIF
+#if defined( __netcdf )
+ IF ( netcdf_output ) THEN
+ IF ( two_d ) THEN
+ nc_stat = NF90_PUT_VAR( id_set_xy(av), &
+ id_var_do2d(av,if), &
+ local_2d(nxl:nxr+1,nys:nyn+1), &
+ start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
+ count = (/ nx+2, ny+2, 1, 1 /) )
+ ELSE
+ nc_stat = NF90_PUT_VAR( id_set_xy(av), &
+ id_var_do2d(av,if), &
+ local_2d(nxl:nxr+1,nys:nyn+1), &
+ start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
+ count = (/ nx+2, ny+2, 1, 1 /) )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) &
+ CALL handle_netcdf_error( 55 )
+ ENDIF
+#endif
+#endif
+ do2d_xy_n = do2d_xy_n + 1
+!
+!-- Write LOCAL parameter set for ISO2D.
+ IF ( myid == 0 .AND. iso2d_output ) THEN
+ IF ( section(is,s) /= -1 ) THEN
+ WRITE ( section_chr, '(''z = '',F7.2,'' m (GP '',I3, &
+ &'')'')' &
+ ) level_z(layer_xy), layer_xy
+ ELSE
+ section_chr = 'averaged along z'
+ ENDIF
+ IF ( av == 0 ) THEN
+ rtext = TRIM( do2d(av,if) ) // ' t = ' // &
+ TRIM( simulated_time_chr ) // ' ' // &
+ TRIM( section_chr )
+ ELSE
+ rtext = TRIM( do2d(av,if) ) // ' averaged t = ' // &
+ TRIM( simulated_time_chr ) // ' ' // &
+ TRIM( section_chr )
+ ENDIF
+ WRITE (27,LOCAL)
+ ENDIF
+!
+!-- For 2D-arrays (e.g. u*) only one cross-section is available.
+!-- Hence exit loop of output levels.
+ IF ( two_d ) THEN
+ two_d = .FALSE.
+ EXIT loop1
+ ENDIF
+
+ CASE ( 'xz' )
+!
+!-- Update the NetCDF xz cross section time axis
+ IF ( myid == 0 ) THEN
+ IF ( simulated_time /= do2d_xz_last_time(av) ) THEN
+ do2d_xz_time_count(av) = do2d_xz_time_count(av) + 1
+ do2d_xz_last_time(av) = simulated_time
+ IF ( .NOT. data_output_2d_on_each_pe .AND. &
+ netcdf_output ) THEN
+#if defined( __netcdf )
+ nc_stat = NF90_PUT_VAR( id_set_xz(av), &
+ id_var_time_xz(av), &
+ (/ simulated_time /), &
+ start = (/ do2d_xz_time_count(av) /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) THEN
+ CALL handle_netcdf_error( 56 )
+ ENDIF
+#endif
+ ENDIF
+ ENDIF
+ ENDIF
+!
+!-- If required, carry out averaging along y
+ IF ( section(is,s) == -1 ) THEN
+
+ ALLOCATE( local_2d_l(nxl-1:nxr+1,nzb:nzt+1) )
+ local_2d_l = 0.0
+ ngp = ( nxr-nxl+3 ) * ( nzt-nzb+2 )
+!
+!-- First local averaging on the PE
+ DO k = nzb, nzt+1
+ DO j = nys, nyn
+ DO i = nxl-1, nxr+1
+ local_2d_l(i,k) = local_2d_l(i,k) + &
+ local_pf(i,j,k)
+ ENDDO
+ ENDDO
+ ENDDO
+#if defined( __parallel )
+!
+!-- Now do the averaging over all PEs along y
+ CALL MPI_ALLREDUCE( local_2d_l(nxl-1,nzb), &
+ local_2d(nxl-1,nzb), ngp, MPI_REAL, &
+ MPI_SUM, comm1dy, ierr )
+#else
+ local_2d = local_2d_l
+#endif
+ local_2d = local_2d / ( ny + 1.0 )
+
+ DEALLOCATE( local_2d_l )
+
+ ELSE
+!
+!-- Just store the respective section on the local array
+!-- (but only if it is available on this PE!)
+ IF ( section(is,s) >= nys .AND. section(is,s) <= nyn ) &
+ THEN
+ local_2d = local_pf(:,section(is,s),nzb:nzt+1)
+ ENDIF
+
+ ENDIF
+
+#if defined( __parallel )
+ IF ( data_output_2d_on_each_pe ) THEN
+!
+!-- Output of partial arrays on each PE. If the cross section
+!-- does not reside on the PE, output special index values.
+#if defined( __netcdf )
+ IF ( netcdf_output .AND. myid == 0 ) THEN
+ WRITE ( 22 ) simulated_time, do2d_xz_time_count(av), &
+ av
+ ENDIF
+#endif
+ IF ( ( section(is,s)>=nys .AND. section(is,s)<=nyn ) .OR.&
+ ( section(is,s) == -1 .AND. nys-1 == -1 ) ) &
+ THEN
+ WRITE (22) nxl-1, nxr+1, nzb, nzt+1
+ WRITE (22) local_2d
+ ELSE
+ WRITE (22) -1, -1, -1, -1
+ ENDIF
+
+ ELSE
+!
+!-- PE0 receives partial arrays from all processors of the
+!-- respective cross section and outputs them. Here a
+!-- barrier has to be set, because otherwise
+!-- "-MPI- FATAL: Remote protocol queue full" may occur.
+ CALL MPI_BARRIER( comm2d, ierr )
+
+ ngp = ( nxr-nxl+3 ) * ( nzt-nzb+2 )
+ IF ( myid == 0 ) THEN
+!
+!-- Local array can be relocated directly.
+ IF ( ( section(is,s)>=nys .AND. section(is,s)<=nyn ) &
+ .OR. ( section(is,s) == -1 .AND. nys-1 == -1 ) ) &
+ THEN
+ total_2d(nxl-1:nxr+1,nzb:nzt+1) = local_2d
+ ENDIF
+!
+!-- Receive data from all other PEs.
+ DO n = 1, numprocs-1
+!
+!-- Receive index limits first, then array.
+!-- Index limits are received in arbitrary order from
+!-- the PEs.
+ CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
+ MPI_ANY_SOURCE, 0, comm2d, status, &
+ ierr )
+!
+!-- Not all PEs have data for XZ-cross-section.
+ IF ( ind(1) /= -9999 ) THEN
+ sender = status(MPI_SOURCE)
+ DEALLOCATE( local_2d )
+ ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
+ CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
+ MPI_REAL, sender, 1, comm2d, &
+ status, ierr )
+ total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
+ ENDIF
+ ENDDO
+!
+!-- Output of the total cross-section.
+ IF ( iso2d_output ) THEN
+ WRITE (22) total_2d(0:nx+1,nzb:nzt+1)
+ ENDIF
+!
+!-- Relocate the local array for the next loop increment
+ DEALLOCATE( local_2d )
+ ALLOCATE( local_2d(nxl-1:nxr+1,nzb:nzt+1) )
+
+#if defined( __netcdf )
+ IF ( netcdf_output ) THEN
+ nc_stat = NF90_PUT_VAR( id_set_xz(av), &
+ id_var_do2d(av,if), &
+ total_2d(0:nx+1,nzb:nzt+1),&
+ start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
+ count = (/ nx+2, 1, nz+2, 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) &
+ CALL handle_netcdf_error( 57 )
+ ENDIF
+#endif
+
+ ELSE
+!
+!-- If the cross section resides on the PE, send the
+!-- local index limits, otherwise send -9999 to PE0.
+ IF ( ( section(is,s)>=nys .AND. section(is,s)<=nyn ) &
+ .OR. ( section(is,s) == -1 .AND. nys-1 == -1 ) ) &
+ THEN
+ ind(1) = nxl-1; ind(2) = nxr+1
+ ind(3) = nzb; ind(4) = nzt+1
+ ELSE
+ ind(1) = -9999; ind(2) = -9999
+ ind(3) = -9999; ind(4) = -9999
+ ENDIF
+ CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, &
+ ierr )
+!
+!-- If applicable, send data to PE0.
+ IF ( ind(1) /= -9999 ) THEN
+ CALL MPI_SEND( local_2d(nxl-1,nzb), ngp, MPI_REAL, &
+ 0, 1, comm2d, ierr )
+ ENDIF
+ ENDIF
+!
+!-- A barrier has to be set, because otherwise some PEs may
+!-- proceed too fast so that PE0 may receive wrong data on
+!-- tag 0
+ CALL MPI_BARRIER( comm2d, ierr )
+ ENDIF
+#else
+ IF ( iso2d_output ) THEN
+ WRITE (22) local_2d(nxl:nxr+1,nzb:nzt+1)
+ ENDIF
+#if defined( __netcdf )
+ IF ( netcdf_output ) THEN
+ nc_stat = NF90_PUT_VAR( id_set_xz(av), &
+ id_var_do2d(av,if), &
+ local_2d(nxl:nxr+1,nzb:nzt+1), &
+ start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
+ count = (/ nx+2, 1, nz+2, 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) &
+ CALL handle_netcdf_error( 58 )
+ ENDIF
+#endif
+#endif
+ do2d_xz_n = do2d_xz_n + 1
+!
+!-- Write LOCAL-parameter set for ISO2D.
+ IF ( myid == 0 .AND. iso2d_output ) THEN
+ IF ( section(is,s) /= -1 ) THEN
+ WRITE ( section_chr, '(''y = '',F8.2,'' m (GP '',I3, &
+ &'')'')' &
+ ) section(is,s)*dy, section(is,s)
+ ELSE
+ section_chr = 'averaged along y'
+ ENDIF
+ IF ( av == 0 ) THEN
+ rtext = TRIM( do2d(av,if) ) // ' t = ' // &
+ TRIM( simulated_time_chr ) // ' ' // &
+ TRIM( section_chr )
+ ELSE
+ rtext = TRIM( do2d(av,if) ) // ' averaged t = ' // &
+ TRIM( simulated_time_chr ) // ' ' // &
+ TRIM( section_chr )
+ ENDIF
+ WRITE (28,LOCAL)
+ ENDIF
+
+ CASE ( 'yz' )
+!
+!-- Update the NetCDF xy cross section time axis
+ IF ( myid == 0 ) THEN
+ IF ( simulated_time /= do2d_yz_last_time(av) ) THEN
+ do2d_yz_time_count(av) = do2d_yz_time_count(av) + 1
+ do2d_yz_last_time(av) = simulated_time
+ IF ( .NOT. data_output_2d_on_each_pe .AND. &
+ netcdf_output ) THEN
+#if defined( __netcdf )
+ nc_stat = NF90_PUT_VAR( id_set_yz(av), &
+ id_var_time_yz(av), &
+ (/ simulated_time /), &
+ start = (/ do2d_yz_time_count(av) /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) THEN
+ CALL handle_netcdf_error( 59 )
+ ENDIF
+#endif
+ ENDIF
+ ENDIF
+ ENDIF
+!
+!-- If required, carry out averaging along x
+ IF ( section(is,s) == -1 ) THEN
+
+ ALLOCATE( local_2d_l(nys-1:nyn+1,nzb:nzt+1) )
+ local_2d_l = 0.0
+ ngp = ( nyn-nys+3 ) * ( nzt-nzb+2 )
+!
+!-- First local averaging on the PE
+ DO k = nzb, nzt+1
+ DO j = nys-1, nyn+1
+ DO i = nxl, nxr
+ local_2d_l(j,k) = local_2d_l(j,k) + &
+ local_pf(i,j,k)
+ ENDDO
+ ENDDO
+ ENDDO
+#if defined( __parallel )
+!
+!-- Now do the averaging over all PEs along x
+ CALL MPI_ALLREDUCE( local_2d_l(nys-1,nzb), &
+ local_2d(nys-1,nzb), ngp, MPI_REAL, &
+ MPI_SUM, comm1dx, ierr )
+#else
+ local_2d = local_2d_l
+#endif
+ local_2d = local_2d / ( nx + 1.0 )
+
+ DEALLOCATE( local_2d_l )
+
+ ELSE
+!
+!-- Just store the respective section on the local array
+!-- (but only if it is available on this PE!)
+ IF ( section(is,s) >= nxl .AND. section(is,s) <= nxr ) &
+ THEN
+ local_2d = local_pf(section(is,s),:,nzb:nzt+1)
+ ENDIF
+
+ ENDIF
+
+#if defined( __parallel )
+ IF ( data_output_2d_on_each_pe ) THEN
+!
+!-- Output of partial arrays on each PE. If the cross section
+!-- does not reside on the PE, output special index values.
+#if defined( __netcdf )
+ IF ( netcdf_output .AND. myid == 0 ) THEN
+ WRITE ( 23 ) simulated_time, do2d_yz_time_count(av), &
+ av
+ ENDIF
+#endif
+ IF ( ( section(is,s)>=nxl .AND. section(is,s)<=nxr ) .OR.&
+ ( section(is,s) == -1 .AND. nxl-1 == -1 ) ) &
+ THEN
+ WRITE (23) nys-1, nyn+1, nzb, nzt+1
+ WRITE (23) local_2d
+ ELSE
+ WRITE (23) -1, -1, -1, -1
+ ENDIF
+
+ ELSE
+!
+!-- PE0 receives partial arrays from all processors of the
+!-- respective cross section and outputs them. Here a
+!-- barrier has to be set, because otherwise
+!-- "-MPI- FATAL: Remote protocol queue full" may occur.
+ CALL MPI_BARRIER( comm2d, ierr )
+
+ ngp = ( nyn-nys+3 ) * ( nzt-nzb+2 )
+ IF ( myid == 0 ) THEN
+!
+!-- Local array can be relocated directly.
+ IF ( ( section(is,s)>=nxl .AND. section(is,s)<=nxr ) &
+ .OR. ( section(is,s) == -1 .AND. nxl-1 == -1 ) ) &
+ THEN
+ total_2d(nys-1:nyn+1,nzb:nzt+1) = local_2d
+ ENDIF
+!
+!-- Receive data from all other PEs.
+ DO n = 1, numprocs-1
+!
+!-- Receive index limits first, then array.
+!-- Index limits are received in arbitrary order from
+!-- the PEs.
+ CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
+ MPI_ANY_SOURCE, 0, comm2d, status, &
+ ierr )
+!
+!-- Not all PEs have data for YZ-cross-section.
+ IF ( ind(1) /= -9999 ) THEN
+ sender = status(MPI_SOURCE)
+ DEALLOCATE( local_2d )
+ ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
+ CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
+ MPI_REAL, sender, 1, comm2d, &
+ status, ierr )
+ total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
+ ENDIF
+ ENDDO
+!
+!-- Output of the total cross-section.
+ IF ( iso2d_output ) THEN
+ WRITE (23) total_2d(0:ny+1,nzb:nzt+1)
+ ENDIF
+!
+!-- Relocate the local array for the next loop increment
+ DEALLOCATE( local_2d )
+ ALLOCATE( local_2d(nys-1:nyn+1,nzb:nzt+1) )
+
+#if defined( __netcdf )
+ IF ( netcdf_output ) THEN
+ nc_stat = NF90_PUT_VAR( id_set_yz(av), &
+ id_var_do2d(av,if), &
+ total_2d(0:ny+1,nzb:nzt+1),&
+ start = (/ is, 1, 1, do2d_yz_time_count(av) /), &
+ count = (/ 1, ny+2, nz+2, 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) &
+ CALL handle_netcdf_error( 60 )
+ ENDIF
+#endif
+
+ ELSE
+!
+!-- If the cross section resides on the PE, send the
+!-- local index limits, otherwise send -9999 to PE0.
+ IF ( ( section(is,s)>=nxl .AND. section(is,s)<=nxr ) &
+ .OR. ( section(is,s) == -1 .AND. nxl-1 == -1 ) ) &
+ THEN
+ ind(1) = nys-1; ind(2) = nyn+1
+ ind(3) = nzb; ind(4) = nzt+1
+ ELSE
+ ind(1) = -9999; ind(2) = -9999
+ ind(3) = -9999; ind(4) = -9999
+ ENDIF
+ CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, &
+ ierr )
+!
+!-- If applicable, send data to PE0.
+ IF ( ind(1) /= -9999 ) THEN
+ CALL MPI_SEND( local_2d(nys-1,nzb), ngp, MPI_REAL, &
+ 0, 1, comm2d, ierr )
+ ENDIF
+ ENDIF
+!
+!-- A barrier has to be set, because otherwise some PEs may
+!-- proceed too fast so that PE0 may receive wrong data on
+!-- tag 0
+ CALL MPI_BARRIER( comm2d, ierr )
+ ENDIF
+#else
+ IF ( iso2d_output ) THEN
+ WRITE (23) local_2d(nys:nyn+1,nzb:nzt+1)
+ ENDIF
+#if defined( __netcdf )
+ IF ( netcdf_output ) THEN
+ nc_stat = NF90_PUT_VAR( id_set_yz(av), &
+ id_var_do2d(av,if), &
+ local_2d(nys:nyn+1,nzb:nzt+1), &
+ start = (/ is, 1, 1, do2d_xz_time_count(av) /), &
+ count = (/ 1, ny+2, nz+2, 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) &
+ CALL handle_netcdf_error( 61 )
+ ENDIF
+#endif
+#endif
+ do2d_yz_n = do2d_yz_n + 1
+!
+!-- Write LOCAL-parameter set for ISO2D.
+ IF ( myid == 0 .AND. iso2d_output ) THEN
+ IF ( section(is,s) /= -1 ) THEN
+ WRITE ( section_chr, '(''x = '',F8.2,'' m (GP '',I3, &
+ &'')'')' &
+ ) section(is,s)*dx, section(is,s)
+ ELSE
+ section_chr = 'averaged along x'
+ ENDIF
+ IF ( av == 0 ) THEN
+ rtext = TRIM( do2d(av,if) ) // ' t = ' // &
+ TRIM( simulated_time_chr ) // ' ' // &
+ TRIM( section_chr )
+ ELSE
+ rtext = TRIM( do2d(av,if) ) // ' averaged t = ' // &
+ TRIM( simulated_time_chr ) // ' ' // &
+ TRIM( section_chr )
+ ENDIF
+ WRITE (29,LOCAL)
+ ENDIF
+
+ END SELECT
+
+ is = is + 1
+ ENDDO loop1
+
+ ENDIF
+
+ if = if + 1
+ l = MAX( 2, LEN_TRIM( do2d(av,if) ) )
+ do2d_mode = do2d(av,if)(l-1:l)
+
+ ENDDO
+
+!
+!-- Deallocate temporary arrays.
+ IF ( ALLOCATED( level_z ) ) DEALLOCATE( level_z )
+ DEALLOCATE( local_pf, local_2d )
+#if defined( __parallel )
+ IF ( .NOT. data_output_2d_on_each_pe .AND. myid == 0 ) THEN
+ DEALLOCATE( total_2d )
+ ENDIF
+#endif
+
+!
+!-- Close plot output file.
+ file_id = 20 + s
+
+ IF ( data_output_2d_on_each_pe ) THEN
+ CALL close_file( file_id )
+ ELSE
+ IF ( myid == 0 ) CALL close_file( file_id )
+ ENDIF
+
+
+ CALL cpu_log (log_point(3),'data_output_2d','stop','nobarrier')
+
+ END SUBROUTINE data_output_2d
Index: /palm/tags/release-3.4a/SOURCE/data_output_3d.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/data_output_3d.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/data_output_3d.f90 (revision 141)
@@ -0,0 +1,408 @@
+ SUBROUTINE data_output_3d( av )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 96 2007-06-04 08:07:41Z raasch
+! Output of density and salinity
+!
+! 75 2007-03-22 09:54:05Z raasch
+! 2nd+3rd argument removed from exchange horiz
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.3 2006/06/02 15:18:59 raasch
+! +argument "found", -argument grid in call of routine user_data_output_3d
+!
+! Revision 1.2 2006/02/23 10:23:07 raasch
+! Former subroutine plot_3d renamed data_output_3d, pl.. renamed do..,
+! .._anz renamed .._n,
+! output extended to (almost) all quantities, output of user-defined quantities
+!
+! Revision 1.1 1997/09/03 06:29:36 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Output of the 3D-arrays in NetCDF and/or AVS format.
+!------------------------------------------------------------------------------!
+
+ USE array_kind
+ USE arrays_3d
+ USE averaging
+ USE cloud_parameters
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE netcdf_control
+ USE particle_attributes
+ USE pegrid
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=9) :: simulated_time_mod
+
+ INTEGER :: av, i, if, j, k, n, pos, prec, psi
+
+ LOGICAL :: found, resorted
+
+ REAL :: mean_r, s_r3, s_r4
+
+ REAL(spk), DIMENSION(:,:,:), ALLOCATABLE :: local_pf
+
+ REAL, DIMENSION(:,:,:), POINTER :: to_be_resorted
+
+!
+!-- Return, if nothing to output
+ IF ( do3d_no(av) == 0 ) RETURN
+
+ CALL cpu_log (log_point(14),'data_output_3d','start')
+
+!
+!-- Open output file.
+!-- Also creates coordinate and fld-file for AVS.
+!-- In case of a run on more than one PE, each PE opens its own file and
+!-- writes the data of its subdomain in binary format (regardless of the format
+!-- the user has requested). After the run, these files are combined to one
+!-- file by combine_plot_fields in the format requested by the user (netcdf
+!-- and/or avs).
+ IF ( avs_output .OR. ( numprocs > 1 ) ) CALL check_open( 30 )
+
+#if defined( __netcdf )
+ IF ( myid == 0 .AND. netcdf_output ) CALL check_open( 106+av*10 )
+#endif
+
+!
+!-- Allocate a temporary array with the desired output dimensions.
+ ALLOCATE( local_pf(nxl-1:nxr+1,nys-1:nyn+1,nzb:nz_do3d) )
+
+!
+!-- Update the NetCDF time axis
+#if defined( __netcdf )
+ do3d_time_count(av) = do3d_time_count(av) + 1
+ IF ( myid == 0 .AND. netcdf_output ) THEN
+ nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_time_3d(av), &
+ (/ simulated_time /), &
+ start = (/ do3d_time_count(av) /), &
+ count = (/ 1 /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 1009 )
+ ENDIF
+#endif
+
+!
+!-- Loop over all variables to be written.
+ if = 1
+
+ DO WHILE ( do3d(av,if)(1:1) /= ' ' )
+!
+!-- Set the precision for data compression.
+ IF ( do3d_compress ) THEN
+ DO i = 1, 100
+ IF ( plot_3d_precision(i)%variable == do3d(av,if) ) THEN
+ prec = plot_3d_precision(i)%precision
+ EXIT
+ ENDIF
+ ENDDO
+ ENDIF
+
+!
+!-- Store the array chosen on the temporary array.
+ resorted = .FALSE.
+ SELECT CASE ( TRIM( do3d(av,if) ) )
+
+ CASE ( 'e' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => e
+ ELSE
+ to_be_resorted => e_av
+ ENDIF
+
+ CASE ( 'p' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => p
+ ELSE
+ to_be_resorted => p_av
+ ENDIF
+
+ CASE ( 'pc' ) ! particle concentration (requires ghostpoint exchange)
+ IF ( av == 0 ) THEN
+ tend = prt_count
+ CALL exchange_horiz( tend )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nz_do3d
+ local_pf(i,j,k) = tend(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ resorted = .TRUE.
+ ELSE
+ CALL exchange_horiz( pc_av )
+ to_be_resorted => pc_av
+ ENDIF
+
+ CASE ( 'pr' ) ! mean particle radius
+ IF ( av == 0 ) THEN
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb, nzt+1
+ psi = prt_start_index(k,j,i)
+ s_r3 = 0.0
+ s_r4 = 0.0
+ DO n = psi, psi+prt_count(k,j,i)-1
+ s_r3 = s_r3 + particles(n)%radius**3
+ s_r4 = s_r4 + particles(n)%radius**4
+ ENDDO
+ IF ( s_r3 /= 0.0 ) THEN
+ mean_r = s_r4 / s_r3
+ ELSE
+ mean_r = 0.0
+ ENDIF
+ tend(k,j,i) = mean_r
+ ENDDO
+ ENDDO
+ ENDDO
+ CALL exchange_horiz( tend )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ local_pf(i,j,k) = tend(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ resorted = .TRUE.
+ ELSE
+ CALL exchange_horiz( pr_av )
+ to_be_resorted => pr_av
+ ENDIF
+
+ CASE ( 'pt' )
+ IF ( av == 0 ) THEN
+ IF ( .NOT. cloud_physics ) THEN
+ to_be_resorted => pt
+ ELSE
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nz_do3d
+ local_pf(i,j,k) = pt(k,j,i) + l_d_cp * &
+ pt_d_t(k) * &
+ ql(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ resorted = .TRUE.
+ ENDIF
+ ELSE
+ to_be_resorted => pt_av
+ ENDIF
+
+ CASE ( 'q' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => q
+ ELSE
+ to_be_resorted => q_av
+ ENDIF
+
+ CASE ( 'ql' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => ql
+ ELSE
+ to_be_resorted => ql_av
+ ENDIF
+
+ CASE ( 'ql_c' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => ql_c
+ ELSE
+ to_be_resorted => ql_c_av
+ ENDIF
+
+ CASE ( 'ql_v' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => ql_v
+ ELSE
+ to_be_resorted => ql_v_av
+ ENDIF
+
+ CASE ( 'ql_vp' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => ql_vp
+ ELSE
+ to_be_resorted => ql_vp_av
+ ENDIF
+
+ CASE ( 'qv' )
+ IF ( av == 0 ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nz_do3d
+ local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ resorted = .TRUE.
+ ELSE
+ to_be_resorted => qv_av
+ ENDIF
+
+ CASE ( 'rho' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => rho
+ ELSE
+ to_be_resorted => rho_av
+ ENDIF
+
+ CASE ( 's' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => q
+ ELSE
+ to_be_resorted => q_av
+ ENDIF
+
+ CASE ( 'sa' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => sa
+ ELSE
+ to_be_resorted => sa_av
+ ENDIF
+
+ CASE ( 'u' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => u
+ ELSE
+ to_be_resorted => u_av
+ ENDIF
+
+ CASE ( 'v' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => v
+ ELSE
+ to_be_resorted => v_av
+ ENDIF
+
+ CASE ( 'vpt' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => vpt
+ ELSE
+ to_be_resorted => vpt_av
+ ENDIF
+
+ CASE ( 'w' )
+ IF ( av == 0 ) THEN
+ to_be_resorted => w
+ ELSE
+ to_be_resorted => w_av
+ ENDIF
+
+ CASE DEFAULT
+!
+!-- User defined quantity
+ CALL user_data_output_3d( av, do3d(av,if), found, local_pf, &
+ nz_do3d )
+ resorted = .TRUE.
+
+ IF ( myid == 0 .AND. .NOT. found ) THEN
+ PRINT*, '+++ data_output_3d: no output available for: ', &
+ do3d(av,if)
+ ENDIF
+
+ END SELECT
+
+!
+!-- Resort the array to be output, if not done above
+ IF ( .NOT. resorted ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nz_do3d
+ local_pf(i,j,k) = to_be_resorted(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Output of the volume data information for the AVS-FLD-file.
+ do3d_avs_n = do3d_avs_n + 1
+ IF ( myid == 0 .AND. avs_output ) THEN
+!
+!-- AVS-labels must not contain any colons. Hence they must be removed
+!-- from the time character string.
+ simulated_time_mod = simulated_time_chr
+ DO WHILE ( SCAN( simulated_time_mod, ':' ) /= 0 )
+ pos = SCAN( simulated_time_mod, ':' )
+ simulated_time_mod(pos:pos) = '/'
+ ENDDO
+
+ IF ( av == 0 ) THEN
+ WRITE ( 33, 3300 ) do3d_avs_n, TRIM( avs_data_file ), &
+ skip_do_avs, TRIM( do3d(av,if) ), &
+ TRIM( simulated_time_mod )
+ ELSE
+ WRITE ( 33, 3300 ) do3d_avs_n, TRIM( avs_data_file ), &
+ skip_do_avs, TRIM( do3d(av,if) ) // &
+ ' averaged', TRIM( simulated_time_mod )
+ ENDIF
+!
+!-- Determine the Skip-value for the next array. Record end and start
+!-- require 4 byte each.
+ skip_do_avs = skip_do_avs + ( ((nx+2)*(ny+2)*(nz_do3d+1)) * 4 + 8 )
+ ENDIF
+
+!
+!-- Output of the 3D-array. (compressed/uncompressed)
+ IF ( do3d_compress ) THEN
+!
+!-- Compression, output of compression information on FLD-file and output
+!-- of compressed data.
+ CALL write_compressed( local_pf, 30, 33, myid, nxl, nxr, nyn, nys, &
+ nzb, nz_do3d, prec )
+ ELSE
+!
+!-- Uncompressed output.
+#if defined( __parallel )
+ IF ( netcdf_output .AND. myid == 0 ) THEN
+ WRITE ( 30 ) simulated_time, do3d_time_count(av), av
+ ENDIF
+ WRITE ( 30 ) nxl-1, nxr+1, nys-1, nyn+1, nzb, nz_do3d
+ WRITE ( 30 ) local_pf
+#else
+ IF ( avs_output ) THEN
+ WRITE ( 30 ) local_pf(nxl:nxr+1,nys:nyn+1,:)
+ ENDIF
+#if defined( __netcdf )
+ IF ( netcdf_output ) THEN
+ nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), &
+ local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d), &
+ start = (/ 1, 1, 1, do3d_time_count(av) /), &
+ count = (/ nx+2, ny+2, nz_do3d-nzb+1, 1 /) )
+ IF ( nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 1010 )
+ ENDIF
+#endif
+#endif
+ ENDIF
+
+ if = if + 1
+
+ ENDDO
+
+!
+!-- Deallocate temporary array.
+ DEALLOCATE( local_pf )
+
+
+ CALL cpu_log (log_point(14),'data_output_3d','stop','nobarrier')
+
+!
+!-- Formats.
+3300 FORMAT ('variable ',I4,' file=',A,' filetype=unformatted skip=',I12/ &
+ 'label = ',A,A)
+
+ END SUBROUTINE data_output_3d
Index: /palm/tags/release-3.4a/SOURCE/data_output_dvrp.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/data_output_dvrp.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/data_output_dvrp.f90 (revision 141)
@@ -0,0 +1,520 @@
+ MODULE dvrp_color
+
+ USE dvrp_variables
+
+ IMPLICIT NONE
+
+ CONTAINS
+
+ SUBROUTINE color_dvrp( value, color )
+
+ REAL, INTENT(IN) :: value
+ REAL, INTENT(OUT) :: color(4)
+
+ REAL :: scale
+
+ scale = ( value - slicer_range_limits_dvrp(1,islice_dvrp) ) / &
+ ( slicer_range_limits_dvrp(2,islice_dvrp) - &
+ slicer_range_limits_dvrp(1,islice_dvrp) )
+
+ scale = MODULO( 180.0 + 180.0 * scale, 360.0 )
+
+ color = (/ scale, 0.5, 1.0, 0.0 /)
+
+ END SUBROUTINE color_dvrp
+
+ END MODULE dvrp_color
+
+
+ RECURSIVE SUBROUTINE data_output_dvrp
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+! TEST: different colours for isosurfaces
+! TEST: write statements
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 130 2007-11-13 14:08:40Z letzel
+! allow two instead of one digit to specify isosurface and slicer variables
+! for unknown variables (CASE DEFAULT) call new subroutine
+! user_data_output_dvrp
+!
+! 82 2007-04-16 15:40:52Z raasch
+! Preprocessor strings for different linux clusters changed to "lc",
+! routine local_flush is used for buffer flushing
+!
+! 75 2007-03-22 09:54:05Z raasch
+! Particles-package is now part of the default code,
+! moisture renamed humidity
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.13 2006/02/23 10:25:12 raasch
+! Former routine plot_dvrp renamed data_output_dvrp,
+! Only a fraction of the particles may have a tail,
+! pl.. replaced by do.., %size renamed %dvrp_psize
+!
+! Revision 1.1 2000/04/27 06:27:17 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Plot of isosurface, particles and slicers with dvrp-software
+!------------------------------------------------------------------------------!
+#if defined( __dvrp_graphics )
+
+ USE arrays_3d
+ USE cloud_parameters
+ USE cpulog
+ USE DVRP
+ USE dvrp_color
+ USE dvrp_variables
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE particle_attributes
+ USE pegrid
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=2) :: section_chr
+ CHARACTER (LEN=6) :: output_variable
+ INTEGER :: i, j, k, l, m, n, nn, section_mode, tv, vn
+ INTEGER, DIMENSION(:), ALLOCATABLE :: p_c, p_t
+ REAL :: center(3), distance, slicer_position, surface_value
+ REAL, DIMENSION(:), ALLOCATABLE :: psize, p_x, p_y, p_z
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: local_pf
+
+
+ WRITE ( 9, * ) '*** myid=', myid, ' Anfang data_output_dvrp'
+ CALL local_flush( 9 )
+ CALL cpu_log( log_point(27), 'data_output_dvrp', 'start' )
+
+!
+!-- Loop over all output modes choosed
+ m = 1
+ tv = 0 ! threshold counter
+ islice_dvrp = 0 ! slice plane counter
+ DO WHILE ( mode_dvrp(m) /= ' ' )
+!
+!-- Update of the steering variables
+ IF ( .NOT. lock_steering_update ) THEN
+!
+!-- Set lock to avoid recursive calls of DVRP_STEERING_UPDATE
+ lock_steering_update = .TRUE.
+! WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: vor steering_update'
+! CALL local_flush( 9 )
+ CALL DVRP_STEERING_UPDATE( m-1, data_output_dvrp )
+! WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: nach steering_update'
+! CALL local_flush( 9 )
+ lock_steering_update = .FALSE.
+ ENDIF
+
+!
+!-- Determine the variable which shall be plotted (in case of slicers or
+!-- isosurfaces)
+ IF ( mode_dvrp(m)(1:10) == 'isosurface' ) THEN
+ READ ( mode_dvrp(m), '(10X,I2)' ) vn
+ output_variable = do3d(0,vn)
+ tv = tv + 1
+ ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' ) THEN
+ READ ( mode_dvrp(m), '(6X,I2)' ) vn
+ output_variable = do2d(0,vn)
+ l = MAX( 2, LEN_TRIM( do2d(0,vn) ) )
+ section_chr = do2d(0,vn)(l-1:l)
+ SELECT CASE ( section_chr )
+ CASE ( 'xy' )
+ section_mode = 2
+ slicer_position = zu(MIN( slicer_position_dvrp(m), nz_do3d ))
+ CASE ( 'xz' )
+ section_mode = 1
+ slicer_position = slicer_position_dvrp(m) * dy
+ CASE ( 'yz' )
+ section_mode = 0
+ slicer_position = slicer_position_dvrp(m) * dx
+ END SELECT
+ ENDIF
+
+!
+!-- Select the plot mode (in case of isosurface or slicer only if user has
+!-- defined a variable which shall be plotted; otherwise do nothing)
+ IF ( mode_dvrp(m)(1:9) == 'particles' .AND. particle_advection .AND. &
+ simulated_time >= particle_advection_start ) THEN
+
+! WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: anfang particles'
+! CALL local_flush( 9 )
+!
+!-- DVRP-Calls for plotting particles:
+ CALL cpu_log( log_point_s(28), 'dvrp_particles', 'start' )
+
+!
+!-- Definition of characteristics of particle material
+! CALL DVRP_MATERIAL_RGB( m-1, 1, 0.1, 0.7, 0.1, 0.0 )
+ CALL DVRP_MATERIAL_RGB( m-1, 1, 0.0, 0.0, 0.0, 0.0 )
+
+!
+!-- Move particle coordinates to one-dimensional arrays
+ IF ( .NOT. use_particle_tails ) THEN
+!
+!-- All particles are output
+ ALLOCATE( psize(number_of_particles), p_t(number_of_particles), &
+ p_c(number_of_particles), p_x(number_of_particles), &
+ p_y(number_of_particles), p_z(number_of_particles) )
+ psize = 0.0; p_t = 0; p_c = 0.0; p_x = 0.0; p_y = 0.0
+ p_z = 0.0;
+ psize = particles(1:number_of_particles)%dvrp_psize
+ p_x = particles(1:number_of_particles)%x * superelevation_x
+ p_y = particles(1:number_of_particles)%y * superelevation_y
+ p_z = particles(1:number_of_particles)%z * superelevation
+ p_c = particles(1:number_of_particles)%color
+ ELSE
+!
+!-- Particles have a tail
+! WRITE (9,*) '--- before ALLOCATE simtime=',simulated_time,' #of_tails=', number_of_tails, &
+! ' max#of_tp=', maximum_number_of_tailpoints
+! CALL local_flush( 9 )
+ ALLOCATE( psize(number_of_tails), p_t(number_of_tails), &
+ p_c(number_of_tails*maximum_number_of_tailpoints), &
+ p_x(number_of_tails*maximum_number_of_tailpoints), &
+ p_y(number_of_tails*maximum_number_of_tailpoints), &
+ p_z(number_of_tails*maximum_number_of_tailpoints) )
+! WRITE (9,*) '--- after ALLOCATE'
+! CALL local_flush( 9 )
+ psize = 0.0; p_t = 0; p_c = 0.0; p_x = 0.0; p_y = 0.0
+ p_z = 0.0;
+ i = 0
+ k = 0
+ DO n = 1, number_of_particles
+ nn = particles(n)%tail_id
+ IF ( nn /= 0 ) THEN
+ k = k + 1
+! IF ( simulated_time > 1338.0 ) THEN
+! WRITE (9,*) '--- particle ',n,' tail_id=',nn,' #of_tp=',particles(n)%tailpoints
+! CALL local_flush( 9 )
+! ENDIF
+ DO j = 1, particles(n)%tailpoints
+ i = i + 1
+ p_x(i) = particle_tail_coordinates(j,1,nn) * &
+ superelevation_x
+ p_y(i) = particle_tail_coordinates(j,2,nn) * &
+ superelevation_y
+ p_z(i) = particle_tail_coordinates(j,3,nn) * &
+ superelevation
+ p_c(i) = particle_tail_coordinates(j,4,nn)
+! IF ( simulated_time > 1338.0 ) THEN
+! WRITE (9,*) '--- tp= ',i,' x=',p_x(i),' y=',p_y(i), &
+! ' z=',p_z(i),' c=',p_c(i)
+! CALL local_flush( 9 )
+! ENDIF
+ ENDDO
+ psize(k) = particles(n)%dvrp_psize
+ p_t(k) = particles(n)%tailpoints - 1
+! IF ( simulated_time > 1338.0 ) THEN
+! WRITE (9,*) '--- t= ',k,' psize=',psize(k),' p_t=',p_t(k)
+! CALL local_flush( 9 )
+! ENDIF
+ ENDIF
+ ENDDO
+! WRITE (9,*) '--- after locally storing the particle attributes'
+! CALL local_flush( 9 )
+ ENDIF
+
+!
+!-- Compute and plot particles in dvr-format
+ IF ( uniform_particles .AND. .NOT. use_particle_tails ) THEN
+!
+!-- All particles have the same color. Use simple routine to set
+!-- the particle attributes (produces less output data)
+ CALL DVRP_PARTICLES( m-1, p_x, p_y, p_z, psize )
+ ELSE
+!
+!-- Set color definitions
+ CALL user_dvrp_coltab( 'particles', 'none' )
+
+ CALL DVRP_COLORTABLE_HLS( m-1, 0, interval_values_dvrp, &
+ interval_h_dvrp, interval_l_dvrp, &
+ interval_s_dvrp, interval_a_dvrp )
+
+ IF ( .NOT. use_particle_tails ) THEN
+ CALL DVRP_PARTICLES( m-1, number_of_particles, p_x, p_y, p_z, &
+ 3, psize, p_c, p_t )
+ ELSE
+! WRITE (9,*) '--- before DVRP_PARTICLES'
+! CALL local_flush( 9 )
+ CALL DVRP_PARTICLES( m-1, number_of_tails, p_x, p_y, p_z, 15, &
+ psize, p_c, p_t )
+! WRITE (9,*) '--- after DVRP_PARTICLES'
+! WRITE (9,*) 'm-1 = ',m-1
+! WRITE (9,*) 'number_of_tails=', number_of_tails
+! WRITE (9,*) 'p_x =', p_x
+! WRITE (9,*) 'p_y =', p_y
+! WRITE (9,*) 'p_z =', p_z
+! WRITE (9,*) 'psize =', psize
+! WRITE (9,*) 'p_c =', p_c
+! WRITE (9,*) 'p_t =', p_t
+
+! CALL local_flush( 9 )
+ ENDIF
+ ENDIF
+
+ CALL DVRP_VISUALIZE( m-1, 3, dvrp_filecount )
+! WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: ende particles'
+! CALL local_flush( 9 )
+
+ DEALLOCATE( psize, p_c, p_t, p_x, p_y, p_z )
+
+ CALL cpu_log( log_point_s(28), 'dvrp_particles', 'stop' )
+
+
+ ELSEIF ( ( mode_dvrp(m)(1:10) == 'isosurface' .OR. &
+ mode_dvrp(m)(1:6) == 'slicer' ) &
+ .AND. output_variable /= ' ' ) THEN
+
+!
+!-- Create an intermediate array, properly dimensioned for plot-output
+ ALLOCATE( local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) )
+
+!
+!-- Move original array to intermediate array
+ SELECT CASE ( output_variable )
+
+ CASE ( 'u', 'u_xy', 'u_xz', 'u_yz' )
+ DO i = nxl, nxr+1
+ DO j = nys, nyn+1
+ DO k = nzb, nz_do3d
+ local_pf(i,j,k) = u(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+!-- Replace mirrored values at lower surface by real surface values
+ IF ( output_variable == 'u_xz' .OR. &
+ output_variable == 'u_yz' ) THEN
+ IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0
+ ENDIF
+
+
+ CASE ( 'v', 'v_xy', 'v_xz', 'v_yz' )
+ DO i = nxl, nxr+1
+ DO j = nys, nyn+1
+ DO k = nzb, nz_do3d
+ local_pf(i,j,k) = v(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+!-- Replace mirrored values at lower surface by real surface values
+ IF ( output_variable == 'v_xz' .OR. &
+ output_variable == 'v_yz' ) THEN
+ IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0
+ ENDIF
+
+ CASE ( 'w', 'w_xy', 'w_xz', 'w_yz' )
+ DO i = nxl, nxr+1
+ DO j = nys, nyn+1
+ DO k = nzb, nz_do3d
+ local_pf(i,j,k) = w(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+! Averaging for Langmuir circulation
+! DO k = nzb, nz_do3d
+! DO j = nys+1, nyn
+! DO i = nxl, nxr+1
+! local_pf(i,j,k) = 0.25 * local_pf(i,j-1,k) + &
+! 0.50 * local_pf(i,j,k) + &
+! 0.25 * local_pf(i,j+1,k)
+! ENDDO
+! ENDDO
+! ENDDO
+
+ CASE ( 'p', 'p_xy', 'p_xz', 'p_yz' )
+ DO i = nxl, nxr+1
+ DO j = nys, nyn+1
+ DO k = nzb, nz_do3d
+ local_pf(i,j,k) = p(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'pt', 'pt_xy', 'pt_xz', 'pt_yz' )
+ IF ( .NOT. cloud_physics ) THEN
+ DO i = nxl, nxr+1
+ DO j = nys, nyn+1
+ DO k = nzb, nz_do3d
+ local_pf(i,j,k) = pt(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSE
+ DO i = nxl, nxr+1
+ DO j = nys, nyn+1
+ DO k = nzb, nz_do3d
+ local_pf(i,j,k) = pt(k,j,i) + l_d_cp * pt_d_t(k) * &
+ ql(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+ CASE ( 'q', 'q_xy', 'q_xz', 'q_yz' )
+ IF ( humidity .OR. passive_scalar ) THEN
+ DO i = nxl, nxr+1
+ DO j = nys, nyn+1
+ DO k = nzb, nz_do3d
+ local_pf(i,j,k) = q(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ data_output_dvrp: if humidity/passive_scalar = ', &
+ 'FALSE output of ', output_variable, &
+ 'is not provided'
+ ENDIF
+ ENDIF
+
+ CASE ( 'ql', 'ql_xy', 'ql_xz', 'ql_yz' )
+ IF ( cloud_physics .OR. cloud_droplets ) THEN
+ DO i = nxl, nxr+1
+ DO j = nys, nyn+1
+ DO k = nzb, nz_do3d
+ local_pf(i,j,k) = ql(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ data_output_dvrp: if cloud_physics = FALSE ', &
+ 'output of ', output_variable, 'is not provided'
+ ENDIF
+ ENDIF
+
+ CASE ( 'u*_xy' )
+ DO i = nxl, nxr+1
+ DO j = nys, nyn+1
+ local_pf(i,j,nzb+1) = us(j,i)
+ ENDDO
+ ENDDO
+ slicer_position = zu(nzb+1)
+
+ CASE ( 't*_xy' )
+ DO i = nxl, nxr+1
+ DO j = nys, nyn+1
+ local_pf(i,j,nzb+1) = ts(j,i)
+ ENDDO
+ ENDDO
+ slicer_position = zu(nzb+1)
+
+
+ CASE DEFAULT
+!
+!-- The DEFAULT case is reached either if output_variable contains
+!-- unsupported variable or if the user has coded a special case in
+!-- the user interface. There, the subroutine user_data_output_dvrp
+!-- checks which of these two conditions applies.
+ CALL user_data_output_dvrp( output_variable, local_pf )
+
+
+ END SELECT
+
+
+ IF ( mode_dvrp(m)(1:10) == 'isosurface' ) THEN
+
+! WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: anfang isosurface'
+! CALL local_flush( 9 )
+!
+!-- DVRP-Calls for plotting isosurfaces:
+ CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'start' )
+
+!
+!-- Definition of characteristics of isosurface material
+!-- Preliminary settings for w!
+ IF ( output_variable == 'w' ) THEN
+ IF ( tv == 1 ) THEN
+ CALL DVRP_MATERIAL_RGB( m-1, 1, 0.8, 0.1, 0.1, 0.0 )
+ ELSE
+ CALL DVRP_MATERIAL_RGB( m-1, 1, 0.1, 0.1, 0.8, 0.0 )
+ ENDIF
+ ELSE
+ CALL DVRP_MATERIAL_RGB( m-1, 1, 0.9, 0.9, 0.9, 0.0 )
+ ENDIF
+
+!
+!-- Compute and plot isosurface in dvr-format
+ CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
+ cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
+ CALL DVRP_THRESHOLD( m-1, threshold(tv) )
+ CALL DVRP_VISUALIZE( m-1, 1, dvrp_filecount )
+! WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: ende isosurface'
+! CALL local_flush( 9 )
+
+ CALL cpu_log( log_point_s(26), 'dvrp_isosurface', 'stop' )
+
+ ELSEIF ( mode_dvrp(m)(1:6) == 'slicer' ) THEN
+
+! WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: anfang slicer'
+! CALL local_flush( 9 )
+!
+!-- DVRP-Calls for plotting slicers:
+ CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'start' )
+
+!
+!-- Material and color definitions
+ CALL DVRP_MATERIAL_RGB( m-1, 1, 0.0, 0.0, 0.0, 0.0 )
+
+ islice_dvrp = islice_dvrp + 1
+! CALL DVRP_COLORFUNCTION( m-1, DVRP_CM_HLS, 25, &
+! slicer_range_limits_dvrp(:,islice_dvrp), &
+! color_dvrp )
+
+ CALL user_dvrp_coltab( 'slicer', output_variable )
+
+ CALL DVRP_COLORTABLE_HLS( m-1, 1, interval_values_dvrp, &
+ interval_h_dvrp, interval_l_dvrp, &
+ interval_s_dvrp, interval_a_dvrp )
+
+!
+!-- Compute and plot slicer in dvr-format
+ CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
+ cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
+! CALL DVRP_SLICER( m-1, section_mode, slicer_position )
+ CALL DVRP_SLICER( m-1, 2, 1.0 )
+ WRITE (9,*) 'nx_dvrp=', nx_dvrp
+ WRITE (9,*) 'ny_dvrp=', ny_dvrp
+ WRITE (9,*) 'nz_dvrp=', nz_dvrp
+ WRITE (9,*) 'section_mode=', section_mode
+ WRITE (9,*) 'slicer_position=', slicer_position
+ CALL local_flush( 9 )
+
+ CALL DVRP_VISUALIZE( m-1, 2, dvrp_filecount )
+
+ CALL cpu_log( log_point_s(27), 'dvrp_slicer', 'stop' )
+
+! WRITE ( 9, * ) '*** myid=', myid, ' data_output_dvrp: ende slicer'
+! CALL local_flush( 9 )
+ ENDIF
+
+ DEALLOCATE( local_pf )
+
+ ENDIF
+
+ m = m + 1
+
+ ENDDO
+
+ dvrp_filecount = dvrp_filecount + 1
+
+ CALL cpu_log( log_point(27), 'data_output_dvrp', 'stop' )
+! WRITE ( 9, * ) '*** myid=', myid, ' Ende data_output_dvrp'
+! CALL local_flush( 9 )
+
+#endif
+ END SUBROUTINE data_output_dvrp
Index: /palm/tags/release-3.4a/SOURCE/data_output_profiles.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/data_output_profiles.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/data_output_profiles.f90 (revision 141)
@@ -0,0 +1,587 @@
+ SUBROUTINE data_output_profiles
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! 87 2007-05-22 15:46:47Z raasch
+! var_hom renamed pr_palm
+!
+! Revision 1.18 2006/08/16 14:27:04 raasch
+! PRINT* statements for testing removed
+!
+! Revision 1.1 1997/09/12 06:28:48 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Plot output of 1D-profiles for PROFIL
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE netcdf_control
+ USE pegrid
+ USE profil_parameter
+ USE statistics
+
+ IMPLICIT NONE
+
+
+ INTEGER :: i, id, ilc, ils, j, k, sr
+ REAL :: uxma, uxmi
+
+
+!
+!-- If required, compute statistics
+ IF ( .NOT. flow_statistics_called ) CALL flow_statistics
+
+!
+!-- Flow_statistics has its own CPU time measurement
+ CALL cpu_log( log_point(15), 'data_output_profiles', 'start' )
+
+!
+!-- If required, compute temporal average
+ IF ( averaging_interval_pr == 0.0 ) THEN
+ hom_sum(:,:,:) = hom(:,1,:,:)
+ ELSE
+ IF ( average_count_pr > 0 ) THEN
+ hom_sum = hom_sum / REAL( average_count_pr )
+ ELSE
+!
+!-- This case may happen if dt_dopr is changed in the d3par-list of
+!-- a restart run
+ RETURN
+ ENDIF
+ ENDIF
+
+
+ IF ( myid == 0 ) THEN
+
+!
+!-- Plot-output for each (sub-)region
+
+!
+!-- Open file for profile output in NetCDF format
+ IF ( netcdf_output ) THEN
+ CALL check_open( 104 )
+ ENDIF
+
+!
+!-- Open PROFIL-output files for each (sub-)region
+ IF ( profil_output ) THEN
+ DO sr = 0, statistic_regions
+ CALL check_open( 40 + sr )
+ ENDDO
+ ENDIF
+
+!
+!-- Increment the counter for number of output times
+ dopr_time_count = dopr_time_count + 1
+
+!
+!-- Re-set to zero the counter for the number of profiles already written
+!-- at the current output time into the respective crosses
+ cross_pnc_local = 0
+
+!
+!-- Output of initial profiles
+ IF ( dopr_time_count == 1 ) THEN
+
+ IF ( netcdf_output ) THEN
+#if defined( __netcdf )
+!
+!-- Store initial time (t=0) to time axis
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_time_pr, (/ 0.0 /), &
+ start = (/ 1 /), count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 329 )
+
+!
+!-- Store normalization factors
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(1), & ! wpt0
+ (/ hom_sum(nzb,18,normalizing_region) /), &
+ start = (/ 1 /), count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 330 )
+
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(2), & ! ws2
+ (/ hom_sum(nzb+8,pr_palm,normalizing_region)**2 /), &
+ start = (/ 1 /), count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 331 )
+
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(3), & ! tsw2
+ (/ hom_sum(nzb+3,pr_palm,normalizing_region)**2 /), &
+ start = (/ 1 /), count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 332 )
+
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(4), & ! ws3
+ (/ hom_sum(nzb+8,pr_palm,normalizing_region)**3 /), &
+ start = (/ 1 /), count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 333 )
+
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(5), & ! ws2tsw
+ (/ hom_sum(nzb+8,pr_palm,normalizing_region)**3 * &
+ hom_sum(nzb+3,pr_palm,normalizing_region) /), &
+ start = (/ 1 /), count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 334 )
+
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(6), & ! wstsw2
+ (/ hom_sum(nzb+8,pr_palm,normalizing_region) * &
+ hom_sum(nzb+3,pr_palm,normalizing_region)**2 /), &
+ start = (/ 1 /), count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 335 )
+
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(7), & ! z_i
+ (/ hom_sum(nzb+6,pr_palm,normalizing_region) /), &
+ start = (/ 1 /), count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 336 )
+#endif
+ ENDIF
+!
+!-- Loop over all 1D variables
+ DO i = 1, dopr_n
+
+ IF ( dopr_initial_index(i) /= 0 ) THEN
+
+!
+!-- Output for the individual (sub-)regions
+ DO sr = 0, statistic_regions
+
+ IF ( profil_output ) THEN
+ id = 40 + sr
+!
+!-- Write Label-Header
+ WRITE ( id, 100 ) TRIM( data_output_pr(i) ), '(t=0)'
+!
+!-- Write total profile
+ DO k = nzb, nzt+1
+ WRITE ( id, 101 ) hom(k,2,dopr_initial_index(i),sr), &
+ hom(k,1,dopr_initial_index(i),sr)
+ ENDDO
+!
+!-- Write separation label
+ WRITE ( id, 102 )
+ ENDIF
+
+ IF ( netcdf_output ) THEN
+#if defined( __netcdf )
+!
+!-- Write data to netcdf file
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_dopr(i,sr), &
+ hom(nzb:nzt+1,1,dopr_initial_index(i),sr), &
+ start = (/ 1, 1 /), &
+ count = (/ nzt-nzb+2, 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) &
+ CALL handle_netcdf_error( 337 )
+#endif
+ ENDIF
+
+ ENDDO
+
+ IF ( profil_output ) THEN
+!
+!-- Determine indices for later NAMELIST-output (s. below)
+ profile_number = profile_number + 1
+ j = dopr_crossindex(i)
+ IF ( j /= 0 ) THEN
+ cross_profile_number_count(j) = &
+ cross_profile_number_count(j) + 1
+ k = cross_profile_number_count(j)
+ cross_profile_numbers(k,j) = profile_number
+!
+!-- Initial profiles are always drawn as solid lines in
+!-- anti-background colour.
+ cross_linecolors(k,j) = 1
+ cross_linestyles(k,j) = 0
+!
+!-- If required, extend x-value range of the respective
+!-- cross, provided it has not been specified in &
+!-- check_parameters. Determination over all (sub-)regions.
+ IF ( cross_uxmin(j) == 0.0 .AND. &
+ cross_uxmax(j) == 0.0 ) THEN
+
+ DO sr = 0, statistic_regions
+
+ uxmi = &
+ MINVAL( hom(:nz_do1d,1,dopr_initial_index(i),sr) )
+
+ uxma = &
+ MAXVAL( hom(:nz_do1d,1,dopr_initial_index(i),sr) )
+!
+!-- When the value range of the first line in the
+!-- corresponding cross is determined, its value range
+!-- is simply adopted.
+ IF ( cross_uxmin_computed(j) > &
+ cross_uxmax_computed(j) ) THEN
+ cross_uxmin_computed(j) = uxmi
+ cross_uxmax_computed(j) = uxma
+ ELSE
+ cross_uxmin_computed(j) = &
+ MIN( cross_uxmin_computed(j), uxmi )
+ cross_uxmax_computed(j) = &
+ MAX( cross_uxmax_computed(j), uxma )
+ ENDIF
+
+ ENDDO
+
+ ENDIF
+!
+!-- If required, determine and note normalizing factors
+ SELECT CASE ( cross_normalized_x(j) )
+
+ CASE ( 'ts2' )
+ cross_normx_factor(k,j) = &
+ ( hom_sum(nzb+3,pr_palm,normalizing_region) )**2
+ CASE ( 'wpt0' )
+ cross_normx_factor(k,j) = &
+ hom_sum(nzb,18,normalizing_region)
+ CASE ( 'wsts2' )
+ cross_normx_factor(k,j) = &
+ hom_sum(nzb+8,pr_palm,normalizing_region) &
+ * ( hom_sum(nzb+3,pr_palm,normalizing_region) )**2
+ CASE ( 'ws2' )
+ cross_normx_factor(k,j) = &
+ ( hom_sum(nzb+8,pr_palm,normalizing_region) )**2
+ CASE ( 'ws2ts' )
+ cross_normx_factor(k,j) = &
+ ( hom_sum(nzb+8,pr_palm,normalizing_region) )**2 &
+ * hom_sum(nzb+3,pr_palm,normalizing_region)
+ CASE ( 'ws3' )
+ cross_normx_factor(k,j) = &
+ ( hom_sum(nzb+8,pr_palm,normalizing_region) )**3
+
+ END SELECT
+
+ SELECT CASE ( cross_normalized_y(j) )
+
+ CASE ( 'z_i' )
+ cross_normy_factor(k,j) = &
+ hom_sum(nzb+6,pr_palm,normalizing_region)
+
+ END SELECT
+
+!
+!-- Check the normalizing factors for zeros and deactivate
+!-- the normalization, if required.
+ IF ( cross_normx_factor(k,j) == 0.0 .OR. &
+ cross_normy_factor(k,j) == 0.0 ) THEN
+ PRINT*,'+++ WARNING data_output_profiles: normalizi', &
+ 'ng cross ',j, ' is not possible since one o', &
+ 'f the'
+ PRINT*,' normalizing factors is ',&
+ 'zero!'
+ PRINT*,' cross_normx_factor(',k,',',j,') = ', &
+ cross_normx_factor(k,j)
+ PRINT*,' cross_normy_factor(',k,',',j,') = ', &
+ cross_normy_factor(k,j)
+ cross_normx_factor(k,j) = 1.0
+ cross_normy_factor(k,j) = 1.0
+ cross_normalized_x(j) = ' '
+ cross_normalized_y(j) = ' '
+ ENDIF
+
+!
+!-- If required, extend normalized x-value range of the
+!-- respective cross, provided it has not been specified in
+!-- check_parameters. Determination over all (sub-)regions.
+ IF ( cross_uxmin_normalized(j) == 0.0 .AND. &
+ cross_uxmax_normalized(j) == 0.0 ) THEN
+
+ DO sr = 0, statistic_regions
+
+ uxmi = MINVAL( hom(:nz_do1d,1, &
+ dopr_initial_index(i),sr) ) / &
+ cross_normx_factor(k,j)
+ uxma = MAXVAL( hom(:nz_do1d,1, &
+ dopr_initial_index(i),sr) ) / &
+ cross_normx_factor(k,j)
+!
+!-- When the value range of the first line in the
+!-- corresponding cross is determined, its value range
+!-- is simply adopted.
+ IF ( cross_uxmin_normalized_computed(j) > &
+ cross_uxmax_normalized_computed(j) ) THEN
+ cross_uxmin_normalized_computed(j) = uxmi
+ cross_uxmax_normalized_computed(j) = uxma
+ ELSE
+ cross_uxmin_normalized_computed(j) = &
+ MIN( cross_uxmin_normalized_computed(j), uxmi )
+ cross_uxmax_normalized_computed(j) = &
+ MAX( cross_uxmax_normalized_computed(j), uxma )
+ ENDIF
+
+ ENDDO
+
+ ENDIF
+
+ ENDIF ! Index determination
+
+ ENDIF ! profil output
+
+ ENDIF ! Initial profile available
+
+ ENDDO ! Loop over dopr_n for initial profiles
+
+ IF ( netcdf_output ) dopr_time_count = dopr_time_count + 1
+
+ ENDIF ! Initial profiles
+
+ IF ( netcdf_output ) THEN
+#if defined( __netcdf )
+!
+!-- Store time to time axis
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_time_pr, &
+ (/ simulated_time /), &
+ start = (/ dopr_time_count /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 338 )
+
+!
+!-- Store normalization factors
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(1), & ! wpt0
+ (/ hom_sum(nzb,18,normalizing_region) /), &
+ start = (/ dopr_time_count /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 339 )
+
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(2), & ! ws2
+ (/ hom_sum(nzb+8,pr_palm,normalizing_region)**2 /), &
+ start = (/ dopr_time_count /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 340 )
+
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(3), & ! tsw2
+ (/ hom_sum(nzb+3,pr_palm,normalizing_region)**2 /), &
+ start = (/ dopr_time_count /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 341 )
+
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(4), & ! ws3
+ (/ hom_sum(nzb+8,pr_palm,normalizing_region)**3 /), &
+ start = (/ dopr_time_count /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 342 )
+
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(5), & ! ws2tsw
+ (/ hom_sum(nzb+8,pr_palm,normalizing_region)**3 * &
+ hom_sum(nzb+3,pr_palm,normalizing_region) /), &
+ start = (/ dopr_time_count /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 343 )
+
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(6), & ! wstsw2
+ (/ hom_sum(nzb+8,pr_palm,normalizing_region) * &
+ hom_sum(nzb+3,pr_palm,normalizing_region)**2 /), &
+ start = (/ dopr_time_count /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 344 )
+
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(7), & ! z_i
+ (/ hom_sum(nzb+6,pr_palm,normalizing_region) /), &
+ start = (/ dopr_time_count /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 345 )
+#endif
+ ENDIF
+
+!
+!-- Output of the individual (non-initial) profiles
+ DO i = 1, dopr_n
+
+!
+!-- Output for the individual (sub-)domains
+ DO sr = 0, statistic_regions
+
+ IF ( profil_output ) THEN
+ id = 40 + sr
+!
+!-- Write Label-Header
+ WRITE ( id, 100 ) TRIM( dopr_label(i) ), simulated_time_chr
+!
+!-- Output of total profile
+ DO k = nzb, nzt+1
+ WRITE ( id, 101 ) hom(k,2,dopr_index(i),sr), &
+ hom_sum(k,dopr_index(i),sr)
+ ENDDO
+!
+!-- Write separation label
+ WRITE ( id, 102 )
+ ENDIF
+
+ IF ( netcdf_output ) THEN
+#if defined( __netcdf )
+!
+!-- Write data to netcdf file
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_dopr(i,sr), &
+ hom_sum(nzb:nzt+1,dopr_index(i),sr),&
+ start = (/ 1, dopr_time_count /), &
+ count = (/ nzt-nzb+2, 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 346 )
+#endif
+ ENDIF
+
+ ENDDO
+
+ IF ( profil_output ) THEN
+!
+!-- Determine profile number on file and note the data for later
+!-- NAMELIST output, if the respective profile is to be drawn by
+!-- PROFIL (if it shall not be drawn, the variable dopr_crossindex has
+!-- the value 0, otherwise the number of the coordinate cross)
+ profile_number = profile_number + 1
+ j = dopr_crossindex(i)
+
+ IF ( j /= 0 ) THEN
+ cross_profile_number_count(j) = cross_profile_number_count(j) +1
+ k = cross_profile_number_count(j)
+ cross_pnc_local(j) = cross_pnc_local(j) +1
+ cross_profile_numbers(k,j) = profile_number
+ ilc = MOD( dopr_time_count, 10 )
+ IF ( ilc == 0 ) ilc = 10
+ cross_linecolors(k,j) = linecolors(ilc)
+ ils = MOD( cross_pnc_local(j), 11 )
+ IF ( ils == 0 ) ils = 11
+ cross_linestyles(k,j) = linestyles(ils)
+!
+!-- If required, extend x-value range of the respective coordinate
+!-- cross, provided it has not been specified in check_parameters.
+!-- Determination over all (sub-)regions.
+ IF ( cross_uxmin(j) == 0.0 .AND. cross_uxmax(j) == 0.0 ) THEN
+
+ DO sr = 0, statistic_regions
+
+ uxmi = MINVAL( hom_sum(:nz_do1d,dopr_index(i),sr) )
+ uxma = MAXVAL( hom_sum(:nz_do1d,dopr_index(i),sr) )
+!
+!-- When the value range of the first line in the
+!-- corresponding cross is determined, its value range is
+!-- simply adopted.
+ IF ( cross_uxmin_computed(j) > cross_uxmax_computed(j) ) &
+ THEN
+ cross_uxmin_computed(j) = uxmi
+ cross_uxmax_computed(j) = uxma
+ ELSE
+ cross_uxmin_computed(j) = &
+ MIN( cross_uxmin_computed(j), uxmi )
+ cross_uxmax_computed(j) = &
+ MAX( cross_uxmax_computed(j), uxma )
+ ENDIF
+
+ ENDDO
+
+ ENDIF
+!
+!-- If required, store the normalizing factors
+ SELECT CASE ( cross_normalized_x(j) )
+
+ CASE ( 'tsw2' )
+ cross_normx_factor(k,j) = &
+ ( hom_sum(nzb+11,pr_palm,normalizing_region) )**2
+ CASE ( 'wpt0' )
+ cross_normx_factor(k,j) = &
+ hom_sum(nzb,18,normalizing_region)
+ CASE ( 'wstsw2' )
+ cross_normx_factor(k,j) = &
+ hom_sum(nzb+8,pr_palm,normalizing_region) &
+ * ( hom_sum(nzb+11,pr_palm,normalizing_region) )**2
+ CASE ( 'ws2' )
+ cross_normx_factor(k,j) = &
+ ( hom_sum(nzb+8,pr_palm,normalizing_region) )**2
+ CASE ( 'ws2tsw' )
+ cross_normx_factor(k,j) = &
+ ( hom_sum(nzb+8,pr_palm,normalizing_region) )**2&
+ * hom_sum(nzb+11,pr_palm,normalizing_region)
+ CASE ( 'ws3' )
+ cross_normx_factor(k,j) = &
+ ( hom_sum(nzb+8,pr_palm,normalizing_region) )**3
+
+ END SELECT
+ SELECT CASE ( cross_normalized_y(j) )
+
+ CASE ( 'z_i' )
+ cross_normy_factor(k,j) = &
+ hom_sum(nzb+6,pr_palm,normalizing_region)
+
+ END SELECT
+
+!
+!-- Check the normalizing factors for zeros and deactivate the
+!-- normalization, if required.
+ IF ( cross_normx_factor(k,j) == 0.0 .OR. &
+ cross_normy_factor(k,j) == 0.0 ) THEN
+ PRINT*,'+++ WARNING data_output_profiles: normalizing ',j, &
+ ' cross is not possible since one of the'
+ PRINT*,' normalizing factors is zero!'
+ PRINT*,' cross_normx_factor(',k,',',j,') = ', &
+ cross_normx_factor(k,j)
+ PRINT*,' cross_normy_factor(',k,',',j,') = ', &
+ cross_normy_factor(k,j)
+ cross_normx_factor(k,j) = 1.0
+ cross_normy_factor(k,j) = 1.0
+ cross_normalized_x(j) = ' '
+ cross_normalized_y(j) = ' '
+ ENDIF
+
+!
+!-- If required, extend normalized x-value range of the respective
+!-- cross, provided it has not been specified in check_parameters.
+!-- Determination over all (sub-)regions.
+ IF ( cross_uxmin_normalized(j) == 0.0 .AND. &
+ cross_uxmax_normalized(j) == 0.0 ) THEN
+
+ DO sr = 0, statistic_regions
+
+ uxmi = MINVAL( hom(:nz_do1d,1,dopr_index(i),sr) ) / &
+ cross_normx_factor(k,j)
+ uxma = MAXVAL( hom(:nz_do1d,1,dopr_index(i),sr) ) / &
+ cross_normx_factor(k,j)
+!
+!-- When the value range of the first line in the
+!-- corresponding cross is determined, its value range is
+!-- simply adopted.
+ IF ( cross_uxmin_normalized_computed(j) > &
+ cross_uxmax_normalized_computed(j) ) THEN
+ cross_uxmin_normalized_computed(j) = uxmi
+ cross_uxmax_normalized_computed(j) = uxma
+ ELSE
+ cross_uxmin_normalized_computed(j) = &
+ MIN( cross_uxmin_normalized_computed(j), uxmi )
+ cross_uxmax_normalized_computed(j) = &
+ MAX( cross_uxmax_normalized_computed(j), uxma )
+ ENDIF
+
+ ENDDO
+
+ ENDIF
+
+ ENDIF ! Index determination
+
+ ENDIF ! profil output
+
+ ENDDO ! Loop over dopr_n
+
+ ENDIF ! Output on PE0
+
+!
+!-- If averaging has been done above, the summation counter must be re-set.
+ IF ( averaging_interval_pr /= 0.0 ) THEN
+ average_count_pr = 0
+ ENDIF
+
+ CALL cpu_log( log_point(15), 'data_output_profiles','stop', 'nobarrier' )
+
+!
+!-- Formats
+100 FORMAT ('#1 ',A,1X,A)
+101 FORMAT (E15.7,1X,E15.7)
+102 FORMAT ('NEXT')
+
+ END SUBROUTINE data_output_profiles
Index: /palm/tags/release-3.4a/SOURCE/data_output_ptseries.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/data_output_ptseries.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/data_output_ptseries.f90 (revision 141)
@@ -0,0 +1,279 @@
+ SUBROUTINE data_output_ptseries
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 60 2007-03-11 11:50:04Z raasch
+! Particles-package is now part of the default code.
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.2 2006/08/22 13:51:13 raasch
+! Seperate output for particle groups
+!
+! Revision 1.1 2006/08/04 14:24:18 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Output of particle data timeseries in NetCDF format.
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE netcdf_control
+ USE particle_attributes
+ USE pegrid
+
+ IMPLICIT NONE
+
+
+ INTEGER :: i, inum, j, n
+
+ REAL, DIMENSION(0:number_of_particle_groups,30) :: pts_value, pts_value_l
+
+
+
+ CALL cpu_log( log_point(36), 'data_output_ptseries', 'start' )
+
+ IF ( myid == 0 .AND. netcdf_output ) THEN
+!
+!-- Open file for time series output in NetCDF format
+ dopts_time_count = dopts_time_count + 1
+ CALL check_open( 109 )
+#if defined( __netcdf )
+!
+!-- Update the particle time series time axis
+ nc_stat = NF90_PUT_VAR( id_set_pts, id_var_time_pts, &
+ (/ simulated_time /), &
+ start = (/ dopts_time_count /), count = (/ 1 /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 391 )
+#endif
+
+ ENDIF
+
+ pts_value_l = 0.0
+
+!
+!-- Calculate or collect the particle time series quantities for all particles
+!-- and seperately for each particle group (if there is more than one group)
+ DO n = 1, number_of_particles
+
+ pts_value_l(0,1) = number_of_particles ! total # of particles
+ pts_value_l(0,2) = pts_value_l(0,2) + &
+ ( particles(n)%x - particles(n)%origin_x ) ! mean x
+ pts_value_l(0,3) = pts_value_l(0,3) + &
+ ( particles(n)%y - particles(n)%origin_y ) ! mean y
+ pts_value_l(0,4) = pts_value_l(0,4) + &
+ ( particles(n)%z - particles(n)%origin_z ) ! mean z
+ pts_value_l(0,5) = pts_value_l(0,5) + particles(n)%z ! mean z (absolute)
+ pts_value_l(0,6) = pts_value_l(0,6) + particles(n)%speed_x ! mean u
+ pts_value_l(0,7) = pts_value_l(0,7) + particles(n)%speed_y ! mean v
+ pts_value_l(0,8) = pts_value_l(0,8) + particles(n)%speed_z ! mean w
+ pts_value_l(0,9) = pts_value_l(0,9) + &
+ particles(n)%speed_x_sgs ! mean sgsu
+ pts_value_l(0,10) = pts_value_l(0,10) + &
+ particles(n)%speed_y_sgs ! mean sgsv
+ pts_value_l(0,11) = pts_value_l(0,11) + &
+ particles(n)%speed_z_sgs ! mean sgsw
+ IF ( particles(n)%speed_z > 0.0 ) THEN
+ pts_value_l(0,12) = pts_value_l(0,12) + 1.0 ! # of upward moving prts
+ pts_value_l(0,13) = pts_value_l(0,13) + &
+ particles(n)%speed_z ! mean w upw.
+ ELSE
+ pts_value_l(0,14) = pts_value_l(0,14) + &
+ particles(n)%speed_z ! mean w down
+ ENDIF
+ pts_value_l(0,15) = number_of_particles
+ pts_value_l(0,16) = number_of_particles
+
+!
+!-- Repeat the same for the respective particle group
+ IF ( number_of_particle_groups > 1 ) THEN
+ j = particles(n)%group
+
+ pts_value_l(j,1) = pts_value_l(j,1) + 1
+ pts_value_l(j,2) = pts_value_l(j,2) + &
+ ( particles(n)%x - particles(n)%origin_x )
+ pts_value_l(j,3) = pts_value_l(j,3) + &
+ ( particles(n)%y - particles(n)%origin_y )
+ pts_value_l(j,4) = pts_value_l(j,4) + &
+ ( particles(n)%z - particles(n)%origin_z )
+ pts_value_l(j,5) = pts_value_l(j,5) + particles(n)%z
+ pts_value_l(j,6) = pts_value_l(j,6) + particles(n)%speed_x
+ pts_value_l(j,7) = pts_value_l(j,7) + particles(n)%speed_y
+ pts_value_l(j,8) = pts_value_l(j,8) + particles(n)%speed_z
+ pts_value_l(j,9) = pts_value_l(j,9) + particles(n)%speed_x_sgs
+ pts_value_l(j,10) = pts_value_l(j,10) + particles(n)%speed_y_sgs
+ pts_value_l(j,11) = pts_value_l(j,11) + particles(n)%speed_z_sgs
+ IF ( particles(n)%speed_z > 0.0 ) THEN
+ pts_value_l(j,12) = pts_value_l(j,12) + 1.0
+ pts_value_l(j,13) = pts_value_l(j,13) + particles(n)%speed_z
+ ELSE
+ pts_value_l(j,14) = pts_value_l(j,14) + particles(n)%speed_z
+ ENDIF
+ pts_value_l(j,15) = pts_value_l(j,15) + 1.0
+ pts_value_l(j,16) = pts_value_l(j,16) + 1.0
+
+ ENDIF
+
+ ENDDO
+
+#if defined( __parallel )
+!
+!-- Sum values of the subdomains
+ inum = number_of_particle_groups + 1
+
+ CALL MPI_ALLREDUCE( pts_value_l(0,1), pts_value(0,1), 14*inum, MPI_REAL, &
+ MPI_SUM, comm2d, ierr )
+ CALL MPI_ALLREDUCE( pts_value_l(0,15), pts_value(0,15), inum, MPI_REAL, &
+ MPI_MAX, comm2d, ierr )
+ CALL MPI_ALLREDUCE( pts_value_l(0,16), pts_value(0,16), inum, MPI_REAL, &
+ MPI_MIN, comm2d, ierr )
+#else
+ pts_value(:,1:16) = pts_value_l(:,1:16)
+#endif
+
+!
+!-- Normalize the above calculated quantities with the total number of
+!-- particles
+ IF ( number_of_particle_groups > 1 ) THEN
+ inum = number_of_particle_groups
+ ELSE
+ inum = 0
+ ENDIF
+
+ DO j = 0, inum
+
+ IF ( pts_value(j,1) > 0.0 ) THEN
+
+ pts_value(j,2:14) = pts_value(j,2:14) / pts_value(j,1)
+ IF ( pts_value(j,12) > 0.0 .AND. pts_value(j,12) < 1.0 ) THEN
+ pts_value(j,13) = pts_value(j,13) / pts_value(j,12)
+ pts_value(j,14) = pts_value(j,14) / ( 1.0 - pts_value(j,12) )
+ ELSEIF ( pts_value(j,12) == 0.0 ) THEN
+ pts_value(j,13) = -1.0
+ ELSE
+ pts_value(j,14) = -1.0
+ ENDIF
+
+ ENDIF
+
+ ENDDO
+
+!
+!-- Calculate higher order moments of particle time series quantities,
+!-- seperately for each particle group (if there is more than one group)
+ DO n = 1, number_of_particles
+
+ pts_value_l(0,17) = pts_value_l(0,17) + ( particles(n)%x - &
+ particles(n)%origin_x - pts_value(0,2) )**2 ! x*2
+ pts_value_l(0,18) = pts_value_l(0,18) + ( particles(n)%y - &
+ particles(n)%origin_y - pts_value(0,3) )**2 ! y*2
+ pts_value_l(0,19) = pts_value_l(0,19) + ( particles(n)%z - &
+ particles(n)%origin_z - pts_value(0,4) )**2 ! z*2
+ pts_value_l(0,20) = pts_value_l(0,20) + ( particles(n)%speed_x - &
+ pts_value(0,6) )**2 ! u*2
+ pts_value_l(0,21) = pts_value_l(0,21) + ( particles(n)%speed_y - &
+ pts_value(0,7) )**2 ! v*2
+ pts_value_l(0,22) = pts_value_l(0,22) + ( particles(n)%speed_z - &
+ pts_value(0,8) )**2 ! w*2
+ pts_value_l(0,23) = pts_value_l(0,23) + ( particles(n)%speed_x_sgs - &
+ pts_value(0,9) )**2 ! u"2
+ pts_value_l(0,24) = pts_value_l(0,24) + ( particles(n)%speed_y_sgs - &
+ pts_value(0,10) )**2 ! v"2
+ pts_value_l(0,25) = pts_value_l(0,25) + ( particles(n)%speed_z_sgs - &
+ pts_value(0,11) )**2 ! w"2
+!
+!-- Repeat the same for the respective particle group
+ IF ( number_of_particle_groups > 1 ) THEN
+ j = particles(n)%group
+
+ pts_value_l(j,17) = pts_value_l(j,17) + ( particles(n)%x - &
+ particles(n)%origin_x - pts_value(j,2) )**2
+ pts_value_l(j,18) = pts_value_l(j,18) + ( particles(n)%y - &
+ particles(n)%origin_y - pts_value(j,3) )**2
+ pts_value_l(j,19) = pts_value_l(j,19) + ( particles(n)%z - &
+ particles(n)%origin_z - pts_value(j,4) )**2
+ pts_value_l(j,20) = pts_value_l(j,20) + ( particles(n)%speed_x - &
+ pts_value(j,6) )**2
+ pts_value_l(j,21) = pts_value_l(j,21) + ( particles(n)%speed_y - &
+ pts_value(j,7) )**2
+ pts_value_l(j,22) = pts_value_l(j,22) + ( particles(n)%speed_z - &
+ pts_value(j,8) )**2
+ pts_value_l(j,23) = pts_value_l(j,23) + ( particles(n)%speed_x_sgs - &
+ pts_value(j,9) )**2
+ pts_value_l(j,24) = pts_value_l(j,24) + ( particles(n)%speed_y_sgs - &
+ pts_value(j,10) )**2
+ pts_value_l(j,25) = pts_value_l(j,25) + ( particles(n)%speed_z_sgs - &
+ pts_value(j,11) )**2
+ ENDIF
+
+ ENDDO
+
+ pts_value_l(0,26) = ( number_of_particles - pts_value(0,1) / numprocs )**2
+ ! variance of particle numbers
+ IF ( number_of_particle_groups > 1 ) THEN
+ DO j = 1, number_of_particle_groups
+ pts_value_l(j,26) = ( pts_value_l(j,1) - &
+ pts_value(j,1) / numprocs )**2
+ ENDDO
+ ENDIF
+
+#if defined( __parallel )
+!
+!-- Sum values of the subdomains
+ inum = number_of_particle_groups + 1
+
+ CALL MPI_ALLREDUCE( pts_value_l(0,17), pts_value(0,17), inum*10, MPI_REAL, &
+ MPI_SUM, comm2d, ierr )
+#else
+ pts_value(:,17:26) = pts_value_l(:,17:26)
+#endif
+
+!
+!-- Normalize the above calculated quantities with the total number of
+!-- particles
+ IF ( number_of_particle_groups > 1 ) THEN
+ inum = number_of_particle_groups
+ ELSE
+ inum = 0
+ ENDIF
+
+ DO j = 0, inum
+
+ IF ( pts_value(j,1) > 0.0 ) THEN
+ pts_value(j,17:25) = pts_value(j,17:25) / pts_value(j,1)
+ ENDIF
+ pts_value(j,26) = pts_value(j,26) / numprocs
+
+ ENDDO
+
+#if defined( __netcdf )
+!
+!-- Output particle time series quantities in NetCDF format
+ IF ( myid == 0 .AND. netcdf_output ) THEN
+ DO j = 0, inum
+ DO i = 1, dopts_num
+ nc_stat = NF90_PUT_VAR( id_set_pts, id_var_dopts(i,j), &
+ (/ pts_value(j,i) /), &
+ start = (/ dopts_time_count /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 392 )
+ ENDDO
+ ENDDO
+ ENDIF
+#endif
+
+ CALL cpu_log( log_point(36), 'data_output_ptseries','stop', 'nobarrier' )
+
+ END SUBROUTINE data_output_ptseries
Index: /palm/tags/release-3.4a/SOURCE/data_output_spectra.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/data_output_spectra.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/data_output_spectra.f90 (revision 141)
@@ -0,0 +1,559 @@
+ SUBROUTINE data_output_spectra
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.7 2006/04/11 14:56:38 raasch
+! pl_spectra renamed data_output_sp
+!
+! Revision 1.1 2001/01/05 15:14:20 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Writing spectra data on file, using a special format which allows
+! plotting of these data with PROFIL-graphic-software
+!------------------------------------------------------------------------------!
+#if defined( __spectra )
+
+ USE arrays_3d
+ USE control_parameters
+ USE cpulog
+ USE interfaces
+ USE netcdf_control
+ USE pegrid
+ USE spectrum
+ USE statistics
+
+
+ IMPLICIT NONE
+
+ INTEGER :: m, pr, cranz_x, cranz_y
+ LOGICAL :: frame_x, frame_y
+
+ CALL cpu_log( log_point(31), 'data_output_spectra', 'start' )
+
+!
+!-- Output is only performed on PE0
+ IF ( myid == 0 ) THEN
+
+!
+!-- Open file for spectra output in NetCDF format
+ IF ( netcdf_output ) CALL check_open( 107 )
+
+!
+!-- Increment the counter for number of output times
+ dosp_time_count = dosp_time_count + 1
+
+#if defined( __netcdf )
+!
+!-- Update the spectra time axis
+ nc_stat = NF90_PUT_VAR( id_set_sp, id_var_time_sp, (/ simulated_time /),&
+ start = (/ dosp_time_count /), count = (/ 1 /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 47 )
+#endif
+
+ IF ( profil_output ) THEN
+!
+!-- Compute RAHMEN-Parameter CRANZ for x- and y-spectra separately
+ cranz_x = 0; cranz_y = 0; frame_x = .FALSE.; frame_y = .FALSE.
+
+ m = 1
+ DO WHILE ( data_output_sp(m) /= ' ' .AND. m <= 10 )
+
+ IF ( INDEX( spectra_direction(m), 'x' ) /= 0 ) THEN
+ cranz_x = cranz_x + 1
+ ENDIF
+ IF ( INDEX( spectra_direction(m), 'y' ) /= 0 ) THEN
+ cranz_y = cranz_y + 1
+ ENDIF
+
+ m = m + 1
+
+ ENDDO
+
+ ENDIF
+
+!
+!-- If necessary, calculate time average and reset average counter
+ IF ( average_count_sp == 0 ) THEN
+ PRINT*, '+++ data_output_spectra: no spectra data available'
+ ENDIF
+ IF ( average_count_sp /= 1 ) THEN
+ spectrum_x = spectrum_x / REAL( average_count_sp )
+ spectrum_y = spectrum_y / REAL( average_count_sp )
+ average_count_sp = 0
+ ENDIF
+
+!
+!-- Loop over all spectra defined by the user
+ m = 1
+ DO WHILE ( data_output_sp(m) /= ' ' .AND. m <= 10 )
+
+ SELECT CASE ( TRIM( data_output_sp(m) ) )
+
+ CASE ( 'u' )
+ pr = 1
+
+ CASE ( 'v' )
+ pr = 2
+
+ CASE ( 'w' )
+ pr = 3
+
+ CASE ( 'pt' )
+ pr = 4
+
+ CASE ( 'q' )
+ pr = 5
+
+ CASE DEFAULT
+ PRINT*, '+++ data_output_spectra: Spectra of ', &
+ TRIM( data_output_sp(m) ), ' are not defined'
+
+ END SELECT
+
+!
+!-- Output of spectra in NetCDF format
+ IF ( netcdf_output ) THEN
+!
+!-- Output of x-spectra
+ IF ( INDEX( spectra_direction(m), 'x' ) /= 0 ) THEN
+ CALL output_spectra_netcdf( m, 'x' )
+ ENDIF
+!
+!-- Output of y-spectra
+ IF ( INDEX( spectra_direction(m), 'y' ) /= 0 ) THEN
+ CALL output_spectra_netcdf( m, 'y' )
+ ENDIF
+ ENDIF
+
+!
+!-- Output of spectra in profil format
+ IF ( profil_output ) THEN
+!
+!-- Output of x-spectra
+ IF ( INDEX( spectra_direction(m), 'x' ) /= 0 ) THEN
+ CALL data_output_spectra_x( m, cranz_x, pr, frame_x )
+ ENDIF
+
+!
+!-- Output of y-spectra
+ IF ( INDEX( spectra_direction(m), 'y' ) /= 0 ) THEN
+ CALL data_output_spectra_y( m, cranz_y, pr, frame_y )
+ ENDIF
+ ENDIF
+
+!
+!-- Increase counter for next spectrum
+ m = m + 1
+
+ ENDDO
+
+!
+!-- Reset spectra values
+ spectrum_x = 0.0; spectrum_y = 0.0
+
+ ENDIF
+
+ CALL cpu_log( log_point(31), 'data_output_spectra', 'stop' )
+
+#if defined( __parallel )
+! CALL MPI_BARRIER( comm2d, ierr ) ! really necessary
+#endif
+
+#endif
+ END SUBROUTINE data_output_spectra
+
+
+ SUBROUTINE output_spectra_netcdf( nsp, direction )
+#if defined( __netcdf )
+
+ USE constants
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE netcdf_control
+ USE spectrum
+ USE statistics
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=1), INTENT(IN) :: direction
+
+ INTEGER, INTENT(IN) :: nsp
+
+ INTEGER :: i, k
+
+ REAL :: frequency
+
+ REAL, DIMENSION(nx/2) :: netcdf_data_x
+ REAL, DIMENSION(ny/2) :: netcdf_data_y
+
+
+ IF ( direction == 'x' ) THEN
+
+ DO k = 1, n_sp_x
+
+ DO i = 1, nx/2
+ frequency = 2.0 * pi * i / ( dx * ( nx + 1 ) )
+ netcdf_data_x(i) = frequency * spectrum_x(i,k,nsp)
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_sp, id_var_dospx(nsp), netcdf_data_x, &
+ start = (/ 1, k, dosp_time_count /), &
+ count = (/ nx/2, 1, 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 348 )
+
+ ENDDO
+
+ ENDIF
+
+ IF ( direction == 'y' ) THEN
+
+ DO k = 1, n_sp_y
+
+ DO i = 1, ny/2
+ frequency = 2.0 * pi * i / ( dy * ( ny + 1 ) )
+ netcdf_data_y(i) = frequency * spectrum_y(i,k,nsp)
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_sp, id_var_dospy(nsp), netcdf_data_y, &
+ start = (/ 1, k, dosp_time_count /), &
+ count = (/ ny/2, 1, 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 349 )
+
+ ENDDO
+
+ ENDIF
+
+#endif
+ END SUBROUTINE output_spectra_netcdf
+
+
+#if defined( __spectra )
+ SUBROUTINE data_output_spectra_x( m, cranz, pr, frame_written )
+
+ USE arrays_3d
+ USE constants
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE pegrid
+ USE singleton
+ USE spectrum
+ USE statistics
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=30) :: atext
+ INTEGER :: i, j, k, m, pr
+ LOGICAL :: frame_written
+ REAL :: frequency = 0.0
+
+!
+!-- Variables needed for PROFIL-namelist
+ INTEGER :: cranz, labforx = 3, labfory = 3, legpos = 3, &
+ timodex = 1
+ INTEGER, DIMENSION(1:10) :: cucol = 1, klist = 999999, lstyle = 0
+ LOGICAL :: datleg = .TRUE., grid = .TRUE., &
+ lclose = .TRUE., rand = .TRUE., &
+ swap = .TRUE., twoxa = .TRUE., &
+ xlog = .TRUE., ylog = .TRUE.
+ CHARACTER (LEN=80) :: rtext, utext, xtext = 'k in m>->1', ytext
+ REAL :: gwid = 0.1, rlegfak = 0.7, uxmin, uxmax, &
+ uymin, uymax
+ REAL, DIMENSION(1:10) :: lwid = 0.6
+ REAL, DIMENSION(10) :: uyma, uymi
+
+ NAMELIST /RAHMEN/ cranz, datleg, rtext, swap
+ NAMELIST /CROSS/ rand, cucol, grid, gwid, klist, labforx, labfory, &
+ legpos, lclose, lstyle, lwid, rlegfak, timodex, utext, &
+ uxmin, uxmax, uymin, uymax, twoxa, xlog, xtext, ylog, &
+ ytext
+
+
+ rtext = '\0.5 ' // run_description_header
+
+!
+!-- Open parameter- and data-file
+ CALL check_open( 81 )
+ CALL check_open( 82 )
+
+!
+!-- Write file header,
+!-- write RAHMEN-parameters (pr=3: w-array is on zw, other arrys on zu,
+!-- pr serves as an index for output of strings (axis-labels) of the
+!-- different quantities u, v, w, pt and q)
+ DO k = 1, n_sp_x
+ IF ( k < 10 ) THEN
+ IF ( pr == 3 ) THEN
+ WRITE ( 82, 100 ) '#', k, header_char( pr ), &
+ INT( zw(comp_spectra_level(k)) ), &
+ simulated_time_chr
+ ELSE
+ WRITE ( 82, 100 ) '#', k, header_char( pr ), &
+ INT( zu(comp_spectra_level(k)) ), &
+ simulated_time_chr
+ ENDIF
+ ELSE
+ IF ( pr == 3 ) THEN
+ WRITE ( 82, 101 ) '#', k, header_char( pr ), &
+ INT( zw(comp_spectra_level(k)) ), &
+ simulated_time_chr
+ ELSE
+ WRITE ( 82, 101 ) '#', k, header_char( pr ), &
+ INT( zu(comp_spectra_level(k)) ), &
+ simulated_time_chr
+ ENDIF
+ ENDIF
+ ENDDO
+
+ IF ( .NOT. frame_written ) THEN
+ WRITE ( 81, RAHMEN )
+ frame_written = .TRUE.
+ ENDIF
+
+!
+!-- Write all data and calculate uymi and uyma. They serve to calculate
+!-- the CROSS-parameters uymin and uymax
+ uymi = 999.999; uyma = -999.999
+ DO i = 1, nx/2
+ frequency = 2.0 * pi * i / ( dx * ( nx + 1 ) )
+ WRITE ( 82, 102 ) frequency, ( frequency * spectrum_x(i,k,m), k = 1, &
+ n_sp_x )
+ DO k = 1, n_sp_x
+ uymi(k) = MIN( uymi(k), frequency * spectrum_x(i,k,m) )
+ uyma(k) = MAX( uyma(k), frequency * spectrum_x(i,k,m) )
+ ENDDO
+ ENDDO
+
+!
+!-- Determine CROSS-parameters
+ cucol(1:n_sp_x) = (/ ( k, k = 1, n_sp_x ) /)
+ lstyle(1:n_sp_x) = (/ ( lstyles(k), k = 1, n_sp_x ) /)
+
+!
+!-- Calculate klist-values from the available comp_spectra_level values
+ i = 1; k = 1
+ DO WHILE ( i <= 10 .AND. plot_spectra_level(i) /= 999999 )
+ DO WHILE ( k <= n_sp_x .AND. &
+ plot_spectra_level(i) >= comp_spectra_level(k) )
+ IF ( plot_spectra_level(i) == comp_spectra_level(k) ) THEN
+ klist(i) = k + klist_x
+ ELSE
+ uymi(k) = 999.999
+ uyma(k) = -999.999
+ ENDIF
+ k = k + 1
+ ENDDO
+ i = i + 1
+ ENDDO
+ uymi(k:n_sp_x) = 999.999
+ uyma(k:n_sp_x) = -999.999
+ utext = 'x'//utext_char( pr )
+ IF ( averaging_interval_sp /= 0.0 ) THEN
+ WRITE ( atext, 104 ) averaging_interval_sp
+ utext = TRIM(utext) // ', ' // TRIM( atext )
+ ENDIF
+ uxmin = 0.8 * 2.0 * pi / ( dx * ( nx + 1 ) )
+ uxmax = 1.2 * 2.0 * pi * nx/2 / ( dx * ( nx + 1 ) )
+ uymin = 0.8 * MIN ( 999.999, MINVAL ( uymi ) )
+ uymax = 1.2 * MAX ( -999.999, MAXVAL ( uyma ) )
+ ytext = ytext_char( pr )
+
+!
+!-- Output of CROSS-parameters
+ WRITE ( 81, CROSS )
+
+!
+!-- Increase counter by the number of profiles written in the actual block
+ klist_x = klist_x + n_sp_x
+
+!
+!-- Write end-mark
+ WRITE ( 82, 103 )
+
+!
+!-- Close parameter- and data-file
+ CALL close_file( 81 )
+ CALL close_file( 82 )
+
+!
+!-- Formats
+100 FORMAT (A,I1,1X,A,1X,I4,'m ',A)
+101 FORMAT (A,I2,1X,A,1X,I4,'m ',A)
+102 FORMAT (E15.7,10(1X,E15.7))
+103 FORMAT ('NEXT')
+104 FORMAT ('time averaged over',F7.1,' s')
+
+ END SUBROUTINE data_output_spectra_x
+
+
+ SUBROUTINE data_output_spectra_y( m, cranz, pr, frame_written )
+
+ USE arrays_3d
+ USE constants
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE pegrid
+ USE singleton
+ USE spectrum
+ USE statistics
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=30) :: atext
+ INTEGER :: i, j, k, m, pr
+ LOGICAL :: frame_written
+ REAL :: frequency = 0.0
+
+!
+!-- Variables needed for PROFIL-namelist
+ INTEGER :: cranz, labforx = 3, labfory = 3, legpos = 3, &
+ timodex = 1
+ INTEGER, DIMENSION(1:10) :: cucol = 1, klist = 999999, lstyle = 0
+ LOGICAL :: datleg = .TRUE., grid = .TRUE., &
+ lclose = .TRUE., rand = .TRUE., &
+ swap = .TRUE., twoxa = .TRUE., &
+ xlog = .TRUE., ylog = .TRUE.
+ CHARACTER (LEN=80) :: rtext, utext, xtext = 'k in m>->1', ytext
+ REAL :: gwid = 0.1, rlegfak = 0.7, uxmin, uxmax, &
+ uymin, uymax
+ REAL, DIMENSION(1:10) :: lwid = 0.6
+ REAL, DIMENSION(10) :: uyma, uymi
+
+ NAMELIST /RAHMEN/ cranz, datleg, rtext, swap
+ NAMELIST /CROSS/ rand, cucol, grid, gwid, klist, labforx, labfory, &
+ legpos, lclose, lstyle, lwid, rlegfak, timodex, utext, &
+ uxmin, uxmax, uymin, uymax, twoxa, xlog, xtext, ylog, &
+ ytext
+
+
+ rtext = '\0.5 ' // run_description_header
+
+!
+!-- Open parameter- and data-file
+ CALL check_open( 83 )
+ CALL check_open( 84 )
+
+!
+!-- Write file header,
+!-- write RAHMEN-parameters (pr=3: w-array is on zw, other arrys on zu,
+!-- pr serves as an index for output of strings (axis-labels) of the
+!-- different quantities u, v, w, pt and q)
+ DO k = 1, n_sp_y
+ IF ( k < 10 ) THEN
+ IF ( pr == 3 ) THEN
+ WRITE ( 84, 100 ) '#', k, header_char( pr ), &
+ INT( zw(comp_spectra_level(k)) ), &
+ simulated_time_chr
+ ELSE
+ WRITE ( 84, 100 ) '#', k, header_char( pr ), &
+ INT( zu(comp_spectra_level(k)) ), &
+ simulated_time_chr
+ ENDIF
+ ELSE
+ IF ( pr == 3 ) THEN
+ WRITE ( 84, 101 ) '#', k, header_char( pr ), &
+ INT( zw(comp_spectra_level(k)) ), &
+ simulated_time_chr
+ ELSE
+ WRITE ( 84, 101 ) '#', k, header_char( pr ), &
+ INT( zu(comp_spectra_level(k)) ), &
+ simulated_time_chr
+ ENDIF
+ ENDIF
+ ENDDO
+
+ IF ( .NOT. frame_written ) THEN
+ WRITE ( 83, RAHMEN )
+ frame_written = .TRUE.
+ ENDIF
+
+!
+!-- Write all data and calculate uymi and uyma. They serve to calculate
+!-- the CROSS-parameters uymin and uymax
+ uymi = 999.999; uyma = -999.999
+ DO j = 1, ny/2
+ frequency = 2.0 * pi * j / ( dy * ( ny + 1 ) )
+ WRITE ( 84, 102 ) frequency, ( frequency * spectrum_y(j,k,m), &
+ k = 1, n_sp_y )
+ DO k = 1, n_sp_y
+ uymi(k) = MIN( uymi(k), frequency * spectrum_y(j,k,m) )
+ uyma(k) = MAX( uyma(k), frequency * spectrum_y(j,k,m) )
+ ENDDO
+ ENDDO
+
+!
+!-- Determine CROSS-parameters
+ cucol(1:n_sp_y) = (/ ( k, k = 1, n_sp_y ) /)
+ lstyle(1:n_sp_y) = (/ ( lstyles(k), k = 1, n_sp_y ) /)
+
+!
+!-- Calculate klist-values from the available comp_spectra_level values
+ j = 1; k = 1
+ DO WHILE ( j <= 10 .AND. plot_spectra_level(j) /= 999999 )
+ DO WHILE ( k <= n_sp_y .AND. &
+ plot_spectra_level(j) >= comp_spectra_level(k) )
+ IF ( plot_spectra_level(j) == comp_spectra_level(k) ) THEN
+ klist(j) = k + klist_y
+ ELSE
+ uymi(k) = 999.999
+ uyma(k) = -999.999
+ ENDIF
+ k = k + 1
+ ENDDO
+ j = j + 1
+ ENDDO
+ uymi(k:n_sp_y) = 999.999
+ uyma(k:n_sp_y) = -999.999
+ utext = 'y'//utext_char( pr )
+ IF ( averaging_interval_sp /= 0.0 ) THEN
+ WRITE ( atext, 104 ) averaging_interval_sp
+ utext = TRIM(utext) // ', ' // TRIM( atext )
+ ENDIF
+ uxmin = 0.8 * 2.0 * pi / ( dy * ( ny + 1 ) )
+ uxmax = 1.2 * 2.0 * pi * ny/2 / ( dy * ( ny + 1 ) )
+ uymin = 0.8 * MIN ( 999.999, MINVAL ( uymi ) )
+ uymax = 1.2 * MAX ( -999.999, MAXVAL ( uyma ) )
+ ytext = ytext_char( pr )
+
+!
+!-- Output CROSS-parameters
+ WRITE ( 83, CROSS )
+
+!
+!-- Increase counter by the number of profiles written in the actual block
+ klist_y = klist_y + n_sp_y
+
+!
+!-- Write end-mark
+ WRITE ( 84, 103 )
+
+!
+!-- Close parameter- and data-file
+ CALL close_file( 83 )
+ CALL close_file( 84 )
+
+!
+!-- Formats
+100 FORMAT (A,I1,1X,A,1X,I4,'m ',A)
+101 FORMAT (A,I2,1X,A,1X,I4,'m ',A)
+102 FORMAT (E15.7,10(1X,E15.7))
+103 FORMAT ('NEXT')
+104 FORMAT ('time averaged over',F7.1,' s')
+
+ END SUBROUTINE data_output_spectra_y
+#endif
Index: /palm/tags/release-3.4a/SOURCE/data_output_tseries.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/data_output_tseries.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/data_output_tseries.f90 (revision 141)
@@ -0,0 +1,100 @@
+ SUBROUTINE data_output_tseries
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 48 2007-03-06 12:28:36Z raasch
+! Collection of time series quantities moved to routine flow_statistics,
+! output for "profil" removed
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.13 2006/03/14 12:42:51 raasch
+! Error removed: NetCDF output only if switched on
+!
+! Revision 1.1 1998/03/03 08:00:13 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Time series output for PROFIL. Always all time series are stored. A selection
+! can be applied via the PROFIL-parameters in close_file.
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE netcdf_control
+ USE pegrid
+ USE profil_parameter
+ USE statistics
+
+ IMPLICIT NONE
+
+
+ INTEGER :: file_id, i, j, sr
+
+
+!
+!-- If required, compute statistics.
+ IF ( .NOT. flow_statistics_called ) CALL flow_statistics
+
+!
+!-- Flow_statistics has its own cpu-time measuring.
+ CALL cpu_log( log_point(21), 'data_output_tseries', 'start' )
+
+ IF ( myid == 0 ) THEN
+
+!
+!-- Open file for time series output in NetCDF format
+ IF ( netcdf_output ) THEN
+ dots_time_count = dots_time_count + 1
+ CALL check_open( 105 )
+#if defined( __netcdf )
+!
+!-- Update the time series time axis
+ nc_stat = NF90_PUT_VAR( id_set_ts, id_var_time_ts, &
+ (/ simulated_time /), &
+ start = (/ dots_time_count /), &
+ count = (/ 1 /) )
+ IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 350 )
+#endif
+ ENDIF
+
+!
+!-- Time series output for the total domain (and each subregion, if
+!-- applicable)
+ DO sr = 0, statistic_regions
+
+#if defined( __netcdf )
+ IF ( netcdf_output ) THEN
+ DO i = 1, dots_num
+ nc_stat = NF90_PUT_VAR( id_set_ts, id_var_dots(i,sr), &
+ (/ ts_value(i,sr) /), &
+ start = (/ dots_time_count /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 351 )
+ ENDDO
+ ENDIF
+#endif
+
+ ENDDO
+
+ ENDIF
+
+
+ CALL cpu_log( log_point(21), 'data_output_tseries','stop', 'nobarrier' )
+
+!
+!-- formats
+500 FORMAT (23(E15.7,1X))
+
+ END SUBROUTINE data_output_tseries
Index: /palm/tags/release-3.4a/SOURCE/diffusion_e.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/diffusion_e.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/diffusion_e.f90 (revision 141)
@@ -0,0 +1,379 @@
+ MODULE diffusion_e_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 97 2007-06-21 08:23:15Z raasch
+! Adjustment of mixing length calculation for the ocean version. zw added to
+! argument list.
+! This is also a bugfix, because the height above the topography is now
+! used instead of the height above level k=0.
+! theta renamed var, dpt_dz renamed dvar_dz, +new argument var_reference
+! use_pt_reference renamed use_reference
+!
+! 65 2007-03-13 12:11:43Z raasch
+! Reference temperature pt_reference can be used in buoyancy term
+!
+! 20 2007-02-26 00:12:32Z raasch
+! Bugfix: ddzw dimensioned 1:nzt"+1"
+! Calculation extended for gridpoint nzt
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.18 2006/08/04 14:29:43 raasch
+! dissipation is stored in extra array diss if needed later on for calculating
+! the sgs particle velocities
+!
+! Revision 1.1 1997/09/19 07:40:24 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Diffusion- and dissipation terms for the TKE
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC diffusion_e
+
+
+ INTERFACE diffusion_e
+ MODULE PROCEDURE diffusion_e
+ MODULE PROCEDURE diffusion_e_ij
+ END INTERFACE diffusion_e
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, var, &
+ var_reference, rif, tend, zu, zw )
+
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE particle_attributes
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: dvar_dz, l_stable, phi_m, var_reference
+ REAL :: ddzu(1:nzt+1), dd2zu(1:nzt), ddzw(1:nzt+1), &
+ l_grid(1:nzt), zu(0:nzt+1), zw(0:nzt+1)
+ REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) :: diss, tend
+ REAL, DIMENSION(:,:), POINTER :: rif
+ REAL, DIMENSION(:,:,:), POINTER :: e, km, var
+ REAL, DIMENSION(nzb+1:nzt,nys:nyn) :: dissipation, l, ll
+
+
+!
+!-- This if clause must be outside the k-loop because otherwise
+!-- runtime errors occur with -C hopt on NEC
+ IF ( use_reference ) THEN
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+!
+!-- First, calculate phi-function for eventually adjusting the &
+!-- mixing length to the prandtl mixing length
+ IF ( adjust_mixing_length .AND. prandtl_layer ) THEN
+ IF ( rif(j,i) >= 0.0 ) THEN
+ phi_m = 1.0 + 5.0 * rif(j,i)
+ ELSE
+ phi_m = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif(j,i) ) )
+ ENDIF
+ ENDIF
+
+ DO k = nzb_s_inner(j,i)+1, nzt
+!
+!-- Calculate the mixing length (for dissipation)
+ dvar_dz = atmos_ocean_sign * &
+ ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
+ IF ( dvar_dz > 0.0 ) THEN
+ l_stable = 0.76 * SQRT( e(k,j,i) ) / &
+ SQRT( g / var_reference * dvar_dz ) + 1E-5
+ ELSE
+ l_stable = l_grid(k)
+ ENDIF
+!
+!-- Adjustment of the mixing length
+ IF ( wall_adjustment ) THEN
+ l(k,j) = MIN( wall_adjustment_factor * &
+ ( zu(k) - zw(nzb_s_inner(j,i)) ), &
+ l_grid(k), l_stable )
+ ll(k,j) = MIN( wall_adjustment_factor * &
+ ( zu(k) - zw(nzb_s_inner(j,i)) ), &
+ l_grid(k) )
+ ELSE
+ l(k,j) = MIN( l_grid(k), l_stable )
+ ll(k,j) = l_grid(k)
+ ENDIF
+ IF ( adjust_mixing_length .AND. prandtl_layer ) THEN
+ l(k,j) = MIN( l(k,j), kappa * &
+ ( zu(k) - zw(nzb_s_inner(j,i)) ) &
+ / phi_m )
+ ll(k,j) = MIN( ll(k,j), kappa * &
+ ( zu(k) - zw(nzb_s_inner(j,i)) ) &
+ / phi_m )
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+!
+!-- Calculate the tendency terms
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+
+ dissipation(k,j) = ( 0.19 + 0.74 * l(k,j) / ll(k,j) ) * &
+ e(k,j,i) * SQRT( e(k,j,i) ) / l(k,j)
+
+ tend(k,j,i) = tend(k,j,i) &
+ + ( &
+ ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) ) &
+ - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) ) &
+ ) * ddx2 &
+ + ( &
+ ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) ) &
+ - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) ) &
+ ) * ddy2 &
+ + ( &
+ ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
+ - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k) &
+ ) * ddzw(k) &
+ - dissipation(k,j)
+
+ ENDDO
+ ENDDO
+
+!
+!-- Store dissipation if needed for calculating the sgs particle
+!-- velocities
+ IF ( use_sgs_for_particles ) THEN
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ diss(k,j,i) = dissipation(k,j)
+ ENDDO
+ ENDDO
+ ENDIF
+
+ ENDDO
+
+ ELSE
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+!
+!-- First, calculate phi-function for eventually adjusting the &
+!-- mixing length to the prandtl mixing length
+ IF ( adjust_mixing_length .AND. prandtl_layer ) THEN
+ IF ( rif(j,i) >= 0.0 ) THEN
+ phi_m = 1.0 + 5.0 * rif(j,i)
+ ELSE
+ phi_m = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif(j,i) ) )
+ ENDIF
+ ENDIF
+
+ DO k = nzb_s_inner(j,i)+1, nzt
+!
+!-- Calculate the mixing length (for dissipation)
+ dvar_dz = atmos_ocean_sign * &
+ ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
+ IF ( dvar_dz > 0.0 ) THEN
+ l_stable = 0.76 * SQRT( e(k,j,i) ) / &
+ SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5
+ ELSE
+ l_stable = l_grid(k)
+ ENDIF
+!
+!-- Adjustment of the mixing length
+ IF ( wall_adjustment ) THEN
+ l(k,j) = MIN( wall_adjustment_factor * &
+ ( zu(k) - zw(nzb_s_inner(j,i)) ), &
+ l_grid(k), l_stable )
+ ll(k,j) = MIN( wall_adjustment_factor * &
+ ( zu(k) - zw(nzb_s_inner(j,i)) ), &
+ l_grid(k) )
+ ELSE
+ l(k,j) = MIN( l_grid(k), l_stable )
+ ll(k,j) = l_grid(k)
+ ENDIF
+ IF ( adjust_mixing_length .AND. prandtl_layer ) THEN
+ l(k,j) = MIN( l(k,j), kappa * &
+ ( zu(k) - zw(nzb_s_inner(j,i)) ) &
+ / phi_m )
+ ll(k,j) = MIN( ll(k,j), kappa * &
+ ( zu(k) - zw(nzb_s_inner(j,i)) ) &
+ / phi_m )
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+!
+!-- Calculate the tendency terms
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+
+ dissipation(k,j) = ( 0.19 + 0.74 * l(k,j) / ll(k,j) ) * &
+ e(k,j,i) * SQRT( e(k,j,i) ) / l(k,j)
+
+ tend(k,j,i) = tend(k,j,i) &
+ + ( &
+ ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) ) &
+ - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) ) &
+ ) * ddx2 &
+ + ( &
+ ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) ) &
+ - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) ) &
+ ) * ddy2 &
+ + ( &
+ ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
+ - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k) &
+ ) * ddzw(k) &
+ - dissipation(k,j)
+
+ ENDDO
+ ENDDO
+
+!
+!-- Store dissipation if needed for calculating the sgs particle
+!-- velocities
+ IF ( use_sgs_for_particles ) THEN
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ diss(k,j,i) = dissipation(k,j)
+ ENDDO
+ ENDDO
+ ENDIF
+
+ ENDDO
+
+ ENDIF
+
+!
+!-- Boundary condition for dissipation
+ IF ( use_sgs_for_particles ) THEN
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ diss(nzb_s_inner(j,i),j,i) = diss(nzb_s_inner(j,i)+1,j,i)
+ ENDDO
+ ENDDO
+ ENDIF
+
+ END SUBROUTINE diffusion_e
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE diffusion_e_ij( i, j, ddzu, dd2zu, ddzw, diss, e, km, l_grid, &
+ var, var_reference, rif, tend, zu, zw )
+
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE particle_attributes
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: dvar_dz, l_stable, phi_m, var_reference
+ REAL :: ddzu(1:nzt+1), dd2zu(1:nzt), ddzw(1:nzt+1), &
+ l_grid(1:nzt), zu(0:nzt+1), zw(0:nzt+1)
+ REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) :: diss, tend
+ REAL, DIMENSION(:,:), POINTER :: rif
+ REAL, DIMENSION(:,:,:), POINTER :: e, km, var
+ REAL, DIMENSION(nzb+1:nzt) :: dissipation, l, ll
+
+
+!
+!-- First, calculate phi-function for eventually adjusting the mixing length
+!-- to the prandtl mixing length
+ IF ( adjust_mixing_length .AND. prandtl_layer ) THEN
+ IF ( rif(j,i) >= 0.0 ) THEN
+ phi_m = 1.0 + 5.0 * rif(j,i)
+ ELSE
+ phi_m = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif(j,i) ) )
+ ENDIF
+ ENDIF
+
+!
+!-- Calculate the mixing length (for dissipation)
+ DO k = nzb_s_inner(j,i)+1, nzt
+ dvar_dz = atmos_ocean_sign * &
+ ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
+ IF ( dvar_dz > 0.0 ) THEN
+ IF ( use_reference ) THEN
+ l_stable = 0.76 * SQRT( e(k,j,i) ) / &
+ SQRT( g / var_reference * dvar_dz ) + 1E-5
+ ELSE
+ l_stable = 0.76 * SQRT( e(k,j,i) ) / &
+ SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5
+ ENDIF
+ ELSE
+ l_stable = l_grid(k)
+ ENDIF
+!
+!-- Adjustment of the mixing length
+ IF ( wall_adjustment ) THEN
+ l(k) = MIN( wall_adjustment_factor * &
+ ( zu(k) - zw(nzb_s_inner(j,i)) ), l_grid(k), &
+ l_stable )
+ ll(k) = MIN( wall_adjustment_factor * &
+ ( zu(k) - zw(nzb_s_inner(j,i)) ), l_grid(k) )
+ ELSE
+ l(k) = MIN( l_grid(k), l_stable )
+ ll(k) = l_grid(k)
+ ENDIF
+ IF ( adjust_mixing_length .AND. prandtl_layer ) THEN
+ l(k) = MIN( l(k), kappa * &
+ ( zu(k) - zw(nzb_s_inner(j,i)) ) / phi_m )
+ ll(k) = MIN( ll(k), kappa * &
+ ( zu(k) - zw(nzb_s_inner(j,i)) ) / phi_m )
+ ENDIF
+
+!
+!-- Calculate the tendency term
+ dissipation(k) = ( 0.19 + 0.74 * l(k) / ll(k) ) * e(k,j,i) * &
+ SQRT( e(k,j,i) ) / l(k)
+
+ tend(k,j,i) = tend(k,j,i) &
+ + ( &
+ ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) ) &
+ - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) ) &
+ ) * ddx2 &
+ + ( &
+ ( km(k,j,i)+km(k,j+1,i) ) * ( e(k,j+1,i)-e(k,j,i) ) &
+ - ( km(k,j,i)+km(k,j-1,i) ) * ( e(k,j,i)-e(k,j-1,i) ) &
+ ) * ddy2 &
+ + ( &
+ ( km(k,j,i)+km(k+1,j,i) ) * ( e(k+1,j,i)-e(k,j,i) ) * ddzu(k+1) &
+ - ( km(k,j,i)+km(k-1,j,i) ) * ( e(k,j,i)-e(k-1,j,i) ) * ddzu(k) &
+ ) * ddzw(k) &
+ - dissipation(k)
+
+ ENDDO
+
+!
+!-- Store dissipation if needed for calculating the sgs particle velocities
+ IF ( use_sgs_for_particles ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ diss(k,j,i) = dissipation(k)
+ ENDDO
+!
+!-- Boundary condition for dissipation
+ diss(nzb_s_inner(j,i),j,i) = diss(nzb_s_inner(j,i)+1,j,i)
+ ENDIF
+
+ END SUBROUTINE diffusion_e_ij
+
+ END MODULE diffusion_e_mod
Index: /palm/tags/release-3.4a/SOURCE/diffusion_s.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/diffusion_s.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/diffusion_s.f90 (revision 141)
@@ -0,0 +1,262 @@
+ MODULE diffusion_s_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 129 2007-10-30 12:12:24Z letzel
+! replace wall_heatflux by wall_s_flux that is now included in the parameter
+! list, bugfix for assignment of fluxes at walls
+!
+! 20 2007-02-26 00:12:32Z raasch
+! Bugfix: ddzw dimensioned 1:nzt"+1"
+! Calculation extended for gridpoint nzt, fluxes can be given at top,
+! +s_flux_t in parameter list, s_flux renamed s_flux_b
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.8 2006/02/23 10:34:17 raasch
+! nzb_2d replaced by nzb_s_outer in horizontal diffusion and by nzb_s_inner
+! or nzb_diff_s_inner, respectively, in vertical diffusion, prescribed surface
+! fluxes at vertically oriented topography
+!
+! Revision 1.1 2000/04/13 14:54:02 schroeter
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Diffusion term of scalar quantities (temperature and water content)
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC diffusion_s
+
+ INTERFACE diffusion_s
+ MODULE PROCEDURE diffusion_s
+ MODULE PROCEDURE diffusion_s_ij
+ END INTERFACE diffusion_s
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE diffusion_s( ddzu, ddzw, kh, s, s_flux_b, s_flux_t, &
+ wall_s_flux, tend )
+
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: vertical_gridspace
+ REAL :: ddzu(1:nzt+1), ddzw(1:nzt+1)
+ REAL :: tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+ REAL :: wall_s_flux(0:4)
+ REAL, DIMENSION(:,:), POINTER :: s_flux_b, s_flux_t
+ REAL, DIMENSION(:,:,:), POINTER :: kh, s
+
+ DO i = nxl, nxr
+ DO j = nys,nyn
+!
+!-- Compute horizontal diffusion
+ DO k = nzb_s_outer(j,i)+1, nzt
+
+ tend(k,j,i) = tend(k,j,i) &
+ + 0.5 * ( &
+ ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
+ - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
+ ) * ddx2 &
+ + 0.5 * ( &
+ ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
+ - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
+ ) * ddy2
+ ENDDO
+
+!
+!-- Apply prescribed horizontal wall heatflux where necessary
+ IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
+ THEN
+ DO k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
+
+ tend(k,j,i) = tend(k,j,i) &
+ + 0.5 * ( fwxp(j,i) * &
+ ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
+ + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1) &
+ -fwxm(j,i) * &
+ ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
+ + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2) &
+ ) * ddx2 &
+ + 0.5 * ( fwyp(j,i) * &
+ ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
+ + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3) &
+ -fwym(j,i) * &
+ ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
+ + ( 1.0 - fwym(j,i) ) * wall_s_flux(4) &
+ ) * ddy2
+ ENDDO
+ ENDIF
+
+!
+!-- Compute vertical diffusion. In case that surface fluxes have been
+!-- prescribed or computed at bottom and/or top, index k starts/ends at
+!-- nzb+2 or nzt-1, respectively.
+ DO k = nzb_diff_s_inner(j,i), nzt_diff
+
+ tend(k,j,i) = tend(k,j,i) &
+ + 0.5 * ( &
+ ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
+ - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k) &
+ ) * ddzw(k)
+ ENDDO
+
+!
+!-- Vertical diffusion at the first computational gridpoint along
+!-- z-direction
+ IF ( use_surface_fluxes ) THEN
+
+ k = nzb_s_inner(j,i)+1
+
+ tend(k,j,i) = tend(k,j,i) &
+ + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) ) &
+ * ( s(k+1,j,i)-s(k,j,i) ) &
+ * ddzu(k+1) &
+ + s_flux_b(j,i) &
+ ) * ddzw(k)
+
+ ENDIF
+
+!
+!-- Vertical diffusion at the last computational gridpoint along
+!-- z-direction
+ IF ( use_top_fluxes ) THEN
+
+ k = nzt
+
+ tend(k,j,i) = tend(k,j,i) &
+ + ( - s_flux_t(j,i) &
+ - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) ) &
+ * ( s(k,j,i)-s(k-1,j,i) ) &
+ * ddzu(k) &
+ ) * ddzw(k)
+
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE diffusion_s
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE diffusion_s_ij( i, j, ddzu, ddzw, kh, s, s_flux_b, s_flux_t, &
+ wall_s_flux, tend )
+
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: vertical_gridspace
+ REAL :: ddzu(1:nzt+1), ddzw(1:nzt+1)
+ REAL :: tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+ REAL :: wall_s_flux(0:4)
+ REAL, DIMENSION(:,:), POINTER :: s_flux_b, s_flux_t
+ REAL, DIMENSION(:,:,:), POINTER :: kh, s
+
+!
+!-- Compute horizontal diffusion
+ DO k = nzb_s_outer(j,i)+1, nzt
+
+ tend(k,j,i) = tend(k,j,i) &
+ + 0.5 * ( &
+ ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
+ - ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
+ ) * ddx2 &
+ + 0.5 * ( &
+ ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
+ - ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
+ ) * ddy2
+ ENDDO
+
+!
+!-- Apply prescribed horizontal wall heatflux where necessary
+ IF ( ( wall_w_x(j,i) .NE. 0.0 ) .OR. ( wall_w_y(j,i) .NE. 0.0 ) ) &
+ THEN
+ DO k = nzb_s_inner(j,i)+1, nzb_s_outer(j,i)
+
+ tend(k,j,i) = tend(k,j,i) &
+ + 0.5 * ( fwxp(j,i) * &
+ ( kh(k,j,i) + kh(k,j,i+1) ) * ( s(k,j,i+1)-s(k,j,i) ) &
+ + ( 1.0 - fwxp(j,i) ) * wall_s_flux(1) &
+ -fwxm(j,i) * &
+ ( kh(k,j,i) + kh(k,j,i-1) ) * ( s(k,j,i)-s(k,j,i-1) ) &
+ + ( 1.0 - fwxm(j,i) ) * wall_s_flux(2) &
+ ) * ddx2 &
+ + 0.5 * ( fwyp(j,i) * &
+ ( kh(k,j,i) + kh(k,j+1,i) ) * ( s(k,j+1,i)-s(k,j,i) ) &
+ + ( 1.0 - fwyp(j,i) ) * wall_s_flux(3) &
+ -fwym(j,i) * &
+ ( kh(k,j,i) + kh(k,j-1,i) ) * ( s(k,j,i)-s(k,j-1,i) ) &
+ + ( 1.0 - fwym(j,i) ) * wall_s_flux(4) &
+ ) * ddy2
+ ENDDO
+ ENDIF
+
+!
+!-- Compute vertical diffusion. In case that surface fluxes have been
+!-- prescribed or computed at bottom and/or top, index k starts/ends at
+!-- nzb+2 or nzt-1, respectively.
+ DO k = nzb_diff_s_inner(j,i), nzt_diff
+
+ tend(k,j,i) = tend(k,j,i) &
+ + 0.5 * ( &
+ ( kh(k,j,i) + kh(k+1,j,i) ) * ( s(k+1,j,i)-s(k,j,i) ) * ddzu(k+1) &
+ - ( kh(k,j,i) + kh(k-1,j,i) ) * ( s(k,j,i)-s(k-1,j,i) ) * ddzu(k) &
+ ) * ddzw(k)
+ ENDDO
+
+!
+!-- Vertical diffusion at the first computational gridpoint along z-direction
+ IF ( use_surface_fluxes ) THEN
+
+ k = nzb_s_inner(j,i)+1
+
+ tend(k,j,i) = tend(k,j,i) + ( 0.5 * ( kh(k,j,i)+kh(k+1,j,i) ) &
+ * ( s(k+1,j,i)-s(k,j,i) ) &
+ * ddzu(k+1) &
+ + s_flux_b(j,i) &
+ ) * ddzw(k)
+
+ ENDIF
+
+!
+!-- Vertical diffusion at the last computational gridpoint along z-direction
+ IF ( use_top_fluxes ) THEN
+
+ k = nzt
+
+ tend(k,j,i) = tend(k,j,i) + ( - s_flux_t(j,i) &
+ - 0.5 * ( kh(k-1,j,i)+kh(k,j,i) ) &
+ * ( s(k,j,i)-s(k-1,j,i) ) &
+ * ddzu(k) &
+ ) * ddzw(k)
+
+ ENDIF
+
+ END SUBROUTINE diffusion_s_ij
+
+ END MODULE diffusion_s_mod
Index: /palm/tags/release-3.4a/SOURCE/diffusion_u.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/diffusion_u.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/diffusion_u.f90 (revision 141)
@@ -0,0 +1,393 @@
+ MODULE diffusion_u_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 106 2007-08-16 14:30:26Z raasch
+! Momentumflux at top (uswst) included as boundary condition,
+! i loop is starting from nxlu (needed for non-cyclic boundary conditions)
+!
+! 75 2007-03-22 09:54:05Z raasch
+! Wall functions now include diabatic conditions, call of routine wall_fluxes,
+! z0 removed from argument list, uxrp eliminated
+!
+! 20 2007-02-26 00:12:32Z raasch
+! Bugfix: ddzw dimensioned 1:nzt"+1"
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.15 2006/02/23 10:35:35 raasch
+! nzb_2d replaced by nzb_u_outer in horizontal diffusion and by nzb_u_inner
+! or nzb_diff_u, respectively, in vertical diffusion,
+! wall functions added for north and south walls, +z0 in argument list,
+! terms containing w(k-1,..) are removed from the Prandtl-layer equation
+! because they cause errors at the edges of topography
+! WARNING: loops containing the MAX function are still not properly vectorized!
+!
+! Revision 1.1 1997/09/12 06:23:51 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Diffusion term of the u-component
+! To do: additional damping (needed for non-cyclic bc) causes bad vectorization
+! and slows down the speed on NEC about 5-10%
+!------------------------------------------------------------------------------!
+
+ USE wall_fluxes_mod
+
+ PRIVATE
+ PUBLIC diffusion_u
+
+ INTERFACE diffusion_u
+ MODULE PROCEDURE diffusion_u
+ MODULE PROCEDURE diffusion_u_ij
+ END INTERFACE diffusion_u
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE diffusion_u( ddzu, ddzw, km, km_damp_y, tend, u, usws, uswst, &
+ v, w )
+
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: kmym_x, kmym_y, kmyp_x, kmyp_y, kmzm, kmzp
+ REAL :: ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_y(nys-1:nyn+1)
+ REAL :: tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+ REAL, DIMENSION(:,:), POINTER :: usws, uswst
+ REAL, DIMENSION(:,:,:), POINTER :: km, u, v, w
+ REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: usvs
+
+!
+!-- First calculate horizontal momentum flux u'v' at vertical walls,
+!-- if neccessary
+ IF ( topography /= 'flat' ) THEN
+ CALL wall_fluxes( usvs, 1.0, 0.0, 0.0, 0.0, nzb_u_inner, &
+ nzb_u_outer, wall_u )
+ ENDIF
+
+ DO i = nxlu, nxr
+ DO j = nys,nyn
+!
+!-- Compute horizontal diffusion
+ DO k = nzb_u_outer(j,i)+1, nzt
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmyp_x = 0.25 * &
+ ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
+ kmym_x = 0.25 * &
+ ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
+ kmyp_y = kmyp_x
+ kmym_y = kmym_x
+!
+!-- Increase diffusion at the outflow boundary in case of
+!-- non-cyclic lateral boundaries. Damping is only needed for
+!-- velocity components parallel to the outflow boundary in
+!-- the direction normal to the outflow boundary.
+ IF ( bc_ns /= 'cyclic' ) THEN
+ kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+ kmym_y = MAX( kmym_y, km_damp_y(j) )
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) &
+ & + 2.0 * ( &
+ & km(k,j,i) * ( u(k,j,i+1) - u(k,j,i) ) &
+ & - km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
+ & ) * ddx2 &
+ & + ( kmyp_y * ( u(k,j+1,i) - u(k,j,i) ) * ddy &
+ & + kmyp_x * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx &
+ & - kmym_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy &
+ & - kmym_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx &
+ & ) * ddy
+ ENDDO
+
+!
+!-- Wall functions at the north and south walls, respectively
+ IF ( wall_u(j,i) /= 0.0 ) THEN
+
+ DO k = nzb_u_inner(j,i)+1, nzb_u_outer(j,i)
+ kmyp_x = 0.25 * &
+ ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
+ kmym_x = 0.25 * &
+ ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
+ kmyp_y = kmyp_x
+ kmym_y = kmym_x
+!
+!-- Increase diffusion at the outflow boundary in case of
+!-- non-cyclic lateral boundaries. Damping is only needed for
+!-- velocity components parallel to the outflow boundary in
+!-- the direction normal to the outflow boundary.
+ IF ( bc_ns /= 'cyclic' ) THEN
+ kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+ kmym_y = MAX( kmym_y, km_damp_y(j) )
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) &
+ + 2.0 * ( &
+ km(k,j,i) * ( u(k,j,i+1) - u(k,j,i) ) &
+ - km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
+ ) * ddx2 &
+ + ( fyp(j,i) * ( &
+ kmyp_y * ( u(k,j+1,i) - u(k,j,i) ) * ddy &
+ + kmyp_x * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx &
+ ) &
+ - fym(j,i) * ( &
+ kmym_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy &
+ + kmym_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx &
+ ) &
+ + wall_u(j,i) * usvs(k,j,i) &
+ ) * ddy
+ ENDDO
+ ENDIF
+
+!
+!-- Compute vertical diffusion. In case of simulating a Prandtl layer,
+!-- index k starts at nzb_u_inner+2.
+ DO k = nzb_diff_u(j,i), nzt_diff
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmzp = 0.25 * &
+ ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+ kmzm = 0.25 * &
+ ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
+
+ tend(k,j,i) = tend(k,j,i) &
+ & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
+ & + ( w(k,j,i) - w(k,j,i-1) ) * ddx &
+ & ) &
+ & - kmzm * ( ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) &
+ & + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx &
+ & ) &
+ & ) * ddzw(k)
+ ENDDO
+
+!
+!-- Vertical diffusion at the first grid point above the surface,
+!-- if the momentum flux at the bottom is given by the Prandtl law or
+!-- if it is prescribed by the user.
+!-- Difference quotient of the momentum flux is not formed over half
+!-- of the grid spacing (2.0*ddzw(k)) any more, since the comparison
+!-- with other (LES) modell showed that the values of the momentum
+!-- flux becomes too large in this case.
+!-- The term containing w(k-1,..) (see above equation) is removed here
+!-- because the vertical velocity is assumed to be zero at the surface.
+ IF ( use_surface_fluxes ) THEN
+ k = nzb_u_inner(j,i)+1
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmzp = 0.25 * &
+ ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+ kmzm = 0.25 * &
+ ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
+
+ tend(k,j,i) = tend(k,j,i) &
+ & + ( kmzp * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
+ & ) * ddzw(k) &
+ & + ( kmzp * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
+ & + usws(j,i) &
+ & ) * ddzw(k)
+ ENDIF
+
+!
+!-- Vertical diffusion at the first gridpoint below the top boundary,
+!-- if the momentum flux at the top is prescribed by the user
+ IF ( use_top_fluxes .AND. constant_top_momentumflux ) THEN
+ k = nzt
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmzp = 0.25 * &
+ ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+ kmzm = 0.25 * &
+ ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
+
+ tend(k,j,i) = tend(k,j,i) &
+ & - ( kmzm * ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx &
+ & ) * ddzw(k) &
+ & + ( -uswst(j,i) &
+ & - kmzm * ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) &
+ & ) * ddzw(k)
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE diffusion_u
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE diffusion_u_ij( i, j, ddzu, ddzw, km, km_damp_y, tend, u, usws, &
+ uswst, v, w )
+
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: kmym_x, kmym_y, kmyp_x, kmyp_y, kmzm, kmzp
+ REAL :: ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_y(nys-1:nyn+1)
+ REAL :: tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+ REAL, DIMENSION(nzb:nzt+1) :: usvs
+ REAL, DIMENSION(:,:), POINTER :: usws, uswst
+ REAL, DIMENSION(:,:,:), POINTER :: km, u, v, w
+
+!
+!-- Compute horizontal diffusion
+ DO k = nzb_u_outer(j,i)+1, nzt
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmyp_x = 0.25 * ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
+ kmym_x = 0.25 * ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
+ kmyp_y = kmyp_x
+ kmym_y = kmym_x
+
+!
+!-- Increase diffusion at the outflow boundary in case of non-cyclic
+!-- lateral boundaries. Damping is only needed for velocity components
+!-- parallel to the outflow boundary in the direction normal to the
+!-- outflow boundary.
+ IF ( bc_ns /= 'cyclic' ) THEN
+ kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+ kmym_y = MAX( kmym_y, km_damp_y(j) )
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) &
+ & + 2.0 * ( &
+ & km(k,j,i) * ( u(k,j,i+1) - u(k,j,i) ) &
+ & - km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
+ & ) * ddx2 &
+ & + ( kmyp_y * ( u(k,j+1,i) - u(k,j,i) ) * ddy &
+ & + kmyp_x * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx &
+ & - kmym_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy &
+ & - kmym_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx &
+ & ) * ddy
+ ENDDO
+
+!
+!-- Wall functions at the north and south walls, respectively
+ IF ( wall_u(j,i) .NE. 0.0 ) THEN
+
+!
+!-- Calculate the horizontal momentum flux u'v'
+ CALL wall_fluxes( i, j, nzb_u_inner(j,i)+1, nzb_u_outer(j,i), &
+ usvs, 1.0, 0.0, 0.0, 0.0 )
+
+ DO k = nzb_u_inner(j,i)+1, nzb_u_outer(j,i)
+ kmyp_x = 0.25 * ( km(k,j,i)+km(k,j+1,i)+km(k,j,i-1)+km(k,j+1,i-1) )
+ kmym_x = 0.25 * ( km(k,j,i)+km(k,j-1,i)+km(k,j,i-1)+km(k,j-1,i-1) )
+ kmyp_y = kmyp_x
+ kmym_y = kmym_x
+!
+!-- Increase diffusion at the outflow boundary in case of
+!-- non-cyclic lateral boundaries. Damping is only needed for
+!-- velocity components parallel to the outflow boundary in
+!-- the direction normal to the outflow boundary.
+ IF ( bc_ns /= 'cyclic' ) THEN
+ kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+ kmym_y = MAX( kmym_y, km_damp_y(j) )
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) &
+ + 2.0 * ( &
+ km(k,j,i) * ( u(k,j,i+1) - u(k,j,i) ) &
+ - km(k,j,i-1) * ( u(k,j,i) - u(k,j,i-1) ) &
+ ) * ddx2 &
+ + ( fyp(j,i) * ( &
+ kmyp_y * ( u(k,j+1,i) - u(k,j,i) ) * ddy &
+ + kmyp_x * ( v(k,j+1,i) - v(k,j+1,i-1) ) * ddx &
+ ) &
+ - fym(j,i) * ( &
+ kmym_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy &
+ + kmym_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx &
+ ) &
+ + wall_u(j,i) * usvs(k) &
+ ) * ddy
+ ENDDO
+ ENDIF
+
+!
+!-- Compute vertical diffusion. In case of simulating a Prandtl layer,
+!-- index k starts at nzb_u_inner+2.
+ DO k = nzb_diff_u(j,i), nzt_diff
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmzp = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+ kmzm = 0.25 * ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
+
+ tend(k,j,i) = tend(k,j,i) &
+ & + ( kmzp * ( ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
+ & + ( w(k,j,i) - w(k,j,i-1) ) * ddx &
+ & ) &
+ & - kmzm * ( ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) &
+ & + ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx &
+ & ) &
+ & ) * ddzw(k)
+ ENDDO
+
+!
+!-- Vertical diffusion at the first grid point above the surface, if the
+!-- momentum flux at the bottom is given by the Prandtl law or if it is
+!-- prescribed by the user.
+!-- Difference quotient of the momentum flux is not formed over half of
+!-- the grid spacing (2.0*ddzw(k)) any more, since the comparison with
+!-- other (LES) modell showed that the values of the momentum flux becomes
+!-- too large in this case.
+!-- The term containing w(k-1,..) (see above equation) is removed here
+!-- because the vertical velocity is assumed to be zero at the surface.
+ IF ( use_surface_fluxes ) THEN
+ k = nzb_u_inner(j,i)+1
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmzp = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+ kmzm = 0.25 * ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
+
+ tend(k,j,i) = tend(k,j,i) &
+ & + ( kmzp * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
+ & ) * ddzw(k) &
+ & + ( kmzp * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
+ & + usws(j,i) &
+ & ) * ddzw(k)
+ ENDIF
+
+!
+!-- Vertical diffusion at the first gridpoint below the top boundary,
+!-- if the momentum flux at the top is prescribed by the user
+ IF ( use_top_fluxes .AND. constant_top_momentumflux ) THEN
+ k = nzt
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmzp = 0.25 * &
+ ( km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) )
+ kmzm = 0.25 * &
+ ( km(k,j,i)+km(k-1,j,i)+km(k,j,i-1)+km(k-1,j,i-1) )
+
+ tend(k,j,i) = tend(k,j,i) &
+ & - ( kmzm * ( w(k-1,j,i) - w(k-1,j,i-1) ) * ddx &
+ & ) * ddzw(k) &
+ & + ( -uswst(j,i) &
+ & - kmzm * ( u(k,j,i) - u(k-1,j,i) ) * ddzu(k) &
+ & ) * ddzw(k)
+ ENDIF
+
+ END SUBROUTINE diffusion_u_ij
+
+ END MODULE diffusion_u_mod
Index: /palm/tags/release-3.4a/SOURCE/diffusion_v.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/diffusion_v.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/diffusion_v.f90 (revision 141)
@@ -0,0 +1,392 @@
+ MODULE diffusion_v_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 106 2007-08-16 14:30:26Z raasch
+! Momentumflux at top (vswst) included as boundary condition,
+! j loop is starting from nysv (needed for non-cyclic boundary conditions)
+!
+! 75 2007-03-22 09:54:05Z raasch
+! Wall functions now include diabatic conditions, call of routine wall_fluxes,
+! z0 removed from argument list, vynp eliminated
+!
+! 20 2007-02-26 00:12:32Z raasch
+! Bugfix: ddzw dimensioned 1:nzt"+1"
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.15 2006/02/23 10:36:00 raasch
+! nzb_2d replaced by nzb_v_outer in horizontal diffusion and by nzb_v_inner
+! or nzb_diff_v, respectively, in vertical diffusion,
+! wall functions added for north and south walls, +z0 in argument list,
+! terms containing w(k-1,..) are removed from the Prandtl-layer equation
+! because they cause errors at the edges of topography
+! WARNING: loops containing the MAX function are still not properly vectorized!
+!
+! Revision 1.1 1997/09/12 06:24:01 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Diffusion term of the v-component
+!------------------------------------------------------------------------------!
+
+ USE wall_fluxes_mod
+
+ PRIVATE
+ PUBLIC diffusion_v
+
+ INTERFACE diffusion_v
+ MODULE PROCEDURE diffusion_v
+ MODULE PROCEDURE diffusion_v_ij
+ END INTERFACE diffusion_v
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE diffusion_v( ddzu, ddzw, km, km_damp_x, tend, u, v, vsws, &
+ vswst, w )
+
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: kmxm_x, kmxm_y, kmxp_x, kmxp_y, kmzm, kmzp
+ REAL :: ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_x(nxl-1:nxr+1)
+ REAL :: tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+ REAL, DIMENSION(:,:), POINTER :: vsws, vswst
+ REAL, DIMENSION(:,:,:), POINTER :: km, u, v, w
+ REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: vsus
+
+!
+!-- First calculate horizontal momentum flux v'u' at vertical walls,
+!-- if neccessary
+ IF ( topography /= 'flat' ) THEN
+ CALL wall_fluxes( vsus, 0.0, 1.0, 0.0, 0.0, nzb_v_inner, &
+ nzb_v_outer, wall_v )
+ ENDIF
+
+ DO i = nxl, nxr
+ DO j = nysv, nyn
+!
+!-- Compute horizontal diffusion
+ DO k = nzb_v_outer(j,i)+1, nzt
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmxp_x = 0.25 * &
+ ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
+ kmxm_x = 0.25 * &
+ ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
+ kmxp_y = kmxp_x
+ kmxm_y = kmxm_x
+!
+!-- Increase diffusion at the outflow boundary in case of
+!-- non-cyclic lateral boundaries. Damping is only needed for
+!-- velocity components parallel to the outflow boundary in
+!-- the direction normal to the outflow boundary.
+ IF ( bc_lr /= 'cyclic' ) THEN
+ kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+ kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) &
+ & + ( kmxp_x * ( v(k,j,i+1) - v(k,j,i) ) * ddx &
+ & + kmxp_y * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy &
+ & - kmxm_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx &
+ & - kmxm_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy &
+ & ) * ddx &
+ & + 2.0 * ( &
+ & km(k,j,i) * ( v(k,j+1,i) - v(k,j,i) ) &
+ & - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) ) &
+ & ) * ddy2
+ ENDDO
+
+!
+!-- Wall functions at the left and right walls, respectively
+ IF ( wall_v(j,i) /= 0.0 ) THEN
+
+ DO k = nzb_v_inner(j,i)+1, nzb_v_outer(j,i)
+ kmxp_x = 0.25 * &
+ ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
+ kmxm_x = 0.25 * &
+ ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
+ kmxp_y = kmxp_x
+ kmxm_y = kmxm_x
+!
+!-- Increase diffusion at the outflow boundary in case of
+!-- non-cyclic lateral boundaries. Damping is only needed for
+!-- velocity components parallel to the outflow boundary in
+!-- the direction normal to the outflow boundary.
+ IF ( bc_lr /= 'cyclic' ) THEN
+ kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+ kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) &
+ + 2.0 * ( &
+ km(k,j,i) * ( v(k,j+1,i) - v(k,j,i) ) &
+ - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) ) &
+ ) * ddy2 &
+ + ( fxp(j,i) * ( &
+ kmxp_x * ( v(k,j,i+1) - v(k,j,i) ) * ddx &
+ + kmxp_y * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy &
+ ) &
+ - fxm(j,i) * ( &
+ kmxm_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx &
+ + kmxm_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy &
+ ) &
+ + wall_v(j,i) * vsus(k,j,i) &
+ ) * ddx
+ ENDDO
+ ENDIF
+
+!
+!-- Compute vertical diffusion. In case of simulating a Prandtl
+!-- layer, index k starts at nzb_v_inner+2.
+ DO k = nzb_diff_v(j,i), nzt_diff
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmzp = 0.25 * &
+ ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+ kmzm = 0.25 * &
+ ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
+
+ tend(k,j,i) = tend(k,j,i) &
+ & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
+ & + ( w(k,j,i) - w(k,j-1,i) ) * ddy &
+ & ) &
+ & - kmzm * ( ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) &
+ & + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy &
+ & ) &
+ & ) * ddzw(k)
+ ENDDO
+
+!
+!-- Vertical diffusion at the first grid point above the surface,
+!-- if the momentum flux at the bottom is given by the Prandtl law
+!-- or if it is prescribed by the user.
+!-- Difference quotient of the momentum flux is not formed over
+!-- half of the grid spacing (2.0*ddzw(k)) any more, since the
+!-- comparison with other (LES) modell showed that the values of
+!-- the momentum flux becomes too large in this case.
+!-- The term containing w(k-1,..) (see above equation) is removed here
+!-- because the vertical velocity is assumed to be zero at the surface.
+ IF ( use_surface_fluxes ) THEN
+ k = nzb_v_inner(j,i)+1
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmzp = 0.25 * &
+ ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+ kmzm = 0.25 * &
+ ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
+
+ tend(k,j,i) = tend(k,j,i) &
+ & + ( kmzp * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
+ & ) * ddzw(k) &
+ & + ( kmzp * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
+ & + vsws(j,i) &
+ & ) * ddzw(k)
+ ENDIF
+
+!
+!-- Vertical diffusion at the first gridpoint below the top boundary,
+!-- if the momentum flux at the top is prescribed by the user
+ IF ( use_top_fluxes .AND. constant_top_momentumflux ) THEN
+ k = nzt
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmzp = 0.25 * &
+ ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+ kmzm = 0.25 * &
+ ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
+
+ tend(k,j,i) = tend(k,j,i) &
+ & - ( kmzm * ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy &
+ & ) * ddzw(k) &
+ & + ( -vswst(j,i) &
+ & - kmzm * ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) &
+ & ) * ddzw(k)
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE diffusion_v
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE diffusion_v_ij( i, j, ddzu, ddzw, km, km_damp_x, tend, u, v, &
+ vsws, vswst, w )
+
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: kmxm_x, kmxm_y, kmxp_x, kmxp_y, kmzm, kmzp
+ REAL :: ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_x(nxl-1:nxr+1)
+ REAL :: tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+ REAL, DIMENSION(nzb:nzt+1) :: vsus
+ REAL, DIMENSION(:,:), POINTER :: vsws, vswst
+ REAL, DIMENSION(:,:,:), POINTER :: km, u, v, w
+
+!
+!-- Compute horizontal diffusion
+ DO k = nzb_v_outer(j,i)+1, nzt
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmxp_x = 0.25 * ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
+ kmxm_x = 0.25 * ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
+ kmxp_y = kmxp_x
+ kmxm_y = kmxm_x
+!
+!-- Increase diffusion at the outflow boundary in case of non-cyclic
+!-- lateral boundaries. Damping is only needed for velocity components
+!-- parallel to the outflow boundary in the direction normal to the
+!-- outflow boundary.
+ IF ( bc_lr /= 'cyclic' ) THEN
+ kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+ kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) &
+ & + ( kmxp_x * ( v(k,j,i+1) - v(k,j,i) ) * ddx &
+ & + kmxp_y * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy &
+ & - kmxm_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx &
+ & - kmxm_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy &
+ & ) * ddx &
+ & + 2.0 * ( &
+ & km(k,j,i) * ( v(k,j+1,i) - v(k,j,i) ) &
+ & - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) ) &
+ & ) * ddy2
+ ENDDO
+
+!
+!-- Wall functions at the left and right walls, respectively
+ IF ( wall_v(j,i) /= 0.0 ) THEN
+
+!
+!-- Calculate the horizontal momentum flux v'u'
+ CALL wall_fluxes( i, j, nzb_v_inner(j,i)+1, nzb_v_outer(j,i), &
+ vsus, 0.0, 1.0, 0.0, 0.0 )
+
+ DO k = nzb_v_inner(j,i)+1, nzb_v_outer(j,i)
+ kmxp_x = 0.25 * &
+ ( km(k,j,i)+km(k,j,i+1)+km(k,j-1,i)+km(k,j-1,i+1) )
+ kmxm_x = 0.25 * &
+ ( km(k,j,i)+km(k,j,i-1)+km(k,j-1,i)+km(k,j-1,i-1) )
+ kmxp_y = kmxp_x
+ kmxm_y = kmxm_x
+!
+!-- Increase diffusion at the outflow boundary in case of
+!-- non-cyclic lateral boundaries. Damping is only needed for
+!-- velocity components parallel to the outflow boundary in
+!-- the direction normal to the outflow boundary.
+ IF ( bc_lr /= 'cyclic' ) THEN
+ kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+ kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) &
+ + 2.0 * ( &
+ km(k,j,i) * ( v(k,j+1,i) - v(k,j,i) ) &
+ - km(k,j-1,i) * ( v(k,j,i) - v(k,j-1,i) ) &
+ ) * ddy2 &
+ + ( fxp(j,i) * ( &
+ kmxp_x * ( v(k,j,i+1) - v(k,j,i) ) * ddx &
+ + kmxp_y * ( u(k,j,i+1) - u(k,j-1,i+1) ) * ddy &
+ ) &
+ - fxm(j,i) * ( &
+ kmxm_x * ( v(k,j,i) - v(k,j,i-1) ) * ddx &
+ + kmxm_y * ( u(k,j,i) - u(k,j-1,i) ) * ddy &
+ ) &
+ + wall_v(j,i) * vsus(k) &
+ ) * ddx
+ ENDDO
+ ENDIF
+
+!
+!-- Compute vertical diffusion. In case of simulating a Prandtl layer,
+!-- index k starts at nzb_v_inner+2.
+ DO k = nzb_diff_v(j,i), nzt_diff
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmzp = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+ kmzm = 0.25 * ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
+
+ tend(k,j,i) = tend(k,j,i) &
+ & + ( kmzp * ( ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
+ & + ( w(k,j,i) - w(k,j-1,i) ) * ddy &
+ & ) &
+ & - kmzm * ( ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) &
+ & + ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy &
+ & ) &
+ & ) * ddzw(k)
+ ENDDO
+
+!
+!-- Vertical diffusion at the first grid point above the surface, if the
+!-- momentum flux at the bottom is given by the Prandtl law or if it is
+!-- prescribed by the user.
+!-- Difference quotient of the momentum flux is not formed over half of
+!-- the grid spacing (2.0*ddzw(k)) any more, since the comparison with
+!-- other (LES) modell showed that the values of the momentum flux becomes
+!-- too large in this case.
+!-- The term containing w(k-1,..) (see above equation) is removed here
+!-- because the vertical velocity is assumed to be zero at the surface.
+ IF ( use_surface_fluxes ) THEN
+ k = nzb_v_inner(j,i)+1
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmzp = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+ kmzm = 0.25 * ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
+
+ tend(k,j,i) = tend(k,j,i) &
+ & + ( kmzp * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
+ & ) * ddzw(k) &
+ & + ( kmzp * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
+ & + vsws(j,i) &
+ & ) * ddzw(k)
+ ENDIF
+
+!
+!-- Vertical diffusion at the first gridpoint below the top boundary,
+!-- if the momentum flux at the top is prescribed by the user
+ IF ( use_top_fluxes .AND. constant_top_momentumflux ) THEN
+ k = nzt
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmzp = 0.25 * &
+ ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+ kmzm = 0.25 * &
+ ( km(k,j,i)+km(k-1,j,i)+km(k,j-1,i)+km(k-1,j-1,i) )
+
+ tend(k,j,i) = tend(k,j,i) &
+ & - ( kmzm * ( w(k-1,j,i) - w(k-1,j-1,i) ) * ddy &
+ & ) * ddzw(k) &
+ & + ( -vswst(j,i) &
+ & - kmzm * ( v(k,j,i) - v(k-1,j,i) ) * ddzu(k) &
+ & ) * ddzw(k)
+ ENDIF
+
+ END SUBROUTINE diffusion_v_ij
+
+ END MODULE diffusion_v_mod
Index: /palm/tags/release-3.4a/SOURCE/diffusion_w.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/diffusion_w.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/diffusion_w.f90 (revision 141)
@@ -0,0 +1,334 @@
+ MODULE diffusion_w_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 75 2007-03-22 09:54:05Z raasch
+! Wall functions now include diabatic conditions, call of routine wall_fluxes,
+! z0 removed from argument list
+!
+! 20 2007-02-26 00:12:32Z raasch
+! Bugfix: ddzw dimensioned 1:nzt"+1"
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.12 2006/02/23 10:38:03 raasch
+! nzb_2d replaced by nzb_w_outer, wall functions added for all vertical walls,
+! +z0 in argument list
+! WARNING: loops containing the MAX function are still not properly vectorized!
+!
+! Revision 1.1 1997/09/12 06:24:11 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Diffusion term of the w-component
+!------------------------------------------------------------------------------!
+
+ USE wall_fluxes_mod
+
+ PRIVATE
+ PUBLIC diffusion_w
+
+ INTERFACE diffusion_w
+ MODULE PROCEDURE diffusion_w
+ MODULE PROCEDURE diffusion_w_ij
+ END INTERFACE diffusion_w
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE diffusion_w( ddzu, ddzw, km, km_damp_x, km_damp_y, tend, u, v, &
+ w )
+
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: kmxm_x, kmxm_z, kmxp_x, kmxp_z, kmym_y, kmym_z, kmyp_y, &
+ kmyp_z
+ REAL :: ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_x(nxl-1:nxr+1), &
+ km_damp_y(nys-1:nyn+1)
+ REAL :: tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+ REAL, DIMENSION(:,:,:), POINTER :: km, u, v, w
+ REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wsus, wsvs
+
+
+!
+!-- First calculate horizontal momentum flux w'u' and/or w'v' at vertical
+!-- walls, if neccessary
+ IF ( topography /= 'flat' ) THEN
+ CALL wall_fluxes( wsus, 0.0, 0.0, 0.0, 1.0, nzb_w_inner, &
+ nzb_w_outer, wall_w_x )
+ CALL wall_fluxes( wsvs, 0.0, 0.0, 1.0, 0.0, nzb_w_inner, &
+ nzb_w_outer, wall_w_y )
+ ENDIF
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_w_outer(j,i)+1, nzt-1
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmxp_x = 0.25 * &
+ ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
+ kmxm_x = 0.25 * &
+ ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
+ kmxp_z = kmxp_x
+ kmxm_z = kmxm_x
+ kmyp_y = 0.25 * &
+ ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
+ kmym_y = 0.25 * &
+ ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+ kmyp_z = kmyp_y
+ kmym_z = kmym_y
+!
+!-- Increase diffusion at the outflow boundary in case of
+!-- non-cyclic lateral boundaries. Damping is only needed for
+!-- velocity components parallel to the outflow boundary in
+!-- the direction normal to the outflow boundary.
+ IF ( bc_lr /= 'cyclic' ) THEN
+ kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+ kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+ ENDIF
+ IF ( bc_ns /= 'cyclic' ) THEN
+ kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+ kmym_y = MAX( kmym_y, km_damp_y(j) )
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) &
+ & + ( kmxp_x * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
+ & + kmxp_z * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
+ & - kmxm_x * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
+ & - kmxm_z * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
+ & ) * ddx &
+ & + ( kmyp_y * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
+ & + kmyp_z * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
+ & - kmym_y * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
+ & - kmym_z * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
+ & ) * ddy &
+ & + 2.0 * ( &
+ & km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
+ & - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
+ & ) * ddzu(k+1)
+ ENDDO
+
+!
+!-- Wall functions at all vertical walls, where necessary
+ IF ( wall_w_x(j,i) /= 0.0 .OR. wall_w_y(j,i) /= 0.0 ) THEN
+
+ DO k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmxp_x = 0.25 * &
+ ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
+ kmxm_x = 0.25 * &
+ ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
+ kmxp_z = kmxp_x
+ kmxm_z = kmxm_x
+ kmyp_y = 0.25 * &
+ ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
+ kmym_y = 0.25 * &
+ ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+ kmyp_z = kmyp_y
+ kmym_z = kmym_y
+!
+!-- Increase diffusion at the outflow boundary in case of
+!-- non-cyclic lateral boundaries. Damping is only needed for
+!-- velocity components parallel to the outflow boundary in
+!-- the direction normal to the outflow boundary.
+ IF ( bc_lr /= 'cyclic' ) THEN
+ kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+ kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+ ENDIF
+ IF ( bc_ns /= 'cyclic' ) THEN
+ kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+ kmym_y = MAX( kmym_y, km_damp_y(j) )
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) &
+ + ( fwxp(j,i) * ( &
+ kmxp_x * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
+ + kmxp_z * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
+ ) &
+ - fwxm(j,i) * ( &
+ kmxm_x * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
+ + kmxm_z * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
+ ) &
+ + wall_w_x(j,i) * wsus(k,j,i) &
+ ) * ddx &
+ + ( fwyp(j,i) * ( &
+ kmyp_y * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
+ + kmyp_z * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
+ ) &
+ - fwym(j,i) * ( &
+ kmym_y * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
+ + kmym_z * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
+ ) &
+ + wall_w_y(j,i) * wsvs(k,j,i) &
+ ) * ddy &
+ + 2.0 * ( &
+ km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
+ - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
+ ) * ddzu(k+1)
+ ENDDO
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE diffusion_w
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE diffusion_w_ij( i, j, ddzu, ddzw, km, km_damp_x, km_damp_y, &
+ tend, u, v, w )
+
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: kmxm_x, kmxm_z, kmxp_x, kmxp_z, kmym_y, kmym_z, kmyp_y, &
+ kmyp_z
+ REAL :: ddzu(1:nzt+1), ddzw(1:nzt+1), km_damp_x(nxl-1:nxr+1), &
+ km_damp_y(nys-1:nyn+1)
+ REAL :: tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+ REAL, DIMENSION(nzb:nzt+1) :: wsus, wsvs
+ REAL, DIMENSION(:,:,:), POINTER :: km, u, v, w
+
+
+ DO k = nzb_w_outer(j,i)+1, nzt-1
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmxp_x = 0.25 * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
+ kmxm_x = 0.25 * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
+ kmxp_z = kmxp_x
+ kmxm_z = kmxm_x
+ kmyp_y = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
+ kmym_y = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+ kmyp_z = kmyp_y
+ kmym_z = kmym_y
+!
+!-- Increase diffusion at the outflow boundary in case of non-cyclic
+!-- lateral boundaries. Damping is only needed for velocity components
+!-- parallel to the outflow boundary in the direction normal to the
+!-- outflow boundary.
+ IF ( bc_lr /= 'cyclic' ) THEN
+ kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+ kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+ ENDIF
+ IF ( bc_ns /= 'cyclic' ) THEN
+ kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+ kmym_y = MAX( kmym_y, km_damp_y(j) )
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) &
+ & + ( kmxp_x * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
+ & + kmxp_z * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
+ & - kmxm_x * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
+ & - kmxm_z * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
+ & ) * ddx &
+ & + ( kmyp_y * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
+ & + kmyp_z * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
+ & - kmym_y * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
+ & - kmym_z * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
+ & ) * ddy &
+ & + 2.0 * ( &
+ & km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
+ & - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
+ & ) * ddzu(k+1)
+ ENDDO
+
+!
+!-- Wall functions at all vertical walls, where necessary
+ IF ( wall_w_x(j,i) /= 0.0 .OR. wall_w_y(j,i) /= 0.0 ) THEN
+
+!
+!-- Calculate the horizontal momentum fluxes w'u' and/or w'v'
+ IF ( wall_w_x(j,i) /= 0.0 ) THEN
+ CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i), &
+ wsus, 0.0, 0.0, 0.0, 1.0 )
+ ELSE
+ wsus = 0.0
+ ENDIF
+
+ IF ( wall_w_y(j,i) /= 0.0 ) THEN
+ CALL wall_fluxes( i, j, nzb_w_inner(j,i)+1, nzb_w_outer(j,i), &
+ wsvs, 0.0, 0.0, 1.0, 0.0 )
+ ELSE
+ wsvs = 0.0
+ ENDIF
+
+ DO k = nzb_w_inner(j,i)+1, nzb_w_outer(j,i)
+!
+!-- Interpolate eddy diffusivities on staggered gridpoints
+ kmxp_x = 0.25 * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )
+ kmxm_x = 0.25 * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )
+ kmxp_z = kmxp_x
+ kmxm_z = kmxm_x
+ kmyp_y = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )
+ kmym_y = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )
+ kmyp_z = kmyp_y
+ kmym_z = kmym_y
+!
+!-- Increase diffusion at the outflow boundary in case of
+!-- non-cyclic lateral boundaries. Damping is only needed for
+!-- velocity components parallel to the outflow boundary in
+!-- the direction normal to the outflow boundary.
+ IF ( bc_lr /= 'cyclic' ) THEN
+ kmxp_x = MAX( kmxp_x, km_damp_x(i) )
+ kmxm_x = MAX( kmxm_x, km_damp_x(i) )
+ ENDIF
+ IF ( bc_ns /= 'cyclic' ) THEN
+ kmyp_y = MAX( kmyp_y, km_damp_y(j) )
+ kmym_y = MAX( kmym_y, km_damp_y(j) )
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) &
+ + ( fwxp(j,i) * ( &
+ kmxp_x * ( w(k,j,i+1) - w(k,j,i) ) * ddx &
+ + kmxp_z * ( u(k+1,j,i+1) - u(k,j,i+1) ) * ddzu(k+1) &
+ ) &
+ - fwxm(j,i) * ( &
+ kmxm_x * ( w(k,j,i) - w(k,j,i-1) ) * ddx &
+ + kmxm_z * ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
+ ) &
+ + wall_w_x(j,i) * wsus(k) &
+ ) * ddx &
+ + ( fwyp(j,i) * ( &
+ kmyp_y * ( w(k,j+1,i) - w(k,j,i) ) * ddy &
+ + kmyp_z * ( v(k+1,j+1,i) - v(k,j+1,i) ) * ddzu(k+1) &
+ ) &
+ - fwym(j,i) * ( &
+ kmym_y * ( w(k,j,i) - w(k,j-1,i) ) * ddy &
+ + kmym_z * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
+ ) &
+ + wall_w_y(j,i) * wsvs(k) &
+ ) * ddy &
+ + 2.0 * ( &
+ km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) &
+ - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) &
+ ) * ddzu(k+1)
+ ENDDO
+ ENDIF
+
+ END SUBROUTINE diffusion_w_ij
+
+ END MODULE diffusion_w_mod
Index: /palm/tags/release-3.4a/SOURCE/diffusivities.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/diffusivities.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/diffusivities.f90 (revision 141)
@@ -0,0 +1,199 @@
+ SUBROUTINE diffusivities( var, var_reference )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 137 2007-11-28 08:50:10Z letzel
+! Bugfix for summation of sums_l_l for flow_statistics
+! Vertical scalar profiles now based on nzb_s_inner and ngp_2dh_s_inner.
+!
+! 97 2007-06-21 08:23:15Z raasch
+! Adjustment of mixing length calculation for the ocean version.
+! This is also a bugfix, because the height above the topography is now
+! used instead of the height above level k=0.
+! theta renamed var, dpt_dz renamed dvar_dz, +new argument var_reference
+! use_pt_reference renamed use_reference
+!
+! 57 2007-03-09 12:05:41Z raasch
+! Reference temperature pt_reference can be used in buoyancy term
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.24 2006/04/26 12:16:26 raasch
+! OpenMP optimization (+sums_l_l_t), sqrt_e must be private
+!
+! Revision 1.1 1997/09/19 07:41:10 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Computation of the turbulent diffusion coefficients for momentum and heat
+! according to Prandtl-Kolmogorov
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE pegrid
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, omp_get_thread_num, sr, tn
+
+ REAL :: dvar_dz, l_stable, var_reference
+
+ REAL, SAVE :: phi_m = 1.0
+
+ REAL :: var(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+
+ REAL, DIMENSION(1:nzt) :: l, ll, sqrt_e
+
+
+!
+!-- Default thread number in case of one thread
+ tn = 0
+
+!
+!-- Initialization for calculation of the mixing length profile
+ sums_l_l = 0.0
+
+!
+!-- Compute the turbulent diffusion coefficient for momentum
+ !$OMP PARALLEL PRIVATE (dvar_dz,i,j,k,l,ll,l_stable,phi_m,sqrt_e,sr,tn)
+!$ tn = omp_get_thread_num()
+
+ !$OMP DO
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+
+!
+!-- Compute the Phi-function for a possible adaption of the mixing length
+!-- to the Prandtl mixing length
+ IF ( adjust_mixing_length .AND. prandtl_layer ) THEN
+ IF ( rif(j,i) >= 0.0 ) THEN
+ phi_m = 1.0 + 5.0 * rif(j,i)
+ ELSE
+ phi_m = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif(j,i) ) )
+ ENDIF
+ ENDIF
+
+!
+!-- Introduce an optional minimum tke
+ IF ( e_min > 0.0 ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ e(k,j,i) = MAX( e(k,j,i), e_min )
+ ENDDO
+ ENDIF
+
+!
+!-- Calculate square root of e in a seperate loop, because it is used
+!-- twice in the next loop (better vectorization)
+ DO k = nzb_s_inner(j,i)+1, nzt
+ sqrt_e(k) = SQRT( e(k,j,i) )
+ ENDDO
+
+!
+!-- Determine the mixing length
+ DO k = nzb_s_inner(j,i)+1, nzt
+ dvar_dz = atmos_ocean_sign * & ! inverse effect of pt/rho gradient
+ ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
+ IF ( dvar_dz > 0.0 ) THEN
+ IF ( use_reference ) THEN
+ l_stable = 0.76 * sqrt_e(k) / &
+ SQRT( g / var_reference * dvar_dz ) + 1E-5
+ ELSE
+ l_stable = 0.76 * sqrt_e(k) / &
+ SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5
+ ENDIF
+ ELSE
+ l_stable = l_grid(k)
+ ENDIF
+!
+!-- Adjustment of the mixing length
+ IF ( wall_adjustment ) THEN
+ l(k) = MIN( l_wall(k,j,i), l_grid(k), l_stable )
+ ll(k) = MIN( l_wall(k,j,i), l_grid(k) )
+ ELSE
+ l(k) = MIN( l_grid(k), l_stable )
+ ll(k) = l_grid(k)
+ ENDIF
+ IF ( adjust_mixing_length .AND. prandtl_layer ) THEN
+ l(k) = MIN( l(k), kappa * &
+ ( zu(k) - zw(nzb_s_inner(j,i)) ) / phi_m )
+ ll(k) = MIN( ll(k), kappa * &
+ ( zu(k) - zw(nzb_s_inner(j,i)) ) / phi_m )
+ ENDIF
+
+!
+!-- Compute diffusion coefficients for momentum and heat
+ km(k,j,i) = 0.1 * l(k) * sqrt_e(k)
+ kh(k,j,i) = ( 1.0 + 2.0 * l(k) / ll(k) ) * km(k,j,i)
+
+ ENDDO
+
+!
+!-- Summation for averaged profile (cf. flow_statistics)
+!-- (the IF statement still requires a performance check on NEC machines)
+ DO sr = 0, statistic_regions
+ IF ( rmask(j,i,sr) /= 0.0 .AND. &
+ i >= nxl .AND. i <= nxr .AND. j >= nys .AND. j <= nyn ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ sums_l_l(k,sr,tn) = sums_l_l(k,sr,tn) + l(k)
+ ENDDO
+ ENDIF
+ ENDDO
+
+ ENDDO
+ ENDDO
+
+ sums_l_l(nzt+1,:,tn) = sums_l_l(nzt,:,tn) ! quasi boundary-condition for
+ ! data output
+
+ !$OMP END PARALLEL
+
+!
+!-- Set vertical boundary values (Neumann conditions both at bottom and top).
+!-- Horizontal boundary conditions at vertical walls are not set because
+!-- so far vertical walls require usage of a Prandtl-layer where the boundary
+!-- values of the diffusivities are not needed
+ !$OMP PARALLEL DO
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ km(nzb_s_inner(j,i),j,i) = km(nzb_s_inner(j,i)+1,j,i)
+ km(nzt+1,j,i) = km(nzt,j,i)
+ kh(nzb_s_inner(j,i),j,i) = kh(nzb_s_inner(j,i)+1,j,i)
+ kh(nzt+1,j,i) = kh(nzt,j,i)
+ ENDDO
+ ENDDO
+
+!
+!-- Set Neumann boundary conditions at the outflow boundaries in case of
+!-- non-cyclic lateral boundaries
+ IF ( outflow_l ) THEN
+ km(:,:,nxl-1) = km(:,:,nxl)
+ kh(:,:,nxl-1) = kh(:,:,nxl)
+ ENDIF
+ IF ( outflow_r ) THEN
+ km(:,:,nxr+1) = km(:,:,nxr)
+ kh(:,:,nxr+1) = kh(:,:,nxr)
+ ENDIF
+ IF ( outflow_s ) THEN
+ km(:,nys-1,:) = km(:,nys,:)
+ kh(:,nys-1,:) = kh(:,nys,:)
+ ENDIF
+ IF ( outflow_n ) THEN
+ km(:,nyn+1,:) = km(:,nyn,:)
+ kh(:,nyn+1,:) = kh(:,nyn,:)
+ ENDIF
+
+
+ END SUBROUTINE diffusivities
Index: /palm/tags/release-3.4a/SOURCE/disturb_field.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/disturb_field.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/disturb_field.f90 (revision 141)
@@ -0,0 +1,167 @@
+ SUBROUTINE disturb_field( nzb_uv_inner, dist1, field )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 75 2007-03-22 09:54:05Z raasch
+! xrp, ynp eliminated, 2nd+3rd argument removed from exchange horiz
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.11 2006/08/04 14:31:59 raasch
+! izuf renamed iran
+!
+! Revision 1.1 1998/02/04 15:40:45 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Imposing a random perturbation on a 3D-array.
+! On parallel computers, the random number generator is as well called for all
+! gridpoints of the total domain to ensure, regardless of the number of PEs
+! used, that the elements of the array have the same values in the same
+! order in every case. The perturbation range is steered by dist_range.
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE random_function_mod
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ INTEGER :: nzb_uv_inner(nys-1:nyn+1,nxl-1:nxr+1)
+
+ REAL :: randomnumber, &
+ dist1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ field(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: dist2
+
+
+ CALL cpu_log( log_point(20), 'disturb_field', 'start' )
+
+!
+!-- Create an additional temporary array and initialize the arrays needed
+!-- to store the disturbance
+ ALLOCATE( dist2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ dist1 = 0.0
+ dist2 = 0.0
+
+!
+!-- Create the random perturbation and store it on temporary array
+ IF ( random_generator == 'numerical-recipes' ) THEN
+ DO i = dist_nxl(dist_range), dist_nxr(dist_range)
+ DO j = dist_nys(dist_range), dist_nyn(dist_range)
+ DO k = disturbance_level_ind_b, disturbance_level_ind_t
+ randomnumber = 3.0 * disturbance_amplitude * &
+ ( random_function( iran ) - 0.5 )
+ IF ( nxl <= i .AND. nxr >= i .AND. nys <= j .AND. &
+ nyn >= j ) &
+ THEN
+ dist1(k,j,i) = randomnumber
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSEIF ( random_generator == 'system-specific' ) THEN
+ DO i = dist_nxl(dist_range), dist_nxr(dist_range)
+ DO j = dist_nys(dist_range), dist_nyn(dist_range)
+ DO k = disturbance_level_ind_b, disturbance_level_ind_t
+#if defined( __nec )
+ randomnumber = 3.0 * disturbance_amplitude * &
+ ( RANDOM( 0 ) - 0.5 )
+#else
+ CALL RANDOM_NUMBER( randomnumber )
+ randomnumber = 3.0 * disturbance_amplitude * &
+ ( randomnumber - 0.5 )
+#endif
+ IF ( nxl <= i .AND. nxr >= i .AND. nys <= j .AND. nyn >= j ) &
+ THEN
+ dist1(k,j,i) = randomnumber
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+!
+!-- Exchange of ghost points for the random perturbation
+ CALL exchange_horiz( dist1 )
+
+!
+!-- Applying the Shuman filter in order to smooth the perturbations.
+!-- Neighboured grid points in all three directions are used for the
+!-- filter operation.
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = disturbance_level_ind_b-1, disturbance_level_ind_t+1
+ dist2(k,j,i) = ( dist1(k,j,i-1) + dist1(k,j,i+1) + dist1(k,j-1,i) &
+ + dist1(k,j+1,i) + dist1(k+1,j,i) + dist1(k-1,j,i) &
+ + 6.0 * dist1(k,j,i) &
+ ) / 12.0
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Exchange of ghost points for the filtered perturbation.
+!-- Afterwards, filter operation and exchange of ghost points are repeated.
+ CALL exchange_horiz( dist2 )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = disturbance_level_ind_b-2, disturbance_level_ind_t+2
+ dist1(k,j,i) = ( dist2(k,j,i-1) + dist2(k,j,i+1) + dist2(k,j-1,i) &
+ + dist2(k,j+1,i) + dist2(k+1,j,i) + dist2(k-1,j,i) &
+ + 6.0 * dist2(k,j,i) &
+ ) / 12.0
+ ENDDO
+ ENDDO
+ ENDDO
+ CALL exchange_horiz( dist1 )
+
+!
+!-- Remove perturbations below topography (including one gridpoint above it
+!-- in order to allow for larger timesteps at the beginning of the simulation
+!-- (diffusion criterion))
+ IF ( TRIM( topography ) /= 'flat' ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ dist1(nzb:nzb_uv_inner(j,i)+1,j,i) = 0.0
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Random perturbation is added to the array to be disturbed.
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = disturbance_level_ind_b-2, disturbance_level_ind_t+2
+ field(k,j,i) = field(k,j,i) + dist1(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Deallocate the temporary array
+ DEALLOCATE( dist2 )
+
+!
+!-- Set a flag, which indicates that a random perturbation is imposed
+ disturbance_created = .TRUE.
+
+
+ CALL cpu_log( log_point(20), 'disturb_field', 'stop' )
+
+
+ END SUBROUTINE disturb_field
Index: /palm/tags/release-3.4a/SOURCE/disturb_heatflux.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/disturb_heatflux.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/disturb_heatflux.f90 (revision 141)
@@ -0,0 +1,70 @@
+ SUBROUTINE disturb_heatflux
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.7 2006/08/04 14:35:07 raasch
+! Additional parameter in function random_gauss which limits the range of the
+! created random numbers, izuf renamed iran
+!
+! Revision 1.1 1998/03/25 20:03:47 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Generate random, normally distributed heatflux values and store them as the
+! near-surface heatflux.
+! On parallel computers, too, this random generator is called at all grid points
+! of the total array in order to guarantee the same random distribution of the
+! total array regardless of the number of processors used during the model run.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j
+ REAL :: random_gauss, randomnumber
+
+
+ CALL cpu_log( log_point(23), 'disturb_heatflux', 'start' )
+
+!
+!-- Generate random disturbances and store them
+ DO i = 0, nx
+ DO j = 0, ny
+ randomnumber = random_gauss( iran, 5.0 )
+ IF ( nxl <= i .AND. nxr >= i .AND. nys <= j .AND. nyn >= j ) &
+ THEN
+ IF ( nzb_s_inner(j,i) == 0 ) THEN
+ shf(j,i) = randomnumber * surface_heatflux
+!
+!-- Over topography surface_heatflux is replaced by wall_heatflux(0)
+ shf(j,i) = randomnumber * wall_heatflux(0)
+ ELSE
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+
+!
+!-- Exchange lateral boundary conditions for the heatflux array
+ CALL exchange_horiz_2d( shf )
+
+ CALL cpu_log( log_point(23), 'disturb_heatflux', 'stop' )
+
+
+ END SUBROUTINE disturb_heatflux
Index: /palm/tags/release-3.4a/SOURCE/eqn_state_seawater.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/eqn_state_seawater.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/eqn_state_seawater.f90 (revision 141)
@@ -0,0 +1,209 @@
+ MODULE eqn_state_seawater_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 97 2007-06-21 08:23:15Z raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Equation of state for seawater as a function of potential temperature,
+! salinity, and pressure.
+! For coefficients see Jackett et al., 2006: J. Atm. Ocean Tech.
+! eqn_state_seawater calculates the potential density referred at hyp(0).
+! eqn_state_seawater_func calculates density.
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ PRIVATE
+ PUBLIC eqn_state_seawater, eqn_state_seawater_func
+
+ REAL, DIMENSION(12), PARAMETER :: nom = &
+ (/ 9.9984085444849347D2, 7.3471625860981584D0, &
+ -5.3211231792841769D-2, 3.6492439109814549D-4, &
+ 2.5880571023991390D0, -6.7168282786692354D-3, &
+ 1.9203202055760151D-3, 1.1798263740430364D-2, &
+ 9.8920219266399117D-8, 4.6996642771754730D-6, &
+ -2.5862187075154352D-8, -3.2921414007960662D-12 /)
+
+ REAL, DIMENSION(13), PARAMETER :: den = &
+ (/ 1.0, 7.2815210113327091D-3, &
+ -4.4787265461983921D-5, 3.3851002965802430D-7, &
+ 1.3651202389758572D-10, 1.7632126669040377D-3, &
+ -8.8066583251206474D-6, -1.8832689434804897D-10, &
+ 5.7463776745432097D-6, 1.4716275472242334D-9, &
+ 6.7103246285651894D-6, -2.4461698007024582D-17, &
+ -9.1534417604289062D-18 /)
+
+ INTERFACE eqn_state_seawater
+ MODULE PROCEDURE eqn_state_seawater
+ MODULE PROCEDURE eqn_state_seawater_ij
+ END INTERFACE eqn_state_seawater
+
+ INTERFACE eqn_state_seawater_func
+ MODULE PROCEDURE eqn_state_seawater_func
+ END INTERFACE eqn_state_seawater_func
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE eqn_state_seawater
+
+ USE arrays_3d
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL :: p1, p2, p3, pt1, pt2, pt3, pt4, sa1, sa15, sa2
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+!
+!-- Pressure is needed in dbar
+ p1 = hyp(0) * 1E-4
+ p2 = p1 * p1
+ p3 = p2 * p1
+
+!
+!-- Temperature needed in degree Celsius
+ pt1 = pt_p(k,j,i) - 273.15
+ pt2 = pt1 * pt1
+ pt3 = pt1 * pt2
+ pt4 = pt2 * pt2
+
+ sa1 = sa_p(k,j,i)
+ sa15 = sa1 * SQRT( sa1 )
+ sa2 = sa1 * sa1
+
+ rho(k,j,i) = &
+ ( nom(1) + nom(2)*pt1 + nom(3)*pt2 + &
+ nom(4)*pt3 + nom(5)*sa1 + nom(6)*sa1*pt1 + &
+ nom(7)*sa2 + nom(8)*p1 + nom(9)*p1*pt2 + &
+ nom(10)*p1*sa1 + nom(11)*p2 + nom(12)*p2*pt2 &
+ ) / &
+ ( den(1) + den(2)*pt1 + den(3)*pt2 + &
+ den(4)*pt3 + den(5)*pt4 + den(6)*sa1 + &
+ den(7)*sa1*pt1 + den(8)*sa1*pt3 + den(9)*sa15 + &
+ den(10)*sa15*pt2 + den(11)*p1 + den(12)*p2*pt3 + &
+ den(13)*p3*pt1 &
+ )
+
+ ENDDO
+!
+!-- Neumann conditions are assumed at bottom and top boundary
+ rho(nzt+1,j,i) = rho(nzt,j,i)
+ rho(nzb_s_inner(j,i),j,i) = rho(nzb_s_inner(j,i)+1,j,i)
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE eqn_state_seawater
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE eqn_state_seawater_ij( i, j )
+
+ USE arrays_3d
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL :: p1, p2, p3, pt1, pt2, pt3, pt4, sa1, sa15, sa2
+
+ DO k = nzb_s_inner(j,i)+1, nzt
+!
+!-- Pressure is needed in dbar
+ p1 = hyp(0) * 1E-4
+ p2 = p1 * p1
+ p3 = p2 * p1
+
+!
+!-- Temperature needed in degree Celsius
+ pt1 = pt_p(k,j,i) - 273.15
+ pt2 = pt1 * pt1
+ pt3 = pt1 * pt2
+ pt4 = pt2 * pt2
+
+ sa1 = sa_p(k,j,i)
+ sa15 = sa1 * SQRT( sa1 )
+ sa2 = sa1 * sa1
+
+ rho(k,j,i) = ( nom(1) + nom(2)*pt1 + nom(3)*pt2 + &
+ nom(4)*pt3 + nom(5)*sa1 + nom(6)*sa1*pt1 + &
+ nom(7)*sa2 + nom(8)*p1 + nom(9)*p1*pt2 + &
+ nom(10)*p1*sa1 + nom(11)*p2 + nom(12)*p2*pt2 &
+ ) / &
+ ( den(1) + den(2)*pt1 + den(3)*pt2 + &
+ den(4)*pt3 + den(5)*pt4 + den(6)*sa1 + &
+ den(7)*sa1*pt1 + den(8)*sa1*pt3 + den(9)*sa15 + &
+ den(10)*sa15*pt2 + den(11)*p1 + den(12)*p2*pt3 + &
+ den(13)*p3*pt1 &
+ )
+ ENDDO
+!
+!-- Neumann conditions are assumed at bottom and top boundary
+ rho(nzt+1,j,i) = rho(nzt,j,i)
+ rho(nzb_s_inner(j,i),j,i) = rho(nzb_s_inner(j,i)+1,j,i)
+
+ END SUBROUTINE eqn_state_seawater_ij
+
+
+!------------------------------------------------------------------------------!
+! Equation of state as a function
+!------------------------------------------------------------------------------!
+ REAL FUNCTION eqn_state_seawater_func( p, pt, sa )
+
+ IMPLICIT NONE
+
+ REAL :: p, p1, p2, p3, pt, pt1, pt2, pt3, pt4, sa, sa15, sa2
+
+!
+!-- Pressure is needed in dbar
+ p1 = p * 1E-4
+ p2 = p1 * p1
+ p3 = p2 * p1
+
+!
+!-- Temperature needed in degree Celsius
+ pt1 = pt - 273.15
+ pt2 = pt1 * pt1
+ pt3 = pt1 * pt2
+ pt4 = pt2 * pt2
+
+ sa15 = sa * SQRT( sa )
+ sa2 = sa * sa
+
+
+ eqn_state_seawater_func = &
+ ( nom(1) + nom(2)*pt1 + nom(3)*pt2 + nom(4)*pt3 + &
+ nom(5)*sa + nom(6)*sa*pt1 + nom(7)*sa2 + nom(8)*p1 + &
+ nom(9)*p1*pt2 + nom(10)*p1*sa + nom(11)*p2 + nom(12)*p2*pt2 &
+ ) / &
+ ( den(1) + den(2)*pt1 + den(3)*pt2 + den(4)*pt3 + &
+ den(5)*pt4 + den(6)*sa + den(7)*sa*pt1 + den(8)*sa*pt3 + &
+ den(9)*sa15 + den(10)*sa15*pt2 + den(11)*p1 + den(12)*p2*pt3 + &
+ den(13)*p3*pt1 &
+ )
+
+
+ END FUNCTION eqn_state_seawater_func
+
+ END MODULE eqn_state_seawater_mod
Index: /palm/tags/release-3.4a/SOURCE/exchange_horiz.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/exchange_horiz.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/exchange_horiz.f90 (revision 141)
@@ -0,0 +1,133 @@
+ SUBROUTINE exchange_horiz( ar )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 75 2007-03-22 09:54:05Z raasch
+! Special cases for additional gridpoints along x or y in case of non-cyclic
+! boundary conditions are not regarded any more
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.16 2006/02/23 12:19:08 raasch
+! anz_yz renamed ngp_yz
+!
+! Revision 1.1 1997/07/24 11:13:29 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Exchange of lateral boundary values (parallel computers) and cyclic
+! lateral boundary conditions, respectively.
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+
+ IMPLICIT NONE
+
+#if defined( __parallel )
+ INTEGER, DIMENSION(4) :: req
+ INTEGER, DIMENSION(MPI_STATUS_SIZE,4) :: wait_stat
+#endif
+
+ REAL :: ar(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+
+
+ CALL cpu_log( log_point_s(2), 'exchange_horiz', 'start' )
+
+#if defined( __parallel )
+
+!
+!-- Exchange of lateral boundary values for parallel computers
+ IF ( pdims(1) == 1 .OR. mg_switch_to_pe0 ) THEN
+!
+!-- One-dimensional decomposition along y, boundary values can be exchanged
+!-- within the PE memory
+ IF ( bc_lr == 'cyclic' ) THEN
+ ar(:,nys:nyn,nxl-1) = ar(:,nys:nyn,nxr)
+ ar(:,nys:nyn,nxr+1) = ar(:,nys:nyn,nxl)
+ ENDIF
+
+ ELSE
+
+ req = 0
+!
+!-- Send left boundary, receive right one
+ CALL MPI_ISEND( &
+ ar(nzb,nys-1,nxl), ngp_yz(grid_level), MPI_REAL, pleft, 0, &
+ comm2d, req(1), ierr )
+ CALL MPI_IRECV( &
+ ar(nzb,nys-1,nxr+1), ngp_yz(grid_level), MPI_REAL, pright, 0, &
+ comm2d, req(2), ierr )
+!
+!-- Send right boundary, receive left one
+ CALL MPI_ISEND( &
+ ar(nzb,nys-1,nxr), ngp_yz(grid_level), MPI_REAL, pright, 1, &
+ comm2d, req(3), ierr )
+ CALL MPI_IRECV( &
+ ar(nzb,nys-1,nxl-1), ngp_yz(grid_level), MPI_REAL, pleft, 1, &
+ comm2d, req(4), ierr )
+ CALL MPI_WAITALL( 4, req, wait_stat, ierr )
+
+ ENDIF
+
+
+ IF ( pdims(2) == 1 .OR. mg_switch_to_pe0 ) THEN
+!
+!-- One-dimensional decomposition along x, boundary values can be exchanged
+!-- within the PE memory
+ IF ( bc_ns == 'cyclic' ) THEN
+ ar(:,nys-1,:) = ar(:,nyn,:)
+ ar(:,nyn+1,:) = ar(:,nys,:)
+ ENDIF
+
+ ELSE
+
+ req = 0
+!
+!-- Send front boundary, receive rear one
+ CALL MPI_ISEND( ar(nzb,nys,nxl-1), 1, type_xz(grid_level), psouth, 0, &
+ comm2d, req(1), ierr )
+ CALL MPI_IRECV( ar(nzb,nyn+1,nxl-1), 1, type_xz(grid_level), pnorth, 0, &
+ comm2d, req(2), ierr )
+!
+!-- Send rear boundary, receive front one
+ CALL MPI_ISEND( ar(nzb,nyn,nxl-1), 1, type_xz(grid_level), pnorth, 1, &
+ comm2d, req(3), ierr )
+ CALL MPI_IRECV( ar(nzb,nys-1,nxl-1), 1, type_xz(grid_level), psouth, 1, &
+ comm2d, req(4), ierr )
+ call MPI_WAITALL( 4, req, wait_stat, ierr )
+
+ ENDIF
+
+
+#else
+
+!
+!-- Lateral boundary conditions in the non-parallel case
+ IF ( bc_lr == 'cyclic' ) THEN
+ ar(:,nys:nyn,nxl-1) = ar(:,nys:nyn,nxr)
+ ar(:,nys:nyn,nxr+1) = ar(:,nys:nyn,nxl)
+ ENDIF
+
+ IF ( bc_ns == 'cyclic' ) THEN
+ ar(:,nys-1,:) = ar(:,nyn,:)
+ ar(:,nyn+1,:) = ar(:,nys,:)
+ ENDIF
+
+#endif
+
+ CALL cpu_log( log_point_s(2), 'exchange_horiz', 'stop' )
+
+ END SUBROUTINE exchange_horiz
Index: /palm/tags/release-3.4a/SOURCE/exchange_horiz_2d.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/exchange_horiz_2d.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/exchange_horiz_2d.f90 (revision 141)
@@ -0,0 +1,204 @@
+ SUBROUTINE exchange_horiz_2d( ar )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 73 2007-03-20 08:33:14Z raasch
+! Neumann boundary conditions at inflow/outflow in case of non-cyclic boundary
+! conditions
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.9 2006/05/12 19:15:52 letzel
+! MPI_REAL replaced by MPI_INTEGER in exchange_horiz_2d_int
+!
+! Revision 1.1 1998/01/23 09:58:21 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
+! boundary conditions, respectively, for 2D-arrays.
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+
+ IMPLICIT NONE
+
+ REAL :: ar(nys-1:nyn+1,nxl-1:nxr+1)
+
+
+ CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
+
+#if defined( __parallel )
+
+!
+!-- Exchange of lateral boundary values for parallel computers
+ IF ( pdims(1) == 1 ) THEN
+
+!
+!-- One-dimensional decomposition along y, boundary values can be exchanged
+!-- within the PE memory
+ ar(nys:nyn,nxl-1) = ar(nys:nyn,nxr)
+ ar(nys:nyn,nxr+1) = ar(nys:nyn,nxl)
+
+ ELSE
+!
+!-- Send left boundary, receive right one
+ CALL MPI_SENDRECV( ar(nys,nxl), ngp_y, MPI_REAL, pleft, 0, &
+ ar(nys,nxr+1), ngp_y, MPI_REAL, pright, 0, &
+ comm2d, status, ierr )
+!
+!-- Send right boundary, receive left one
+ CALL MPI_SENDRECV( ar(nys,nxr), ngp_y, MPI_REAL, pright, 1, &
+ ar(nys,nxl-1), ngp_y, MPI_REAL, pleft, 1, &
+ comm2d, status, ierr )
+ ENDIF
+
+ IF ( pdims(2) == 1 ) THEN
+!
+!-- One-dimensional decomposition along x, boundary values can be exchanged
+!-- within the PE memory
+ ar(nys-1,:) = ar(nyn,:)
+ ar(nyn+1,:) = ar(nys,:)
+
+ ELSE
+!
+!-- Send front boundary, receive rear one
+ CALL MPI_SENDRECV( ar(nys,nxl-1), 1, type_x, psouth, 0, &
+ ar(nyn+1,nxl-1), 1, type_x, pnorth, 0, &
+ comm2d, status, ierr )
+!
+!-- Send rear boundary, receive front one
+ CALL MPI_SENDRECV( ar(nyn,nxl-1), 1, type_x, pnorth, 1, &
+ ar(nys-1,nxl-1), 1, type_x, psouth, 1, &
+ comm2d, status, ierr )
+ ENDIF
+
+#else
+
+!
+!-- Lateral boundary conditions in the non-parallel case
+ IF ( bc_lr == 'cyclic' ) THEN
+ ar(nys:nyn,nxl-1) = ar(nys:nyn,nxr)
+ ar(nys:nyn,nxr+1) = ar(nys:nyn,nxl)
+ ENDIF
+
+ IF ( bc_ns == 'cyclic' ) THEN
+ ar(nys-1,:) = ar(nyn,:)
+ ar(nyn+1,:) = ar(nys,:)
+ ENDIF
+
+#endif
+
+!
+!-- Neumann-conditions at inflow/outflow in case of non-cyclic boundary
+!-- conditions
+ IF ( inflow_l .OR. outflow_l ) ar(:,nxl-1) = ar(:,nxl)
+ IF ( inflow_r .OR. outflow_r ) ar(:,nxr+1) = ar(:,nxr)
+ IF ( inflow_s .OR. outflow_s ) ar(nys-1,:) = ar(nys,:)
+ IF ( inflow_n .OR. outflow_n ) ar(nyn+1,:) = ar(nyn,:)
+
+ CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
+
+ END SUBROUTINE exchange_horiz_2d
+
+
+
+ SUBROUTINE exchange_horiz_2d_int( ar )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Exchange of lateral (ghost) boundaries (parallel computers) and cyclic
+! boundary conditions, respectively, for 2D integer arrays.
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: ar(nys-1:nyn+1,nxl-1:nxr+1)
+
+
+ CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' )
+
+#if defined( __parallel )
+
+!
+!-- Exchange of lateral boundary values for parallel computers
+ IF ( pdims(1) == 1 ) THEN
+
+!
+!-- One-dimensional decomposition along y, boundary values can be exchanged
+!-- within the PE memory
+ ar(nys:nyn,nxl-1) = ar(nys:nyn,nxr)
+ ar(nys:nyn,nxr+1) = ar(nys:nyn,nxl)
+
+ ELSE
+!
+!-- Send left boundary, receive right one
+ CALL MPI_SENDRECV( ar(nys,nxl), ngp_y, MPI_INTEGER, pleft, 0, &
+ ar(nys,nxr+1), ngp_y, MPI_INTEGER, pright, 0, &
+ comm2d, status, ierr )
+!
+!-- Send right boundary, receive left one
+ CALL MPI_SENDRECV( ar(nys,nxr), ngp_y, MPI_INTEGER, pright, 1, &
+ ar(nys,nxl-1), ngp_y, MPI_INTEGER, pleft, 1, &
+ comm2d, status, ierr )
+ ENDIF
+
+ IF ( pdims(2) == 1 ) THEN
+!
+!-- One-dimensional decomposition along x, boundary values can be exchanged
+!-- within the PE memory
+ ar(nys-1,:) = ar(nyn,:)
+ ar(nyn+1,:) = ar(nys,:)
+
+ ELSE
+!
+!-- Send front boundary, receive rear one
+ CALL MPI_SENDRECV( ar(nys,nxl-1), 1, type_x_int, psouth, 0, &
+ ar(nyn+1,nxl-1), 1, type_x_int, pnorth, 0, &
+ comm2d, status, ierr )
+!
+!-- Send rear boundary, receive front one
+ CALL MPI_SENDRECV( ar(nyn,nxl-1), 1, type_x_int, pnorth, 1, &
+ ar(nys-1,nxl-1), 1, type_x_int, psouth, 1, &
+ comm2d, status, ierr )
+ ENDIF
+
+#else
+
+!
+!-- Lateral boundary conditions in the non-parallel case
+ IF ( bc_lr == 'cyclic' ) THEN
+ ar(nys:nyn,nxl-1) = ar(nys:nyn,nxr)
+ ar(nys:nyn,nxr+1) = ar(nys:nyn,nxl)
+ ENDIF
+
+ IF ( bc_ns == 'cyclic' ) THEN
+ ar(nys-1,:) = ar(nyn,:)
+ ar(nyn+1,:) = ar(nys,:)
+ ENDIF
+
+#endif
+
+ CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
+
+ END SUBROUTINE exchange_horiz_2d_int
Index: /palm/tags/release-3.4a/SOURCE/fft_xy.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/fft_xy.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/fft_xy.f90 (revision 141)
@@ -0,0 +1,822 @@
+ MODULE fft_xy
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.4 2006/03/28 12:27:09 raasch
+! Stop when system-specific fft is selected on NEC. For unknown reasons this
+! causes a program abort during first allocation in init_grid.
+!
+! Revision 1.2 2004/04/30 11:44:27 raasch
+! Module renamed from fft_for_1d_decomp to fft_xy, 1d-routines renamed to
+! fft_x and fft_y,
+! function FFT replaced by subroutine FFTN due to problems with 64-bit
+! mode on ibm,
+! shape of array cwork is explicitly stored in ishape/jshape and handled
+! to routine FFTN instead of shape-function (due to compiler error on
+! decalpha),
+! non vectorized FFT for nec included
+!
+! Revision 1.1 2002/06/11 13:00:49 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Fast Fourier transformation along x and y for 1d domain decomposition along x.
+! Original version: Klaus Ketelsen (May 2002)
+!------------------------------------------------------------------------------!
+
+ USE array_kind
+ USE control_parameters
+ USE indices
+ USE singleton
+ USE temperton_fft
+
+ IMPLICIT NONE
+
+ PRIVATE
+ PUBLIC fft_x, fft_y, fft_init, fft_x_m, fft_y_m
+
+ INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: ifax_x, ifax_y
+
+ LOGICAL, SAVE :: init_fft = .FALSE.
+
+ REAL, SAVE :: sqr_nx, sqr_ny
+ REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trigs_x, trigs_y
+
+#if defined( __ibm )
+ INTEGER, PARAMETER :: nau1 = 20000, nau2 = 22000
+!
+!-- The following working arrays contain tables and have to be "save" and
+!-- shared in OpenMP sense
+ REAL, DIMENSION(nau1), SAVE :: aux1, auy1, aux3, auy3
+#elif defined( __nec )
+ INTEGER, SAVE :: nz1
+ REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trig_xb, trig_xf, trig_yb, &
+ trig_yf
+#endif
+
+!
+!-- Public interfaces
+ INTERFACE fft_init
+ MODULE PROCEDURE fft_init
+ END INTERFACE fft_init
+
+ INTERFACE fft_x
+ MODULE PROCEDURE fft_x
+ END INTERFACE fft_x
+
+ INTERFACE fft_y
+ MODULE PROCEDURE fft_y
+ END INTERFACE fft_y
+
+ INTERFACE fft_x_m
+ MODULE PROCEDURE fft_x_m
+ END INTERFACE fft_x_m
+
+ INTERFACE fft_y_m
+ MODULE PROCEDURE fft_y_m
+ END INTERFACE fft_y_m
+
+ CONTAINS
+
+
+ SUBROUTINE fft_init
+
+ IMPLICIT NONE
+
+!
+!-- The following temporary working arrays have to be on stack or private
+!-- in OpenMP sense
+#if defined( __ibm )
+ REAL, DIMENSION(0:nx+2) :: workx
+ REAL, DIMENSION(0:ny+2) :: worky
+ REAL, DIMENSION(nau2) :: aux2, auy2, aux4, auy4
+#elif defined( __nec )
+ REAL, DIMENSION(0:nx+3,nz+1) :: work_x
+ REAL, DIMENSION(0:ny+3,nz+1) :: work_y
+ REAL, DIMENSION(6*(nx+3),nz+1) :: workx
+ REAL, DIMENSION(6*(ny+3),nz+1) :: worky
+#endif
+
+!
+!-- Return, if already called
+ IF ( init_fft ) THEN
+ RETURN
+ ELSE
+ init_fft = .TRUE.
+ ENDIF
+
+ IF ( fft_method == 'system-specific' ) THEN
+
+ sqr_nx = SQRT( 1.0 / ( nx + 1.0 ) )
+ sqr_ny = SQRT( 1.0 / ( ny + 1.0 ) )
+#if defined( __ibm ) && ! defined( __ibmy_special )
+!
+!-- Initialize tables for fft along x
+ CALL DRCFT( 1, workx, 1, workx, 1, nx+1, 1, 1, sqr_nx, aux1, nau1, &
+ aux2, nau2 )
+ CALL DCRFT( 1, workx, 1, workx, 1, nx+1, 1, -1, sqr_nx, aux3, nau1, &
+ aux4, nau2 )
+!
+!-- Initialize tables for fft along y
+ CALL DRCFT( 1, worky, 1, worky, 1, ny+1, 1, 1, sqr_ny, auy1, nau1, &
+ auy2, nau2 )
+ CALL DCRFT( 1, worky, 1, worky, 1, ny+1, 1, -1, sqr_ny, auy3, nau1, &
+ auy4, nau2 )
+#elif defined( __nec )
+ PRINT*, '+++ fft_init: fft method "', fft_method, &
+ '" currently does not work on NEC'
+ CALL local_stop
+
+ ALLOCATE( trig_xb(2*(nx+1)), trig_xf(2*(nx+1)), &
+ trig_yb(2*(ny+1)), trig_yf(2*(ny+1)) )
+
+ work_x = 0.0
+ work_y = 0.0
+ nz1 = nz + MOD( nz+1, 2 ) ! odd nz slows down fft significantly
+ ! when using the NEC ffts
+
+!
+!-- Initialize tables for fft along x (non-vector and vector case (M))
+ CALL DZFFT( 0, nx+1, sqr_nx, work_x, work_x, trig_xf, workx, 0 )
+ CALL ZDFFT( 0, nx+1, sqr_nx, work_x, work_x, trig_xb, workx, 0 )
+ CALL DZFFTM( 0, nx+1, nz1, sqr_nx, work_x, nx+4, work_x, nx+4, &
+ trig_xf, workx, 0 )
+ CALL ZDFFTM( 0, nx+1, nz1, sqr_nx, work_x, nx+4, work_x, nx+4, &
+ trig_xb, workx, 0 )
+!
+!-- Initialize tables for fft along y (non-vector and vector case (M))
+ CALL DZFFT( 0, ny+1, sqr_ny, work_y, work_y, trig_yf, worky, 0 )
+ CALL ZDFFT( 0, ny+1, sqr_ny, work_y, work_y, trig_yb, worky, 0 )
+ CALL DZFFTM( 0, ny+1, nz1, sqr_ny, work_y, ny+4, work_y, ny+4, &
+ trig_yf, worky, 0 )
+ CALL ZDFFTM( 0, ny+1, nz1, sqr_ny, work_y, ny+4, work_y, ny+4, &
+ trig_yb, worky, 0 )
+#else
+ PRINT*, '+++ fft_init: no system-specific fft-call available'
+ CALL local_stop
+#endif
+ ELSEIF ( fft_method == 'temperton-algorithm' ) THEN
+!
+!-- Temperton-algorithm
+!-- Initialize tables for fft along x and y
+ ALLOCATE( ifax_x(nx+1), ifax_y(ny+1), trigs_x(nx+1), trigs_y(ny+1) )
+
+ CALL set99( trigs_x, ifax_x, nx+1 )
+ CALL set99( trigs_y, ifax_y, ny+1 )
+
+ ELSEIF ( fft_method == 'singleton-algorithm' ) THEN
+
+ CONTINUE
+
+ ELSE
+
+ PRINT*, '+++ fft_init: fft method "', fft_method, &
+ '" not available'
+ CALL local_stop
+
+ ENDIF
+
+ END SUBROUTINE fft_init
+
+
+ SUBROUTINE fft_x( ar, direction )
+
+!----------------------------------------------------------------------!
+! fft_x !
+! !
+! Fourier-transformation along x-direction !
+! !
+! fft_x uses internal algorithms (Singleton or Temperton) or !
+! system-specific routines, if they are available !
+!----------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: direction
+ INTEGER :: i, ishape(1)
+
+!kk REAL, DIMENSION(:) :: ar !kk Does NOT work (Bug??)
+ REAL, DIMENSION(0:nx) :: ar
+ REAL, DIMENSION(0:nx+2) :: work
+ REAL, DIMENSION(nx+2) :: work1
+ COMPLEX, DIMENSION(:), ALLOCATABLE :: cwork
+#if defined( __ibm )
+ REAL, DIMENSION(nau2) :: aux2, aux4
+#elif defined( __nec )
+ REAL, DIMENSION(6*(nx+1)) :: work2
+#endif
+
+ IF ( fft_method == 'singleton-algorithm' ) THEN
+
+!
+!-- Performing the fft with singleton's software works on every system,
+!-- since it is part of the model
+ ALLOCATE( cwork(0:nx) )
+
+ IF ( direction == 'forward') then
+
+ DO i = 0, nx
+ cwork(i) = CMPLX( ar(i) )
+ ENDDO
+ ishape = SHAPE( cwork )
+ CALL FFTN( cwork, ishape )
+
+ DO i = 0, (nx+1)/2
+ ar(i) = REAL( cwork(i) )
+ ENDDO
+ DO i = 1, (nx+1)/2 - 1
+ ar(nx+1-i) = -AIMAG( cwork(i) )
+ ENDDO
+
+ ELSE
+
+ cwork(0) = CMPLX( ar(0), 0.0 )
+ DO i = 1, (nx+1)/2 - 1
+ cwork(i) = CMPLX( ar(i), -ar(nx+1-i) )
+ cwork(nx+1-i) = CMPLX( ar(i), ar(nx+1-i) )
+ ENDDO
+ cwork((nx+1)/2) = CMPLX( ar((nx+1)/2), 0.0 )
+
+ ishape = SHAPE( cwork )
+ CALL FFTN( cwork, ishape, inv = .TRUE. )
+
+ DO i = 0, nx
+ ar(i) = REAL( cwork(i) )
+ ENDDO
+
+ ENDIF
+
+ DEALLOCATE( cwork )
+
+ ELSEIF ( fft_method == 'temperton-algorithm' ) THEN
+
+!
+!-- Performing the fft with Temperton's software works on every system,
+!-- since it is part of the model
+ IF ( direction == 'forward' ) THEN
+
+ work(0:nx) = ar
+ CALL fft991cy( work, work1, trigs_x, ifax_x, 1, nx+1, nx+1, 1, -1 )
+
+ DO i = 0, (nx+1)/2
+ ar(i) = work(2*i)
+ ENDDO
+ DO i = 1, (nx+1)/2 - 1
+ ar(nx+1-i) = work(2*i+1)
+ ENDDO
+
+ ELSE
+
+ DO i = 0, (nx+1)/2
+ work(2*i) = ar(i)
+ ENDDO
+ DO i = 1, (nx+1)/2 - 1
+ work(2*i+1) = ar(nx+1-i)
+ ENDDO
+ work(1) = 0.0
+ work(nx+2) = 0.0
+
+ CALL fft991cy( work, work1, trigs_x, ifax_x, 1, nx+1, nx+1, 1, 1 )
+ ar = work(0:nx)
+
+ ENDIF
+
+ ELSEIF ( fft_method == 'system-specific' ) THEN
+
+#if defined( __ibm ) && ! defined( __ibmy_special )
+ IF ( direction == 'forward' ) THEN
+
+ CALL DRCFT( 0, ar, 1, work, 1, nx+1, 1, 1, sqr_nx, aux1, nau1, &
+ aux2, nau2 )
+
+ DO i = 0, (nx+1)/2
+ ar(i) = work(2*i)
+ ENDDO
+ DO i = 1, (nx+1)/2 - 1
+ ar(nx+1-i) = work(2*i+1)
+ ENDDO
+
+ ELSE
+
+ DO i = 0, (nx+1)/2
+ work(2*i) = ar(i)
+ ENDDO
+ DO i = 1, (nx+1)/2 - 1
+ work(2*i+1) = ar(nx+1-i)
+ ENDDO
+ work(1) = 0.0
+ work(nx+2) = 0.0
+
+ CALL DCRFT( 0, work, 1, work, 1, nx+1, 1, -1, sqr_nx, aux3, nau1, &
+ aux4, nau2 )
+
+ DO i = 0, nx
+ ar(i) = work(i)
+ ENDDO
+
+ ENDIF
+#elif defined( __nec )
+ IF ( direction == 'forward' ) THEN
+
+ work(0:nx) = ar(0:nx)
+
+ CALL DZFFT( 1, nx+1, sqr_nx, work, work, trig_xf, work2, 0 )
+
+ DO i = 0, (nx+1)/2
+ ar(i) = work(2*i)
+ ENDDO
+ DO i = 1, (nx+1)/2 - 1
+ ar(nx+1-i) = work(2*i+1)
+ ENDDO
+
+ ELSE
+
+ DO i = 0, (nx+1)/2
+ work(2*i) = ar(i)
+ ENDDO
+ DO i = 1, (nx+1)/2 - 1
+ work(2*i+1) = ar(nx+1-i)
+ ENDDO
+ work(1) = 0.0
+ work(nx+2) = 0.0
+
+ CALL ZDFFT( -1, nx+1, sqr_nx, work, work, trig_xb, work2, 0 )
+
+ ar(0:nx) = work(0:nx)
+
+ ENDIF
+#else
+ PRINT*, '+++ fft_x: no system-specific fft-call available'
+ CALL local_stop
+#endif
+ ELSE
+
+ PRINT*, '+++ fft_x: fft method "', fft_method, '" not available'
+ CALL local_stop
+
+ ENDIF
+
+ END SUBROUTINE fft_x
+
+ SUBROUTINE fft_y( ar, direction )
+
+!----------------------------------------------------------------------!
+! fft_y !
+! !
+! Fourier-transformation along y-direction !
+! !
+! fft_y uses internal algorithms (Singleton or Temperton) or !
+! system-specific routines, if they are available !
+!----------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: direction
+ INTEGER :: j, jshape(1)
+
+!kk REAL, DIMENSION(:) :: ar !kk Does NOT work (Bug??)
+ REAL, DIMENSION(0:ny) :: ar
+ REAL, DIMENSION(0:ny+2) :: work
+ REAL, DIMENSION(ny+2) :: work1
+ COMPLEX, DIMENSION(:), ALLOCATABLE :: cwork
+#if defined( __ibm )
+ REAL, DIMENSION(nau2) :: auy2, auy4
+#elif defined( __nec )
+ REAL, DIMENSION(6*(ny+1)) :: work2
+#endif
+
+ IF ( fft_method == 'singleton-algorithm' ) THEN
+
+!
+!-- Performing the fft with singleton's software works on every system,
+!-- since it is part of the model
+ ALLOCATE( cwork(0:ny) )
+
+ IF ( direction == 'forward') THEN
+
+ DO j = 0, ny
+ cwork(j) = CMPLX( ar(j) )
+ ENDDO
+
+ jshape = SHAPE( cwork )
+ CALL FFTN( cwork, jshape )
+
+ DO j = 0, (ny+1)/2
+ ar(j) = REAL( cwork(j) )
+ ENDDO
+ DO j = 1, (ny+1)/2 - 1
+ ar(ny+1-j) = -AIMAG( cwork(j) )
+ ENDDO
+
+ ELSE
+
+ cwork(0) = CMPLX( ar(0), 0.0 )
+ DO j = 1, (ny+1)/2 - 1
+ cwork(j) = CMPLX( ar(j), -ar(ny+1-j) )
+ cwork(ny+1-j) = CMPLX( ar(j), ar(ny+1-j) )
+ ENDDO
+ cwork((ny+1)/2) = CMPLX( ar((ny+1)/2), 0.0 )
+
+ jshape = SHAPE( cwork )
+ CALL FFTN( cwork, jshape, inv = .TRUE. )
+
+ DO j = 0, ny
+ ar(j) = REAL( cwork(j) )
+ ENDDO
+
+ ENDIF
+
+ DEALLOCATE( cwork )
+
+ ELSEIF ( fft_method == 'temperton-algorithm' ) THEN
+
+!
+!-- Performing the fft with Temperton's software works on every system,
+!-- since it is part of the model
+ IF ( direction == 'forward' ) THEN
+
+ work(0:ny) = ar
+ CALL fft991cy( work, work1, trigs_y, ifax_y, 1, ny+1, ny+1, 1, -1 )
+
+ DO j = 0, (ny+1)/2
+ ar(j) = work(2*j)
+ ENDDO
+ DO j = 1, (ny+1)/2 - 1
+ ar(ny+1-j) = work(2*j+1)
+ ENDDO
+
+ ELSE
+
+ DO j = 0, (ny+1)/2
+ work(2*j) = ar(j)
+ ENDDO
+ DO j = 1, (ny+1)/2 - 1
+ work(2*j+1) = ar(ny+1-j)
+ ENDDO
+ work(1) = 0.0
+ work(ny+2) = 0.0
+
+ CALL fft991cy( work, work1, trigs_y, ifax_y, 1, ny+1, ny+1, 1, 1 )
+ ar = work(0:ny)
+
+ ENDIF
+
+ ELSEIF ( fft_method == 'system-specific' ) THEN
+
+#if defined( __ibm ) && ! defined( __ibmy_special )
+ IF ( direction == 'forward') THEN
+
+ CALL DRCFT( 0, ar, 1, work, 1, ny+1, 1, 1, sqr_ny, auy1, nau1, &
+ auy2, nau2 )
+
+ DO j = 0, (ny+1)/2
+ ar(j) = work(2*j)
+ ENDDO
+ DO j = 1, (ny+1)/2 - 1
+ ar(ny+1-j) = work(2*j+1)
+ ENDDO
+
+ ELSE
+
+ DO j = 0, (ny+1)/2
+ work(2*j) = ar(j)
+ ENDDO
+ DO j = 1, (ny+1)/2 - 1
+ work(2*j+1) = ar(ny+1-j)
+ ENDDO
+ work(1) = 0.0
+ work(ny+2) = 0.0
+
+ CALL DCRFT( 0, work, 1, work, 1, ny+1, 1, -1, sqr_ny, auy3, nau1, &
+ auy4, nau2 )
+
+ DO j = 0, ny
+ ar(j) = work(j)
+ ENDDO
+
+ ENDIF
+#elif defined( __nec )
+ IF ( direction == 'forward' ) THEN
+
+ work(0:ny) = ar(0:ny)
+
+ CALL DZFFT( 1, ny+1, sqr_ny, work, work, trig_yf, work2, 0 )
+
+ DO j = 0, (ny+1)/2
+ ar(j) = work(2*j)
+ ENDDO
+ DO j = 1, (ny+1)/2 - 1
+ ar(ny+1-j) = work(2*j+1)
+ ENDDO
+
+ ELSE
+
+ DO j = 0, (ny+1)/2
+ work(2*j) = ar(j)
+ ENDDO
+ DO j = 1, (ny+1)/2 - 1
+ work(2*j+1) = ar(ny+1-j)
+ ENDDO
+ work(1) = 0.0
+ work(ny+2) = 0.0
+
+ CALL ZDFFT( -1, ny+1, sqr_ny, work, work, trig_yb, work2, 0 )
+
+ ar(0:ny) = work(0:ny)
+
+ ENDIF
+#else
+ PRINT*, '+++ fft_y: no system-specific fft-call available'
+ CALL local_stop
+#endif
+
+ ELSE
+
+ PRINT*, '+++ fft_y: fft method "', fft_method, '" not available'
+ CALL local_stop
+
+ ENDIF
+
+ END SUBROUTINE fft_y
+
+ SUBROUTINE fft_x_m( ar, direction )
+
+!----------------------------------------------------------------------!
+! fft_x_m !
+! !
+! Fourier-transformation along x-direction !
+! Version for 1d domain decomposition !
+! using multiple 1D FFT from Math Keisan on NEC !
+! or Temperton-algorithm !
+! (no singleton-algorithm on NEC because it does not vectorize) !
+! !
+!----------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: direction
+ INTEGER :: i, k, siza, sizw
+
+ REAL, DIMENSION(0:nx,nz) :: ar
+ REAL, DIMENSION(0:nx+3,nz+1) :: ai
+ REAL, DIMENSION(6*(nx+4),nz+1) :: work1
+#if defined( __nec )
+ COMPLEX, DIMENSION((nx+4)/2+1,nz+1) :: work
+#endif
+
+ IF ( fft_method == 'temperton-algorithm' ) THEN
+
+ siza = SIZE( ai, 1 )
+
+ IF ( direction == 'forward') THEN
+
+ ai(0:nx,1:nz) = ar(0:nx,1:nz)
+ ai(nx+1:,:) = 0.0
+
+ CALL fft991cy( ai, work1, trigs_x, ifax_x, 1, siza, nx+1, nz, -1 )
+
+ DO k = 1, nz
+ DO i = 0, (nx+1)/2
+ ar(i,k) = ai(2*i,k)
+ ENDDO
+ DO i = 1, (nx+1)/2 - 1
+ ar(nx+1-i,k) = ai(2*i+1,k)
+ ENDDO
+ ENDDO
+
+ ELSE
+
+ DO k = 1, nz
+ DO i = 0, (nx+1)/2
+ ai(2*i,k) = ar(i,k)
+ ENDDO
+ DO i = 1, (nx+1)/2 - 1
+ ai(2*i+1,k) = ar(nx+1-i,k)
+ ENDDO
+ ai(1,k) = 0.0
+ ai(nx+2,k) = 0.0
+ ENDDO
+
+ CALL fft991cy( ai, work1, trigs_x, ifax_x, 1, siza, nx+1, nz, 1 )
+
+ ar(0:nx,1:nz) = ai(0:nx,1:nz)
+
+ ENDIF
+
+ ELSEIF ( fft_method == 'system-specific' ) THEN
+
+#if defined( __nec )
+ siza = SIZE( ai, 1 )
+ sizw = SIZE( work, 1 )
+
+ IF ( direction == 'forward') THEN
+
+!
+!-- Tables are initialized once more. This call should not be
+!-- necessary, but otherwise program aborts in asymmetric case
+ CALL DZFFTM( 0, nx+1, nz1, sqr_nx, work, nx+4, work, nx+4, &
+ trig_xf, work1, 0 )
+
+ ai(0:nx,1:nz) = ar(0:nx,1:nz)
+ IF ( nz1 > nz ) THEN
+ ai(:,nz1) = 0.0
+ ENDIF
+
+ CALL DZFFTM( 1, nx+1, nz1, sqr_nx, ai, siza, work, sizw, &
+ trig_xf, work1, 0 )
+
+ DO k = 1, nz
+ DO i = 0, (nx+1)/2
+ ar(i,k) = REAL( work(i+1,k) )
+ ENDDO
+ DO i = 1, (nx+1)/2 - 1
+ ar(nx+1-i,k) = AIMAG( work(i+1,k) )
+ ENDDO
+ ENDDO
+
+ ELSE
+
+!
+!-- Tables are initialized once more. This call should not be
+!-- necessary, but otherwise program aborts in asymmetric case
+ CALL ZDFFTM( 0, nx+1, nz1, sqr_nx, work, nx+4, work, nx+4, &
+ trig_xb, work1, 0 )
+
+ IF ( nz1 > nz ) THEN
+ work(:,nz1) = 0.0
+ ENDIF
+ DO k = 1, nz
+ work(1,k) = CMPLX( ar(0,k), 0.0 )
+ DO i = 1, (nx+1)/2 - 1
+ work(i+1,k) = CMPLX( ar(i,k), ar(nx+1-i,k) )
+ ENDDO
+ work(((nx+1)/2)+1,k) = CMPLX( ar((nx+1)/2,k), 0.0 )
+ ENDDO
+
+ CALL ZDFFTM( -1, nx+1, nz1, sqr_nx, work, sizw, ai, siza, &
+ trig_xb, work1, 0 )
+
+ ar(0:nx,1:nz) = ai(0:nx,1:nz)
+
+ ENDIF
+
+#else
+ PRINT*, '+++ fft_x_m: no system-specific fft-call available'
+ STOP
+#endif
+
+ ELSE
+
+ PRINT*, '+++ fft_x_m: fft method "', fft_method, '" not available'
+ CALL local_stop
+
+ ENDIF
+
+ END SUBROUTINE fft_x_m
+
+ SUBROUTINE fft_y_m( ar, ny1, direction )
+
+!----------------------------------------------------------------------!
+! fft_y_m !
+! !
+! Fourier-transformation along y-direction !
+! Version for 1d domain decomposition !
+! using multiple 1D FFT from Math Keisan on NEC !
+! or Temperton-algorithm !
+! (no singleton-algorithm on NEC because it does not vectorize) !
+! !
+!----------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: direction
+ INTEGER :: j, k, ny1, siza, sizw
+
+ REAL, DIMENSION(0:ny1,nz) :: ar
+ REAL, DIMENSION(0:ny+3,nz+1) :: ai
+ REAL, DIMENSION(6*(ny+4),nz+1) :: work1
+#if defined( __nec )
+ COMPLEX, DIMENSION((ny+4)/2+1,nz+1) :: work
+#endif
+
+ IF ( fft_method == 'temperton-algorithm' ) THEN
+
+ siza = SIZE( ai, 1 )
+
+ IF ( direction == 'forward') THEN
+
+ ai(0:ny,1:nz) = ar(0:ny,1:nz)
+ ai(ny+1:,:) = 0.0
+
+ CALL fft991cy( ai, work1, trigs_y, ifax_y, 1, siza, ny+1, nz, -1 )
+
+ DO k = 1, nz
+ DO j = 0, (ny+1)/2
+ ar(j,k) = ai(2*j,k)
+ ENDDO
+ DO j = 1, (ny+1)/2 - 1
+ ar(ny+1-j,k) = ai(2*j+1,k)
+ ENDDO
+ ENDDO
+
+ ELSE
+
+ DO k = 1, nz
+ DO j = 0, (ny+1)/2
+ ai(2*j,k) = ar(j,k)
+ ENDDO
+ DO j = 1, (ny+1)/2 - 1
+ ai(2*j+1,k) = ar(ny+1-j,k)
+ ENDDO
+ ai(1,k) = 0.0
+ ai(ny+2,k) = 0.0
+ ENDDO
+
+ CALL fft991cy( ai, work1, trigs_y, ifax_y, 1, siza, ny+1, nz, 1 )
+
+ ar(0:ny,1:nz) = ai(0:ny,1:nz)
+
+ ENDIF
+
+ ELSEIF ( fft_method == 'system-specific' ) THEN
+
+#if defined( __nec )
+ siza = SIZE( ai, 1 )
+ sizw = SIZE( work, 1 )
+
+ IF ( direction == 'forward') THEN
+
+!
+!-- Tables are initialized once more. This call should not be
+!-- necessary, but otherwise program aborts in asymmetric case
+ CALL DZFFTM( 0, ny+1, nz1, sqr_ny, work, ny+4, work, ny+4, &
+ trig_yf, work1, 0 )
+
+ ai(0:ny,1:nz) = ar(0:ny,1:nz)
+ IF ( nz1 > nz ) THEN
+ ai(:,nz1) = 0.0
+ ENDIF
+
+ CALL DZFFTM( 1, ny+1, nz1, sqr_ny, ai, siza, work, sizw, &
+ trig_yf, work1, 0 )
+
+ DO k = 1, nz
+ DO j = 0, (ny+1)/2
+ ar(j,k) = REAL( work(j+1,k) )
+ ENDDO
+ DO j = 1, (ny+1)/2 - 1
+ ar(ny+1-j,k) = AIMAG( work(j+1,k) )
+ ENDDO
+ ENDDO
+
+ ELSE
+
+!
+!-- Tables are initialized once more. This call should not be
+!-- necessary, but otherwise program aborts in asymmetric case
+ CALL ZDFFTM( 0, ny+1, nz1, sqr_ny, work, ny+4, work, ny+4, &
+ trig_yb, work1, 0 )
+
+ IF ( nz1 > nz ) THEN
+ work(:,nz1) = 0.0
+ ENDIF
+ DO k = 1, nz
+ work(1,k) = CMPLX( ar(0,k), 0.0 )
+ DO j = 1, (ny+1)/2 - 1
+ work(j+1,k) = CMPLX( ar(j,k), ar(ny+1-j,k) )
+ ENDDO
+ work(((ny+1)/2)+1,k) = CMPLX( ar((ny+1)/2,k), 0.0 )
+ ENDDO
+
+ CALL ZDFFTM( -1, ny+1, nz1, sqr_ny, work, sizw, ai, siza, &
+ trig_yb, work1, 0 )
+
+ ar(0:ny,1:nz) = ai(0:ny,1:nz)
+
+ ENDIF
+
+#else
+ PRINT*, '+++ fft_y_m: no system-specific fft-call available'
+ STOP
+#endif
+
+ ELSE
+
+ PRINT*, '+++ fft_y_m: fft method "', fft_method, '" not available'
+ CALL local_stop
+
+ ENDIF
+
+ END SUBROUTINE fft_y_m
+
+ END MODULE fft_xy
Index: /palm/tags/release-3.4a/SOURCE/flow_statistics.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/flow_statistics.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/flow_statistics.f90 (revision 141)
@@ -0,0 +1,1036 @@
+ SUBROUTINE flow_statistics
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 133 2007-11-20 10:10:53Z letzel
+! Vertical profiles now based on nzb_s_inner; they are divided by
+! ngp_2dh_s_inner (scalars, procucts of scalars) and ngp_2dh (staggered
+! velocity components and their products, procucts of scalars and velocity
+! components), respectively.
+!
+! 106 2007-08-16 14:30:26Z raasch
+! Prescribed momentum fluxes at the top surface are used,
+! profiles for w*p* and w"e are calculated
+!
+! 97 2007-06-21 08:23:15Z raasch
+! Statistics for ocean version (salinity, density) added,
+! calculation of z_i and Deardorff velocity scale adjusted to be used with
+! the ocean version
+!
+! 87 2007-05-22 15:46:47Z raasch
+! Two more arguments added to user_statistics, which is now also called for
+! user-defined profiles,
+! var_hom and var_sum renamed pr_palm
+!
+! 82 2007-04-16 15:40:52Z raasch
+! Cpp-directive lcmuk changed to intel_openmp_bug
+!
+! 75 2007-03-22 09:54:05Z raasch
+! Collection of time series quantities moved from routine flow_statistics to
+! here, routine user_statistics is called for each statistic region,
+! moisture renamed humidity
+!
+! 19 2007-02-23 04:53:48Z raasch
+! fluxes at top modified (tswst, qswst)
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.41 2006/08/04 14:37:50 raasch
+! Error removed in non-parallel part (sums_l)
+!
+! Revision 1.1 1997/08/11 06:15:17 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Compute average profiles and further average flow quantities for the different
+! user-defined (sub-)regions. The region indexed 0 is the total model domain.
+!
+! NOTE: For simplicity, nzb_s_inner and nzb_diff_s_inner are being used as a
+! ---- lower vertical index for k-loops for all variables, although strictly
+! speaking the k-loops would have to be split up according to the staggered
+! grid. However, this implies no error since staggered velocity components are
+! zero at the walls and inside buildings.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE cloud_parameters
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE statistics
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, omp_get_thread_num, sr, tn
+ LOGICAL :: first
+ REAL :: height, pts, sums_l_eper, sums_l_etot, ust, ust2, u2, vst, &
+ vst2, v2, w2, z_i(2)
+ REAL :: sums_ll(nzb:nzt+1,2)
+
+
+ CALL cpu_log( log_point(10), 'flow_statistics', 'start' )
+
+!
+!-- To be on the safe side, check whether flow_statistics has already been
+!-- called once after the current time step
+ IF ( flow_statistics_called ) THEN
+ IF ( myid == 0 ) PRINT*, '+++ WARNING: flow_statistics is called two', &
+ ' times within one timestep'
+ CALL local_stop
+ ENDIF
+
+!
+!-- Compute statistics for each (sub-)region
+ DO sr = 0, statistic_regions
+
+!
+!-- Initialize (local) summation array
+ sums_l = 0.0
+
+!
+!-- Store sums that have been computed in other subroutines in summation
+!-- array
+ sums_l(:,11,:) = sums_l_l(:,sr,:) ! mixing length from diffusivities
+!-- WARNING: next line still has to be adjusted for OpenMP
+ sums_l(:,21,0) = sums_wsts_bc_l(:,sr) ! heat flux from advec_s_bc
+ sums_l(nzb+9,pr_palm,0) = sums_divold_l(sr) ! old divergence from pres
+ sums_l(nzb+10,pr_palm,0) = sums_divnew_l(sr) ! new divergence from pres
+!-- WARNING: next four lines still may have to be adjusted for OpenMP
+ sums_l(nzb:nzb+2,pr_palm-1,0) = sums_up_fraction_l(1,1:3,sr)! upstream
+ sums_l(nzb+3:nzb+5,pr_palm-1,0) = sums_up_fraction_l(2,1:3,sr)! parts
+ sums_l(nzb+6:nzb+8,pr_palm-1,0) = sums_up_fraction_l(3,1:3,sr)! from
+ sums_l(nzb+9:nzb+11,pr_palm-1,0) = sums_up_fraction_l(4,1:3,sr)! spline
+
+!
+!-- Horizontally averaged profiles of horizontal velocities and temperature.
+!-- They must have been computed before, because they are already required
+!-- for other horizontal averages.
+ tn = 0
+ !$OMP PARALLEL PRIVATE( i, j, k, tn )
+#if defined( __intel_openmp_bug )
+ tn = omp_get_thread_num()
+#else
+!$ tn = omp_get_thread_num()
+#endif
+
+ !$OMP DO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i), nzt+1
+ sums_l(k,1,tn) = sums_l(k,1,tn) + u(k,j,i) * rmask(j,i,sr)
+ sums_l(k,2,tn) = sums_l(k,2,tn) + v(k,j,i) * rmask(j,i,sr)
+ sums_l(k,4,tn) = sums_l(k,4,tn) + pt(k,j,i) * rmask(j,i,sr)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Horizontally averaged profile of salinity
+ IF ( ocean ) THEN
+ !$OMP DO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i), nzt+1
+ sums_l(k,23,tn) = sums_l(k,23,tn) + &
+ sa(k,j,i) * rmask(j,i,sr)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Horizontally averaged profiles of virtual potential temperature,
+!-- total water content, specific humidity and liquid water potential
+!-- temperature
+ IF ( humidity ) THEN
+ !$OMP DO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i), nzt+1
+ sums_l(k,44,tn) = sums_l(k,44,tn) + &
+ vpt(k,j,i) * rmask(j,i,sr)
+ sums_l(k,41,tn) = sums_l(k,41,tn) + &
+ q(k,j,i) * rmask(j,i,sr)
+ ENDDO
+ ENDDO
+ ENDDO
+ IF ( cloud_physics ) THEN
+ !$OMP DO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i), nzt+1
+ sums_l(k,42,tn) = sums_l(k,42,tn) + &
+ ( q(k,j,i) - ql(k,j,i) ) * rmask(j,i,sr)
+ sums_l(k,43,tn) = sums_l(k,43,tn) + ( &
+ pt(k,j,i) + l_d_cp*pt_d_t(k) * ql(k,j,i) &
+ ) * rmask(j,i,sr)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+
+!
+!-- Horizontally averaged profiles of passive scalar
+ IF ( passive_scalar ) THEN
+ !$OMP DO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i), nzt+1
+ sums_l(k,41,tn) = sums_l(k,41,tn) + q(k,j,i) * rmask(j,i,sr)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ !$OMP END PARALLEL
+
+!
+!-- Summation of thread sums
+ IF ( threads_per_task > 1 ) THEN
+ DO i = 1, threads_per_task-1
+ sums_l(:,1,0) = sums_l(:,1,0) + sums_l(:,1,i)
+ sums_l(:,2,0) = sums_l(:,2,0) + sums_l(:,2,i)
+ sums_l(:,4,0) = sums_l(:,4,0) + sums_l(:,4,i)
+ IF ( ocean ) THEN
+ sums_l(:,23,0) = sums_l(:,23,0) + sums_l(:,23,i)
+ ENDIF
+ IF ( humidity ) THEN
+ sums_l(:,41,0) = sums_l(:,41,0) + sums_l(:,41,i)
+ sums_l(:,44,0) = sums_l(:,44,0) + sums_l(:,44,i)
+ IF ( cloud_physics ) THEN
+ sums_l(:,42,0) = sums_l(:,42,0) + sums_l(:,42,i)
+ sums_l(:,43,0) = sums_l(:,43,0) + sums_l(:,43,i)
+ ENDIF
+ ENDIF
+ IF ( passive_scalar ) THEN
+ sums_l(:,41,0) = sums_l(:,41,0) + sums_l(:,41,i)
+ ENDIF
+ ENDDO
+ ENDIF
+
+#if defined( __parallel )
+!
+!-- Compute total sum from local sums
+ CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), nzt+2-nzb, MPI_REAL, &
+ MPI_SUM, comm2d, ierr )
+ CALL MPI_ALLREDUCE( sums_l(nzb,2,0), sums(nzb,2), nzt+2-nzb, MPI_REAL, &
+ MPI_SUM, comm2d, ierr )
+ CALL MPI_ALLREDUCE( sums_l(nzb,4,0), sums(nzb,4), nzt+2-nzb, MPI_REAL, &
+ MPI_SUM, comm2d, ierr )
+ IF ( ocean ) THEN
+ CALL MPI_ALLREDUCE( sums_l(nzb,23,0), sums(nzb,23), nzt+2-nzb, &
+ MPI_REAL, MPI_SUM, comm2d, ierr )
+ ENDIF
+ IF ( humidity ) THEN
+ CALL MPI_ALLREDUCE( sums_l(nzb,44,0), sums(nzb,44), nzt+2-nzb, &
+ MPI_REAL, MPI_SUM, comm2d, ierr )
+ CALL MPI_ALLREDUCE( sums_l(nzb,41,0), sums(nzb,41), nzt+2-nzb, &
+ MPI_REAL, MPI_SUM, comm2d, ierr )
+ IF ( cloud_physics ) THEN
+ CALL MPI_ALLREDUCE( sums_l(nzb,42,0), sums(nzb,42), nzt+2-nzb, &
+ MPI_REAL, MPI_SUM, comm2d, ierr )
+ CALL MPI_ALLREDUCE( sums_l(nzb,43,0), sums(nzb,43), nzt+2-nzb, &
+ MPI_REAL, MPI_SUM, comm2d, ierr )
+ ENDIF
+ ENDIF
+
+ IF ( passive_scalar ) THEN
+ CALL MPI_ALLREDUCE( sums_l(nzb,41,0), sums(nzb,41), nzt+2-nzb, &
+ MPI_REAL, MPI_SUM, comm2d, ierr )
+ ENDIF
+#else
+ sums(:,1) = sums_l(:,1,0)
+ sums(:,2) = sums_l(:,2,0)
+ sums(:,4) = sums_l(:,4,0)
+ IF ( ocean ) sums(:,23) = sums_l(:,23,0)
+ IF ( humidity ) THEN
+ sums(:,44) = sums_l(:,44,0)
+ sums(:,41) = sums_l(:,41,0)
+ IF ( cloud_physics ) THEN
+ sums(:,42) = sums_l(:,42,0)
+ sums(:,43) = sums_l(:,43,0)
+ ENDIF
+ ENDIF
+ IF ( passive_scalar ) sums(:,41) = sums_l(:,41,0)
+#endif
+
+!
+!-- Final values are obtained by division by the total number of grid points
+!-- used for summation. After that store profiles.
+ sums(:,1) = sums(:,1) / ngp_2dh(sr)
+ sums(:,2) = sums(:,2) / ngp_2dh(sr)
+ sums(:,4) = sums(:,4) / ngp_2dh_s_inner(:,sr)
+ hom(:,1,1,sr) = sums(:,1) ! u
+ hom(:,1,2,sr) = sums(:,2) ! v
+ hom(:,1,4,sr) = sums(:,4) ! pt
+
+!
+!-- Salinity
+ IF ( ocean ) THEN
+ sums(:,23) = sums(:,23) / ngp_2dh_s_inner(:,sr)
+ hom(:,1,23,sr) = sums(:,23) ! sa
+ ENDIF
+
+!
+!-- Humidity and cloud parameters
+ IF ( humidity ) THEN
+ sums(:,44) = sums(:,44) / ngp_2dh_s_inner(:,sr)
+ sums(:,41) = sums(:,41) / ngp_2dh_s_inner(:,sr)
+ hom(:,1,44,sr) = sums(:,44) ! vpt
+ hom(:,1,41,sr) = sums(:,41) ! qv (q)
+ IF ( cloud_physics ) THEN
+ sums(:,42) = sums(:,42) / ngp_2dh_s_inner(:,sr)
+ sums(:,43) = sums(:,43) / ngp_2dh_s_inner(:,sr)
+ hom(:,1,42,sr) = sums(:,42) ! qv
+ hom(:,1,43,sr) = sums(:,43) ! pt
+ ENDIF
+ ENDIF
+
+!
+!-- Passive scalar
+ IF ( passive_scalar ) hom(:,1,41,sr) = sums(:,41) / &
+ ngp_2dh_s_inner(:,sr) ! s (q)
+
+!
+!-- Horizontally averaged profiles of the remaining prognostic variables,
+!-- variances, the total and the perturbation energy (single values in last
+!-- column of sums_l) and some diagnostic quantities.
+!-- NOTE: for simplicity, nzb_s_inner is used below, although strictly
+!-- ---- speaking the following k-loop would have to be split up and
+!-- rearranged according to the staggered grid.
+!-- However, this implies no error since staggered velocity components
+!-- are zero at the walls and inside buildings.
+ tn = 0
+#if defined( __intel_openmp_bug )
+ !$OMP PARALLEL PRIVATE( i, j, k, pts, sums_ll, sums_l_eper, sums_l_etot, &
+ !$OMP tn, ust, ust2, u2, vst, vst2, v2, w2 )
+ tn = omp_get_thread_num()
+#else
+ !$OMP PARALLEL PRIVATE( i, j, k, pts, sums_ll, sums_l_eper, sums_l_etot, tn, ust, ust2, u2, vst, vst2, v2, w2 )
+!$ tn = omp_get_thread_num()
+#endif
+ !$OMP DO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ sums_l_etot = 0.0
+ sums_l_eper = 0.0
+ DO k = nzb_s_inner(j,i), nzt+1
+ u2 = u(k,j,i)**2
+ v2 = v(k,j,i)**2
+ w2 = w(k,j,i)**2
+ ust2 = ( u(k,j,i) - hom(k,1,1,sr) )**2
+ vst2 = ( v(k,j,i) - hom(k,1,2,sr) )**2
+!
+!-- Prognostic and diagnostic variables
+ sums_l(k,3,tn) = sums_l(k,3,tn) + w(k,j,i) * rmask(j,i,sr)
+ sums_l(k,8,tn) = sums_l(k,8,tn) + e(k,j,i) * rmask(j,i,sr)
+ sums_l(k,9,tn) = sums_l(k,9,tn) + km(k,j,i) * rmask(j,i,sr)
+ sums_l(k,10,tn) = sums_l(k,10,tn) + kh(k,j,i) * rmask(j,i,sr)
+ sums_l(k,40,tn) = sums_l(k,40,tn) + p(k,j,i)
+
+!
+!-- Variances
+ sums_l(k,30,tn) = sums_l(k,30,tn) + ust2 * rmask(j,i,sr)
+ sums_l(k,31,tn) = sums_l(k,31,tn) + vst2 * rmask(j,i,sr)
+ sums_l(k,32,tn) = sums_l(k,32,tn) + w2 * rmask(j,i,sr)
+ sums_l(k,33,tn) = sums_l(k,33,tn) + &
+ ( pt(k,j,i)-hom(k,1,4,sr) )**2 * rmask(j,i,sr)
+!
+!-- Higher moments
+!-- (Computation of the skewness of w further below)
+ sums_l(k,38,tn) = sums_l(k,38,tn) + w(k,j,i) * w2 * &
+ rmask(j,i,sr)
+!
+!-- Perturbation energy
+ sums_l(k,34,tn) = sums_l(k,34,tn) + 0.5 * ( ust2 + vst2 + w2 ) &
+ * rmask(j,i,sr)
+ sums_l_etot = sums_l_etot + &
+ 0.5 * ( u2 + v2 + w2 ) * rmask(j,i,sr)
+ sums_l_eper = sums_l_eper + &
+ 0.5 * ( ust2+vst2+w2 ) * rmask(j,i,sr)
+ ENDDO
+!
+!-- Total and perturbation energy for the total domain (being
+!-- collected in the last column of sums_l). Summation of these
+!-- quantities is seperated from the previous loop in order to
+!-- allow vectorization of that loop.
+ sums_l(nzb+4,pr_palm,tn) = sums_l(nzb+4,pr_palm,tn) + sums_l_etot
+ sums_l(nzb+5,pr_palm,tn) = sums_l(nzb+5,pr_palm,tn) + sums_l_eper
+!
+!-- 2D-arrays (being collected in the last column of sums_l)
+ sums_l(nzb,pr_palm,tn) = sums_l(nzb,pr_palm,tn) + &
+ us(j,i) * rmask(j,i,sr)
+ sums_l(nzb+1,pr_palm,tn) = sums_l(nzb+1,pr_palm,tn) + &
+ usws(j,i) * rmask(j,i,sr)
+ sums_l(nzb+2,pr_palm,tn) = sums_l(nzb+2,pr_palm,tn) + &
+ vsws(j,i) * rmask(j,i,sr)
+ sums_l(nzb+3,pr_palm,tn) = sums_l(nzb+3,pr_palm,tn) + &
+ ts(j,i) * rmask(j,i,sr)
+ ENDDO
+ ENDDO
+
+!
+!-- Horizontally averaged profiles of the vertical fluxes
+ !$OMP DO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+!
+!-- Subgridscale fluxes (without Prandtl layer from k=nzb,
+!-- oterwise from k=nzb+1)
+!-- NOTE: for simplicity, nzb_diff_s_inner is used below, although
+!-- ---- strictly speaking the following k-loop would have to be
+!-- split up according to the staggered grid.
+!-- However, this implies no error since staggered velocity
+!-- components are zero at the walls and inside buildings.
+
+ DO k = nzb_diff_s_inner(j,i)-1, nzt_diff
+!
+!-- Momentum flux w"u"
+ sums_l(k,12,tn) = sums_l(k,12,tn) - 0.25 * ( &
+ km(k,j,i)+km(k+1,j,i)+km(k,j,i-1)+km(k+1,j,i-1) &
+ ) * ( &
+ ( u(k+1,j,i) - u(k,j,i) ) * ddzu(k+1) &
+ + ( w(k,j,i) - w(k,j,i-1) ) * ddx &
+ ) * rmask(j,i,sr)
+!
+!-- Momentum flux w"v"
+ sums_l(k,14,tn) = sums_l(k,14,tn) - 0.25 * ( &
+ km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) &
+ ) * ( &
+ ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) &
+ + ( w(k,j,i) - w(k,j-1,i) ) * ddy &
+ ) * rmask(j,i,sr)
+!
+!-- Heat flux w"pt"
+ sums_l(k,16,tn) = sums_l(k,16,tn) &
+ - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) ) &
+ * ( pt(k+1,j,i) - pt(k,j,i) ) &
+ * ddzu(k+1) * rmask(j,i,sr)
+
+
+!
+!-- Salinity flux w"sa"
+ IF ( ocean ) THEN
+ sums_l(k,65,tn) = sums_l(k,65,tn) &
+ - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) ) &
+ * ( sa(k+1,j,i) - sa(k,j,i) ) &
+ * ddzu(k+1) * rmask(j,i,sr)
+ ENDIF
+
+!
+!-- Buoyancy flux, water flux (humidity flux) w"q"
+ IF ( humidity ) THEN
+ sums_l(k,45,tn) = sums_l(k,45,tn) &
+ - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) ) &
+ * ( vpt(k+1,j,i) - vpt(k,j,i) ) &
+ * ddzu(k+1) * rmask(j,i,sr)
+ sums_l(k,48,tn) = sums_l(k,48,tn) &
+ - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) ) &
+ * ( q(k+1,j,i) - q(k,j,i) ) &
+ * ddzu(k+1) * rmask(j,i,sr)
+ IF ( cloud_physics ) THEN
+ sums_l(k,51,tn) = sums_l(k,51,tn) &
+ - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) ) &
+ * ( ( q(k+1,j,i) - ql(k+1,j,i) )&
+ - ( q(k,j,i) - ql(k,j,i) ) ) &
+ * ddzu(k+1) * rmask(j,i,sr)
+ ENDIF
+ ENDIF
+
+!
+!-- Passive scalar flux
+ IF ( passive_scalar ) THEN
+ sums_l(k,48,tn) = sums_l(k,48,tn) &
+ - 0.5 * ( kh(k,j,i) + kh(k+1,j,i) ) &
+ * ( q(k+1,j,i) - q(k,j,i) ) &
+ * ddzu(k+1) * rmask(j,i,sr)
+ ENDIF
+
+ ENDDO
+
+!
+!-- Subgridscale fluxes in the Prandtl layer
+ IF ( use_surface_fluxes ) THEN
+ sums_l(nzb,12,tn) = sums_l(nzb,12,tn) + &
+ usws(j,i) * rmask(j,i,sr) ! w"u"
+ sums_l(nzb,14,tn) = sums_l(nzb,14,tn) + &
+ vsws(j,i) * rmask(j,i,sr) ! w"v"
+ sums_l(nzb,16,tn) = sums_l(nzb,16,tn) + &
+ shf(j,i) * rmask(j,i,sr) ! w"pt"
+ sums_l(nzb,58,tn) = sums_l(nzb,58,tn) + &
+ 0.0 * rmask(j,i,sr) ! u"pt"
+ sums_l(nzb,61,tn) = sums_l(nzb,61,tn) + &
+ 0.0 * rmask(j,i,sr) ! v"pt"
+ IF ( ocean ) THEN
+ sums_l(nzb,65,tn) = sums_l(nzb,65,tn) + &
+ saswsb(j,i) * rmask(j,i,sr) ! w"sa"
+ ENDIF
+ IF ( humidity ) THEN
+ sums_l(nzb,48,tn) = sums_l(nzb,48,tn) + &
+ qsws(j,i) * rmask(j,i,sr) ! w"q" (w"qv")
+ IF ( cloud_physics ) THEN
+ sums_l(nzb,45,tn) = sums_l(nzb,45,tn) + ( &
+ ( 1.0 + 0.61 * q(nzb,j,i) ) * &
+ shf(j,i) + 0.61 * pt(nzb,j,i) * &
+ qsws(j,i) &
+ )
+!
+!-- Formula does not work if ql(nzb) /= 0.0
+ sums_l(nzb,51,tn) = sums_l(nzb,51,tn) + & ! w"q" (w"qv")
+ qsws(j,i) * rmask(j,i,sr)
+ ENDIF
+ ENDIF
+ IF ( passive_scalar ) THEN
+ sums_l(nzb,48,tn) = sums_l(nzb,48,tn) + &
+ qsws(j,i) * rmask(j,i,sr) ! w"q" (w"qv")
+ ENDIF
+ ENDIF
+
+!
+!-- Subgridscale fluxes at the top surface
+ IF ( use_top_fluxes ) THEN
+ sums_l(nzt,12,tn) = sums_l(nzt,12,tn) + &
+ uswst(j,i) * rmask(j,i,sr) ! w"u"
+ sums_l(nzt,14,tn) = sums_l(nzt,14,tn) + &
+ vswst(j,i) * rmask(j,i,sr) ! w"v"
+ sums_l(nzt,16,tn) = sums_l(nzt,16,tn) + &
+ tswst(j,i) * rmask(j,i,sr) ! w"pt"
+ sums_l(nzt,58,tn) = sums_l(nzt,58,tn) + &
+ 0.0 * rmask(j,i,sr) ! u"pt"
+ sums_l(nzt,61,tn) = sums_l(nzt,61,tn) + &
+ 0.0 * rmask(j,i,sr) ! v"pt"
+ IF ( ocean ) THEN
+ sums_l(nzt,65,tn) = sums_l(nzt,65,tn) + &
+ saswst(j,i) * rmask(j,i,sr) ! w"sa"
+ ENDIF
+ IF ( humidity ) THEN
+ sums_l(nzt,48,tn) = sums_l(nzt,48,tn) + &
+ qswst(j,i) * rmask(j,i,sr) ! w"q" (w"qv")
+ IF ( cloud_physics ) THEN
+ sums_l(nzt,45,tn) = sums_l(nzt,45,tn) + ( &
+ ( 1.0 + 0.61 * q(nzt,j,i) ) * &
+ tswst(j,i) + 0.61 * pt(nzt,j,i) * &
+ qsws(j,i) &
+ )
+!
+!-- Formula does not work if ql(nzb) /= 0.0
+ sums_l(nzt,51,tn) = sums_l(nzt,51,tn) + & ! w"q" (w"qv")
+ qswst(j,i) * rmask(j,i,sr)
+ ENDIF
+ ENDIF
+ IF ( passive_scalar ) THEN
+ sums_l(nzt,48,tn) = sums_l(nzt,48,tn) + &
+ qswst(j,i) * rmask(j,i,sr) ! w"q" (w"qv")
+ ENDIF
+ ENDIF
+
+!
+!-- Resolved fluxes (can be computed for all horizontal points)
+!-- NOTE: for simplicity, nzb_s_inner is used below, although strictly
+!-- ---- speaking the following k-loop would have to be split up and
+!-- rearranged according to the staggered grid.
+ DO k = nzb_s_inner(j,i), nzt
+ ust = 0.5 * ( u(k,j,i) - hom(k,1,1,sr) + &
+ u(k+1,j,i) - hom(k+1,1,1,sr) )
+ vst = 0.5 * ( v(k,j,i) - hom(k,1,2,sr) + &
+ v(k+1,j,i) - hom(k+1,1,2,sr) )
+ pts = 0.5 * ( pt(k,j,i) - hom(k,1,4,sr) + &
+ pt(k+1,j,i) - hom(k+1,1,4,sr) )
+!
+!-- Momentum flux w*u*
+ sums_l(k,13,tn) = sums_l(k,13,tn) + 0.5 * &
+ ( w(k,j,i-1) + w(k,j,i) ) &
+ * ust * rmask(j,i,sr)
+!
+!-- Momentum flux w*v*
+ sums_l(k,15,tn) = sums_l(k,15,tn) + 0.5 * &
+ ( w(k,j-1,i) + w(k,j,i) ) &
+ * vst * rmask(j,i,sr)
+!
+!-- Heat flux w*pt*
+!-- The following formula (comment line, not executed) does not
+!-- work if applied to subregions
+! sums_l(k,17,tn) = sums_l(k,17,tn) + 0.5 * &
+! ( pt(k,j,i)+pt(k+1,j,i) ) &
+! * w(k,j,i) * rmask(j,i,sr)
+ sums_l(k,17,tn) = sums_l(k,17,tn) + pts * w(k,j,i) * &
+ rmask(j,i,sr)
+!
+!-- Higher moments
+ sums_l(k,35,tn) = sums_l(k,35,tn) + pts * w(k,j,i)**2 * &
+ rmask(j,i,sr)
+ sums_l(k,36,tn) = sums_l(k,36,tn) + pts**2 * w(k,j,i) * &
+ rmask(j,i,sr)
+
+!
+!-- Salinity flux and density (density does not belong to here,
+!-- but so far there is no other suitable place to calculate)
+ IF ( ocean ) THEN
+ pts = 0.5 * ( sa(k,j,i) - hom(k,1,23,sr) + &
+ sa(k+1,j,i) - hom(k+1,1,23,sr) )
+ sums_l(k,66,tn) = sums_l(k,66,tn) + pts * w(k,j,i) * &
+ rmask(j,i,sr)
+ sums_l(k,64,tn) = sums_l(k,64,tn) + rho(k,j,i) * &
+ rmask(j,i,sr)
+ ENDIF
+
+!
+!-- Buoyancy flux, water flux, humidity flux and liquid water
+!-- content
+ IF ( humidity ) THEN
+ pts = 0.5 * ( vpt(k,j,i) - hom(k,1,44,sr) + &
+ vpt(k+1,j,i) - hom(k+1,1,44,sr) )
+ sums_l(k,46,tn) = sums_l(k,46,tn) + pts * w(k,j,i) * &
+ rmask(j,i,sr)
+ pts = 0.5 * ( q(k,j,i) - hom(k,1,41,sr) + &
+ q(k+1,j,i) - hom(k+1,1,41,sr) )
+ sums_l(k,49,tn) = sums_l(k,49,tn) + pts * w(k,j,i) * &
+ rmask(j,i,sr)
+ IF ( cloud_physics .OR. cloud_droplets ) THEN
+ pts = 0.5 * &
+ ( ( q(k,j,i) - ql(k,j,i) ) - hom(k,1,42,sr) &
+ + ( q(k+1,j,i) - ql(k+1,j,i) ) - hom(k+1,1,42,sr) )
+ sums_l(k,52,tn) = sums_l(k,52,tn) + pts * w(k,j,i) * &
+ rmask(j,i,sr)
+ sums_l(k,54,tn) = sums_l(k,54,tn) + ql(k,j,i) * &
+ rmask(j,i,sr)
+ ENDIF
+ ENDIF
+
+!
+!-- Passive scalar flux
+ IF ( passive_scalar ) THEN
+ pts = 0.5 * ( q(k,j,i) - hom(k,1,41,sr) + &
+ q(k+1,j,i) - hom(k+1,1,41,sr) )
+ sums_l(k,49,tn) = sums_l(k,49,tn) + pts * w(k,j,i) * &
+ rmask(j,i,sr)
+ ENDIF
+
+!
+!-- Energy flux w*e*
+ sums_l(k,37,tn) = sums_l(k,37,tn) + w(k,j,i) * 0.5 * &
+ ( ust**2 + vst**2 + w(k,j,i)**2 )&
+ * rmask(j,i,sr)
+
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Density at top follows Neumann condition
+ IF ( ocean ) sums_l(nzt+1,64,tn) = sums_l(nzt,64,tn)
+
+!
+!-- Divergence of vertical flux of resolved scale energy and pressure
+!-- fluctuations as well as flux of pressure fluctuation itself (68).
+!-- First calculate the products, then the divergence.
+!-- Calculation is time consuming. Do it only, if profiles shall be plotted.
+ IF ( hom(nzb+1,2,55,0) /= 0.0 .OR. hom(nzb+1,2,68,0) /= 0.0 ) THEN
+
+ sums_ll = 0.0 ! local array
+
+ !$OMP DO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+
+ sums_ll(k,1) = sums_ll(k,1) + 0.5 * w(k,j,i) * ( &
+ ( 0.25 * ( u(k,j,i)+u(k+1,j,i)+u(k,j,i+1)+u(k+1,j,i+1) &
+ - 2.0 * ( hom(k,1,1,sr) + hom(k+1,1,1,sr) ) &
+ ) )**2 &
+ + ( 0.25 * ( v(k,j,i)+v(k+1,j,i)+v(k,j+1,i)+v(k+1,j+1,i) &
+ - 2.0 * ( hom(k,1,2,sr) + hom(k+1,1,2,sr) ) &
+ ) )**2 &
+ + w(k,j,i)**2 )
+
+ sums_ll(k,2) = sums_ll(k,2) + 0.5 * w(k,j,i) &
+ * ( p(k,j,i) + p(k+1,j,i) )
+
+ ENDDO
+ ENDDO
+ ENDDO
+ sums_ll(0,1) = 0.0 ! because w is zero at the bottom
+ sums_ll(nzt+1,1) = 0.0
+ sums_ll(0,2) = 0.0
+ sums_ll(nzt+1,2) = 0.0
+
+ DO k = nzb_s_inner(j,i)+1, nzt
+ sums_l(k,55,tn) = ( sums_ll(k,1) - sums_ll(k-1,1) ) * ddzw(k)
+ sums_l(k,56,tn) = ( sums_ll(k,2) - sums_ll(k-1,2) ) * ddzw(k)
+ sums_l(k,68,tn) = sums_ll(k,2)
+ ENDDO
+ sums_l(nzb,55,tn) = sums_l(nzb+1,55,tn)
+ sums_l(nzb,56,tn) = sums_l(nzb+1,56,tn)
+ sums_l(nzb,68,tn) = 0.0 ! because w* = 0 at nzb
+
+ ENDIF
+
+!
+!-- Divergence of vertical flux of SGS TKE and the flux itself (69)
+ IF ( hom(nzb+1,2,57,0) /= 0.0 .OR. hom(nzb+1,2,69,0) /= 0.0 ) THEN
+
+ !$OMP DO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+
+ sums_l(k,57,tn) = sums_l(k,57,tn) - 0.5 * ( &
+ (km(k,j,i)+km(k+1,j,i)) * (e(k+1,j,i)-e(k,j,i)) * ddzu(k+1) &
+ - (km(k-1,j,i)+km(k,j,i)) * (e(k,j,i)-e(k-1,j,i)) * ddzu(k) &
+ ) * ddzw(k)
+
+ sums_l(k,69,tn) = sums_l(k,69,tn) - 0.5 * ( &
+ (km(k,j,i)+km(k+1,j,i)) * (e(k+1,j,i)-e(k,j,i)) * ddzu(k+1) &
+ )
+
+ ENDDO
+ ENDDO
+ ENDDO
+ sums_l(nzb,57,tn) = sums_l(nzb+1,57,tn)
+ sums_l(nzb,69,tn) = sums_l(nzb+1,69,tn)
+
+ ENDIF
+
+!
+!-- Horizontal heat fluxes (subgrid, resolved, total).
+!-- Do it only, if profiles shall be plotted.
+ IF ( hom(nzb+1,2,58,0) /= 0.0 ) THEN
+
+ !$OMP DO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+!
+!-- Subgrid horizontal heat fluxes u"pt", v"pt"
+ sums_l(k,58,tn) = sums_l(k,58,tn) - 0.5 * &
+ ( kh(k,j,i) + kh(k,j,i-1) ) &
+ * ( pt(k,j,i-1) - pt(k,j,i) ) &
+ * ddx * rmask(j,i,sr)
+ sums_l(k,61,tn) = sums_l(k,61,tn) - 0.5 * &
+ ( kh(k,j,i) + kh(k,j-1,i) ) &
+ * ( pt(k,j-1,i) - pt(k,j,i) ) &
+ * ddy * rmask(j,i,sr)
+!
+!-- Resolved horizontal heat fluxes u*pt*, v*pt*
+ sums_l(k,59,tn) = sums_l(k,59,tn) + &
+ ( u(k,j,i) - hom(k,1,1,sr) ) &
+ * 0.5 * ( pt(k,j,i-1) - hom(k,1,4,sr) + &
+ pt(k,j,i) - hom(k,1,4,sr) )
+ pts = 0.5 * ( pt(k,j-1,i) - hom(k,1,4,sr) + &
+ pt(k,j,i) - hom(k,1,4,sr) )
+ sums_l(k,62,tn) = sums_l(k,62,tn) + &
+ ( v(k,j,i) - hom(k,1,2,sr) ) &
+ * 0.5 * ( pt(k,j-1,i) - hom(k,1,4,sr) + &
+ pt(k,j,i) - hom(k,1,4,sr) )
+ ENDDO
+ ENDDO
+ ENDDO
+!
+!-- Fluxes at the surface must be zero (e.g. due to the Prandtl-layer)
+ sums_l(nzb,58,tn) = 0.0
+ sums_l(nzb,59,tn) = 0.0
+ sums_l(nzb,60,tn) = 0.0
+ sums_l(nzb,61,tn) = 0.0
+ sums_l(nzb,62,tn) = 0.0
+ sums_l(nzb,63,tn) = 0.0
+
+ ENDIF
+
+!
+!-- Calculate the user-defined profiles
+ CALL user_statistics( 'profiles', sr, tn )
+ !$OMP END PARALLEL
+
+!
+!-- Summation of thread sums
+ IF ( threads_per_task > 1 ) THEN
+ DO i = 1, threads_per_task-1
+ sums_l(:,3,0) = sums_l(:,3,0) + sums_l(:,3,i)
+ sums_l(:,4:40,0) = sums_l(:,4:40,0) + sums_l(:,4:40,i)
+ sums_l(:,45:pr_palm,0) = sums_l(:,45:pr_palm,0) + &
+ sums_l(:,45:pr_palm,i)
+ IF ( max_pr_user > 0 ) THEN
+ sums_l(:,pr_palm+1:pr_palm+max_pr_user,0) = &
+ sums_l(:,pr_palm+1:pr_palm+max_pr_user,0) + &
+ sums_l(:,pr_palm+1:pr_palm+max_pr_user,i)
+ ENDIF
+ ENDDO
+ ENDIF
+
+#if defined( __parallel )
+!
+!-- Compute total sum from local sums
+ CALL MPI_ALLREDUCE( sums_l(nzb,1,0), sums(nzb,1), ngp_sums, MPI_REAL, &
+ MPI_SUM, comm2d, ierr )
+#else
+ sums = sums_l(:,:,0)
+#endif
+
+!
+!-- Final values are obtained by division by the total number of grid points
+!-- used for summation. After that store profiles.
+!-- Profiles:
+ DO k = nzb, nzt+1
+ sums(k,3) = sums(k,3) / ngp_2dh(sr)
+ sums(k,9:11) = sums(k,9:11) / ngp_2dh_s_inner(k,sr)
+ sums(k,12:22) = sums(k,12:22) / ngp_2dh(sr)
+ sums(k,23:29) = sums(k,23:29) / ngp_2dh_s_inner(k,sr)
+ sums(k,30:32) = sums(k,30:32) / ngp_2dh(sr)
+ sums(k,33) = sums(k,33) / ngp_2dh_s_inner(k,sr)
+ sums(k,34:39) = sums(k,34:39) / ngp_2dh(sr)
+ sums(k,40) = sums(k,40) / ngp_2dh_s_inner(k,sr)
+ sums(k,45:53) = sums(k,45:53) / ngp_2dh(sr)
+ sums(k,54) = sums(k,54) / ngp_2dh_s_inner(k,sr)
+ sums(k,55:63) = sums(k,55:63) / ngp_2dh(sr)
+ sums(k,64) = sums(k,64) / ngp_2dh_s_inner(k,sr)
+ sums(k,65:69) = sums(k,65:69) / ngp_2dh(sr)
+ sums(k,70:pr_palm-2) = sums(k,70:pr_palm-2)/ ngp_2dh_s_inner(k,sr)
+ ENDDO
+!-- Upstream-parts
+ sums(nzb:nzb+11,pr_palm-1) = sums(nzb:nzb+11,pr_palm-1) / ngp_3d(sr)
+!-- u* and so on
+!-- As sums(nzb:nzb+3,pr_palm) are full 2D arrays (us, usws, vsws, ts) whose
+!-- size is always ( nx + 1 ) * ( ny + 1 ), defined at the first grid layer
+!-- above the topography, they are being divided by ngp_2dh(sr)
+ sums(nzb:nzb+3,pr_palm) = sums(nzb:nzb+3,pr_palm) / &
+ ngp_2dh(sr)
+!-- eges, e*
+ sums(nzb+4:nzb+5,pr_palm) = sums(nzb+4:nzb+5,pr_palm) / &
+ ngp_3d(sr)
+!-- Old and new divergence
+ sums(nzb+9:nzb+10,pr_palm) = sums(nzb+9:nzb+10,pr_palm) / &
+ ngp_3d_inner(sr)
+
+!-- User-defined profiles
+ IF ( max_pr_user > 0 ) THEN
+ DO k = nzb, nzt+1
+ sums(k,pr_palm+1:pr_palm+max_pr_user) = &
+ sums(k,pr_palm+1:pr_palm+max_pr_user) / &
+ ngp_2dh_s_inner(k,sr)
+ ENDDO
+ ENDIF
+
+!
+!-- Collect horizontal average in hom.
+!-- Compute deduced averages (e.g. total heat flux)
+ hom(:,1,3,sr) = sums(:,3) ! w
+ hom(:,1,8,sr) = sums(:,8) ! e profiles 5-7 are initial profiles
+ hom(:,1,9,sr) = sums(:,9) ! km
+ hom(:,1,10,sr) = sums(:,10) ! kh
+ hom(:,1,11,sr) = sums(:,11) ! l
+ hom(:,1,12,sr) = sums(:,12) ! w"u"
+ hom(:,1,13,sr) = sums(:,13) ! w*u*
+ hom(:,1,14,sr) = sums(:,14) ! w"v"
+ hom(:,1,15,sr) = sums(:,15) ! w*v*
+ hom(:,1,16,sr) = sums(:,16) ! w"pt"
+ hom(:,1,17,sr) = sums(:,17) ! w*pt*
+ hom(:,1,18,sr) = sums(:,16) + sums(:,17) ! wpt
+ hom(:,1,19,sr) = sums(:,12) + sums(:,13) ! wu
+ hom(:,1,20,sr) = sums(:,14) + sums(:,15) ! wv
+ hom(:,1,21,sr) = sums(:,21) ! w*pt*BC
+ hom(:,1,22,sr) = sums(:,16) + sums(:,21) ! wptBC
+ ! profile 24 is initial profile (sa)
+ ! profiles 25-29 left empty for initial
+ ! profiles
+ hom(:,1,30,sr) = sums(:,30) ! u*2
+ hom(:,1,31,sr) = sums(:,31) ! v*2
+ hom(:,1,32,sr) = sums(:,32) ! w*2
+ hom(:,1,33,sr) = sums(:,33) ! pt*2
+ hom(:,1,34,sr) = sums(:,34) ! e*
+ hom(:,1,35,sr) = sums(:,35) ! w*2pt*
+ hom(:,1,36,sr) = sums(:,36) ! w*pt*2
+ hom(:,1,37,sr) = sums(:,37) ! w*e*
+ hom(:,1,38,sr) = sums(:,38) ! w*3
+ hom(:,1,39,sr) = sums(:,38) / ( sums(:,32) + 1E-20 )**1.5 ! Sw
+ hom(:,1,40,sr) = sums(:,40) ! p
+ hom(:,1,45,sr) = sums(:,45) ! w"q"
+ hom(:,1,46,sr) = sums(:,46) ! w*vpt*
+ hom(:,1,47,sr) = sums(:,45) + sums(:,46) ! wvpt
+ hom(:,1,48,sr) = sums(:,48) ! w"q" (w"qv")
+ hom(:,1,49,sr) = sums(:,49) ! w*q* (w*qv*)
+ hom(:,1,50,sr) = sums(:,48) + sums(:,49) ! wq (wqv)
+ hom(:,1,51,sr) = sums(:,51) ! w"qv"
+ hom(:,1,52,sr) = sums(:,52) ! w*qv*
+ hom(:,1,53,sr) = sums(:,52) + sums(:,51) ! wq (wqv)
+ hom(:,1,54,sr) = sums(:,54) ! ql
+ hom(:,1,55,sr) = sums(:,55) ! w*u*u*/dz
+ hom(:,1,56,sr) = sums(:,56) ! w*p*/dz
+ hom(:,1,57,sr) = sums(:,57) ! ( w"e + w"p"/rho )/dz
+ hom(:,1,58,sr) = sums(:,58) ! u"pt"
+ hom(:,1,59,sr) = sums(:,59) ! u*pt*
+ hom(:,1,60,sr) = sums(:,58) + sums(:,59) ! upt_t
+ hom(:,1,61,sr) = sums(:,61) ! v"pt"
+ hom(:,1,62,sr) = sums(:,62) ! v*pt*
+ hom(:,1,63,sr) = sums(:,61) + sums(:,62) ! vpt_t
+ hom(:,1,64,sr) = sums(:,64) ! rho
+ hom(:,1,65,sr) = sums(:,65) ! w"sa"
+ hom(:,1,66,sr) = sums(:,66) ! w*sa*
+ hom(:,1,67,sr) = sums(:,65) + sums(:,66) ! wsa
+ hom(:,1,68,sr) = sums(:,68) ! w*p*
+ hom(:,1,69,sr) = sums(:,69) ! w"e + w"p"/rho
+
+ hom(:,1,pr_palm-1,sr) = sums(:,pr_palm-1)
+ ! upstream-parts u_x, u_y, u_z, v_x,
+ ! v_y, usw. (in last but one profile)
+ hom(:,1,pr_palm,sr) = sums(:,pr_palm)
+ ! u*, w'u', w'v', t* (in last profile)
+
+ IF ( max_pr_user > 0 ) THEN ! user-defined profiles
+ hom(:,1,pr_palm+1:pr_palm+max_pr_user,sr) = &
+ sums(:,pr_palm+1:pr_palm+max_pr_user)
+ ENDIF
+
+!
+!-- Determine the boundary layer height using two different schemes.
+!-- First scheme: Starting from the Earth's (Ocean's) surface, look for the
+!-- first relative minimum (maximum) of the total heat flux.
+!-- The corresponding height is assumed as the boundary layer height, if it
+!-- is less than 1.5 times the height where the heat flux becomes negative
+!-- (positive) for the first time.
+!-- NOTE: This criterion is still capable of improving!
+ z_i(1) = 0.0
+ first = .TRUE.
+ IF ( ocean ) THEN
+ DO k = nzt, nzb+1, -1
+ IF ( first .AND. hom(k,1,18,sr) < 0.0 ) THEN
+ first = .FALSE.
+ height = zw(k)
+ ENDIF
+ IF ( hom(k,1,18,sr) < 0.0 .AND. &
+ hom(k-1,1,18,sr) > hom(k,1,18,sr) ) THEN
+ IF ( zw(k) < 1.5 * height ) THEN
+ z_i(1) = zw(k)
+ ELSE
+ z_i(1) = height
+ ENDIF
+ EXIT
+ ENDIF
+ ENDDO
+ ELSE
+ DO k = nzb, nzt-1
+ IF ( first .AND. hom(k,1,18,sr) < 0.0 ) THEN
+ first = .FALSE.
+ height = zw(k)
+ ENDIF
+ IF ( hom(k,1,18,sr) < 0.0 .AND. &
+ hom(k+1,1,18,sr) > hom(k,1,18,sr) ) THEN
+ IF ( zw(k) < 1.5 * height ) THEN
+ z_i(1) = zw(k)
+ ELSE
+ z_i(1) = height
+ ENDIF
+ EXIT
+ ENDIF
+ ENDDO
+ ENDIF
+
+!
+!-- Second scheme: Starting from the top/bottom model boundary, look for
+!-- the first characteristic kink in the temperature profile, where the
+!-- originally stable stratification notably weakens.
+ z_i(2) = 0.0
+ IF ( ocean ) THEN
+ DO k = nzb+1, nzt-1
+ IF ( ( hom(k,1,4,sr) - hom(k-1,1,4,sr) ) > &
+ 2.0 * ( hom(k+1,1,4,sr) - hom(k,1,4,sr) ) ) THEN
+ z_i(2) = zu(k)
+ EXIT
+ ENDIF
+ ENDDO
+ ELSE
+ DO k = nzt-1, nzb+1, -1
+ IF ( ( hom(k+1,1,4,sr) - hom(k,1,4,sr) ) > &
+ 2.0 * ( hom(k,1,4,sr) - hom(k-1,1,4,sr) ) ) THEN
+ z_i(2) = zu(k)
+ EXIT
+ ENDIF
+ ENDDO
+ ENDIF
+
+ hom(nzb+6,1,pr_palm,sr) = z_i(1)
+ hom(nzb+7,1,pr_palm,sr) = z_i(2)
+
+!
+!-- Computation of both the characteristic vertical velocity and
+!-- the characteristic convective boundary layer temperature.
+!-- The horizontal average at nzb+1 is input for the average temperature.
+ IF ( hom(nzb,1,18,sr) > 0.0 .AND. z_i(1) /= 0.0 ) THEN
+ hom(nzb+8,1,pr_palm,sr) = ( g / hom(nzb+1,1,4,sr) * &
+ hom(nzb,1,18,sr) * &
+ ABS( z_i(1) ) )**0.333333333
+!-- so far this only works if Prandtl layer is used
+ hom(nzb+11,1,pr_palm,sr) = hom(nzb,1,16,sr) / hom(nzb+8,1,pr_palm,sr)
+ ELSE
+ hom(nzb+8,1,pr_palm,sr) = 0.0
+ hom(nzb+11,1,pr_palm,sr) = 0.0
+ ENDIF
+
+!
+!-- Collect the time series quantities
+ ts_value(1,sr) = hom(nzb+4,1,pr_palm,sr) ! E
+ ts_value(2,sr) = hom(nzb+5,1,pr_palm,sr) ! E*
+ ts_value(3,sr) = dt_3d
+ ts_value(4,sr) = hom(nzb,1,pr_palm,sr) ! u*
+ ts_value(5,sr) = hom(nzb+3,1,pr_palm,sr) ! th*
+ ts_value(6,sr) = u_max
+ ts_value(7,sr) = v_max
+ ts_value(8,sr) = w_max
+ ts_value(9,sr) = hom(nzb+10,1,pr_palm,sr) ! new divergence
+ ts_value(10,sr) = hom(nzb+9,1,pr_palm,sr) ! old Divergence
+ ts_value(11,sr) = hom(nzb+6,1,pr_palm,sr) ! z_i(1)
+ ts_value(12,sr) = hom(nzb+7,1,pr_palm,sr) ! z_i(2)
+ ts_value(13,sr) = hom(nzb+8,1,pr_palm,sr) ! w*
+ ts_value(14,sr) = hom(nzb,1,16,sr) ! w'pt' at k=0
+ ts_value(15,sr) = hom(nzb+1,1,16,sr) ! w'pt' at k=1
+ ts_value(16,sr) = hom(nzb+1,1,18,sr) ! wpt at k=1
+ ts_value(17,sr) = hom(nzb,1,4,sr) ! pt(0)
+ ts_value(18,sr) = hom(nzb+1,1,4,sr) ! pt(zp)
+ ts_value(19,sr) = hom(nzb+9,1,pr_palm-1,sr) ! splptx
+ ts_value(20,sr) = hom(nzb+10,1,pr_palm-1,sr) ! splpty
+ ts_value(21,sr) = hom(nzb+11,1,pr_palm-1,sr) ! splptz
+ IF ( ts_value(5,sr) /= 0.0 ) THEN
+ ts_value(22,sr) = ts_value(4,sr)**2 / &
+ ( kappa * g * ts_value(5,sr) / ts_value(18,sr) ) ! L
+ ELSE
+ ts_value(22,sr) = 10000.0
+ ENDIF
+
+!
+!-- Calculate additional statistics provided by the user interface
+ CALL user_statistics( 'time_series', sr, 0 )
+
+ ENDDO ! loop of the subregions
+
+!
+!-- If required, sum up horizontal averages for subsequent time averaging
+ IF ( do_sum ) THEN
+ IF ( average_count_pr == 0 ) hom_sum = 0.0
+ hom_sum = hom_sum + hom(:,1,:,:)
+ average_count_pr = average_count_pr + 1
+ do_sum = .FALSE.
+ ENDIF
+
+!
+!-- Set flag for other UPs (e.g. output routines, but also buoyancy).
+!-- This flag is reset after each time step in time_integration.
+ flow_statistics_called = .TRUE.
+
+ CALL cpu_log( log_point(10), 'flow_statistics', 'stop' )
+
+
+ END SUBROUTINE flow_statistics
+
+
+
Index: /palm/tags/release-3.4a/SOURCE/global_min_max.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/global_min_max.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/global_min_max.f90 (revision 141)
@@ -0,0 +1,226 @@
+ SUBROUTINE global_min_max( i1, i2, j1, j2, k1, k2, ar, mode, value, &
+ value_ijk, value1, value1_ijk )
+
+!-------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.11 2003/04/16 12:56:58 raasch
+! Index values of the extrema are limited to the range 0..nx, 0..ny
+!
+! Revision 1.1 1997/07/24 11:14:03 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Determine the array minimum/maximum and the corresponding indices.
+!-------------------------------------------------------------------------------!
+
+ USE indices
+ USE pegrid
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: mode
+
+ INTEGER :: i, i1, i2, id_fmax, id_fmin, j, j1, j2, k, k1, k2, &
+ fmax_ijk(3), fmax_ijk_l(3), fmin_ijk(3), &
+ fmin_ijk_l(3), value_ijk(3)
+ INTEGER, OPTIONAL :: value1_ijk(3)
+ REAL :: value, &
+ ar(i1:i2,j1:j2,k1:k2)
+#if defined( __ibm )
+ REAL (KIND=4) :: fmax(2), fmax_l(2), fmin(2), fmin_l(2) ! on 32bit-
+ ! machines MPI_2REAL must not be replaced by
+ ! MPI_2DOUBLE_PRECISION
+#else
+ REAL :: fmax(2), fmax_l(2), fmin(2), fmin_l(2)
+#endif
+ REAL, OPTIONAL :: value1
+
+
+!
+!-- Determine array minimum
+ IF ( mode == 'min' .OR. mode == 'minmax' ) THEN
+
+!
+!-- Determine the local minimum
+ fmin_ijk_l = MINLOC( ar )
+ fmin_ijk_l(1) = i1 + fmin_ijk_l(1) - 1 ! MINLOC assumes lowerbound = 1
+ fmin_ijk_l(2) = j1 + fmin_ijk_l(2) - 1
+ fmin_ijk_l(3) = k1 + fmin_ijk_l(3) - 1
+ fmin_l(1) = ar(fmin_ijk_l(1),fmin_ijk_l(2),fmin_ijk_l(3))
+
+#if defined( __parallel )
+ fmin_l(2) = myid
+ CALL MPI_ALLREDUCE( fmin_l, fmin, 1, MPI_2REAL, MPI_MINLOC, comm2d, ierr )
+
+!
+!-- Determine the global minimum. Result stored on PE0.
+ id_fmin = fmin(2)
+ IF ( id_fmin /= 0 ) THEN
+ IF ( myid == 0 ) THEN
+ CALL MPI_RECV( fmin_ijk, 3, MPI_INTEGER, id_fmin, 0, comm2d, &
+ status, ierr )
+ ELSEIF ( myid == id_fmin ) THEN
+ CALL MPI_SEND( fmin_ijk_l, 3, MPI_INTEGER, 0, 0, comm2d, ierr )
+ ENDIF
+ ELSE
+ fmin_ijk = fmin_ijk_l
+ ENDIF
+!
+!-- Send the indices of the just determined array minimum to other PEs
+ CALL MPI_BCAST( fmin_ijk, 3, MPI_INTEGER, 0, comm2d, ierr )
+#else
+ fmin(1) = fmin_l(1)
+ fmin_ijk = fmin_ijk_l
+#endif
+
+ ENDIF
+
+!
+!-- Determine array maximum
+ IF ( mode == 'max' .OR. mode == 'minmax' ) THEN
+
+!
+!-- Determine the local maximum
+ fmax_ijk_l = MAXLOC( ar )
+ fmax_ijk_l(1) = i1 + fmax_ijk_l(1) - 1 ! MAXLOC assumes lowerbound = 1
+ fmax_ijk_l(2) = j1 + fmax_ijk_l(2) - 1
+ fmax_ijk_l(3) = k1 + fmax_ijk_l(3) - 1
+ fmax_l(1) = ar(fmax_ijk_l(1),fmax_ijk_l(2),fmax_ijk_l(3))
+
+#if defined( __parallel )
+ fmax_l(2) = myid
+ CALL MPI_ALLREDUCE( fmax_l, fmax, 1, MPI_2REAL, MPI_MAXLOC, comm2d, ierr )
+
+!
+!-- Determine the global maximum. Result stored on PE0.
+ id_fmax = fmax(2)
+ IF ( id_fmax /= 0 ) THEN
+ IF ( myid == 0 ) THEN
+ CALL MPI_RECV( fmax_ijk, 3, MPI_INTEGER, id_fmax, 0, comm2d, &
+ status, ierr )
+ ELSEIF ( myid == id_fmax ) THEN
+ CALL MPI_SEND( fmax_ijk_l, 3, MPI_INTEGER, 0, 0, comm2d, ierr )
+ ENDIF
+ ELSE
+ fmax_ijk = fmax_ijk_l
+ ENDIF
+!
+!-- send the indices of the just determined array maximum to other PEs
+ CALL MPI_BCAST( fmax_ijk, 3, MPI_INTEGER, 0, comm2d, ierr )
+#else
+ fmax(1) = fmax_l(1)
+ fmax_ijk = fmax_ijk_l
+#endif
+
+ ENDIF
+
+!
+!-- Determine absolute array maximum
+ IF ( mode == 'abs' ) THEN
+
+!
+!-- Determine the local absolut maximum
+ fmax_l(1) = 0.0
+ fmax_ijk_l(1) = i1
+ fmax_ijk_l(2) = j1
+ fmax_ijk_l(3) = k1
+ DO k = k1, k2
+ DO j = j1, j2
+ DO i = i1, i2
+ IF ( ABS( ar(i,j,k) ) > fmax_l(1) ) THEN
+ fmax_l(1) = ABS( ar(i,j,k) )
+ fmax_ijk_l(1) = i
+ fmax_ijk_l(2) = j
+ fmax_ijk_l(3) = k
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Set a flag in case that the determined value is negative.
+!-- A constant offset has to be subtracted in order to handle the special
+!-- case i=0 correctly
+ IF ( ar(fmax_ijk_l(1),fmax_ijk_l(2),fmax_ijk_l(3)) < 0.0 ) THEN
+ fmax_ijk_l(1) = -fmax_ijk_l(1) - 10
+ ENDIF
+
+#if defined( __parallel )
+ fmax_l(2) = myid
+ CALL MPI_ALLREDUCE( fmax_l, fmax, 1, MPI_2REAL, MPI_MAXLOC, comm2d, &
+ ierr )
+
+!
+!-- Determine the global absolut maximum. Result stored on PE0.
+ id_fmax = fmax(2)
+ IF ( id_fmax /= 0 ) THEN
+ IF ( myid == 0 ) THEN
+ CALL MPI_RECV( fmax_ijk, 3, MPI_INTEGER, id_fmax, 0, comm2d, &
+ status, ierr )
+ ELSEIF ( myid == id_fmax ) THEN
+ CALL MPI_SEND( fmax_ijk_l, 3, MPI_INTEGER, 0, 0, comm2d, ierr )
+ ENDIF
+ ELSE
+ fmax_ijk = fmax_ijk_l
+ ENDIF
+!
+!-- Send the indices of the just determined absolut maximum to other PEs
+ CALL MPI_BCAST( fmax_ijk, 3, MPI_INTEGER, 0, comm2d, ierr )
+#else
+ fmax(1) = fmax_l(1)
+ fmax_ijk = fmax_ijk_l
+#endif
+
+ ENDIF
+
+!
+!-- Determine output parameters
+ SELECT CASE( mode )
+
+ CASE( 'min' )
+
+ value = fmin(1)
+ value_ijk = fmin_ijk
+
+ CASE( 'max' )
+
+ value = fmax(1)
+ value_ijk = fmax_ijk
+
+ CASE( 'minmax' )
+
+ value = fmin(1)
+ value_ijk = fmin_ijk
+ value1 = fmax(1)
+ value1_ijk = fmax_ijk
+
+ CASE( 'abs' )
+
+ value = fmax(1)
+ value_ijk = fmax_ijk
+ IF ( fmax_ijk(1) < 0 ) THEN
+ value = -value
+ value_ijk(1) = -value_ijk(1) - 10
+ ENDIF
+
+ END SELECT
+
+!
+!-- Limit index values to the range 0..nx, 0..ny
+ IF ( value_ijk(3) == -1 ) value_ijk(3) = nx
+ IF ( value_ijk(3) == nx+1 ) value_ijk(3) = 0
+ IF ( value_ijk(2) == -1 ) value_ijk(2) = ny
+ IF ( value_ijk(2) == ny+1 ) value_ijk(2) = 0
+
+
+ END SUBROUTINE global_min_max
Index: /palm/tags/release-3.4a/SOURCE/header.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/header.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/header.f90 (revision 141)
@@ -0,0 +1,1603 @@
+ SUBROUTINE header
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 138 2007-11-28 10:03:58Z letzel
+! Allow new case bc_uv_t = 'dirichlet_0' for channel flow.
+! Allow two instead of one digit to specify isosurface and slicer variables.
+! Output of sorting frequency of particles
+!
+! 108 2007-08-24 15:10:38Z letzel
+! Output of informations for coupled model runs (boundary conditions etc.)
+! + output of momentumfluxes at the top boundary
+! Rayleigh damping for ocean, e_init
+!
+! 97 2007-06-21 08:23:15Z raasch
+! Adjustments for the ocean version.
+! use_pt_reference renamed use_reference
+!
+! 87 2007-05-22 15:46:47Z raasch
+! Bugfix: output of use_upstream_for_tke
+!
+! 82 2007-04-16 15:40:52Z raasch
+! Preprocessor strings for different linux clusters changed to "lc",
+! routine local_flush is used for buffer flushing
+!
+! 76 2007-03-29 00:58:32Z raasch
+! Output of netcdf_64bit_3d, particles-package is now part of the default code,
+! output of the loop optimization method, moisture renamed humidity,
+! output of subversion revision number
+!
+! 19 2007-02-23 04:53:48Z raasch
+! Output of scalar flux applied at top boundary
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.63 2006/08/22 13:53:13 raasch
+! Output of dz_max
+!
+! Revision 1.1 1997/08/11 06:17:20 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Writing a header with all important informations about the actual run.
+! This subroutine is called three times, two times at the beginning
+! (writing information on files RUN_CONTROL and HEADER) and one time at the
+! end of the run, then writing additional information about CPU-usage on file
+! header.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE cloud_parameters
+ USE cpulog
+ USE dvrp_variables
+ USE grid_variables
+ USE indices
+ USE model_1d
+ USE particle_attributes
+ USE pegrid
+ USE spectrum
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=1) :: prec
+ CHARACTER (LEN=2) :: do2d_mode
+ CHARACTER (LEN=5) :: section_chr
+ CHARACTER (LEN=9) :: time_to_string
+ CHARACTER (LEN=10) :: coor_chr, host_chr
+ CHARACTER (LEN=16) :: begin_chr
+ CHARACTER (LEN=21) :: ver_rev
+ CHARACTER (LEN=40) :: output_format
+ CHARACTER (LEN=70) :: char1, char2, coordinates, gradients, dopr_chr, &
+ do2d_xy, do2d_xz, do2d_yz, do3d_chr, &
+ run_classification, slices, temperatures, learde, &
+ ugcomponent, vgcomponent
+ CHARACTER (LEN=85) :: roben, runten
+
+ INTEGER :: av, bh, blx, bly, bxl, bxr, byn, bys, i, ihost, io, j, l, ll
+ REAL :: cpuseconds_per_simulated_second
+
+!
+!-- Open the output file. At the end of the simulation, output is directed
+!-- to unit 19.
+ IF ( ( runnr == 0 .OR. force_print_header ) .AND. &
+ .NOT. simulated_time_at_begin /= simulated_time ) THEN
+ io = 15 ! header output on file RUN_CONTROL
+ ELSE
+ io = 19 ! header output on file HEADER
+ ENDIF
+ CALL check_open( io )
+
+!
+!-- At the end of the run, output file (HEADER) will be rewritten with
+!-- new informations
+ IF ( io == 19 .AND. simulated_time_at_begin /= simulated_time ) REWIND( 19 )
+
+!
+!-- Determine kind of model run
+ IF ( TRIM( initializing_actions ) == 'read_restart_data' ) THEN
+ run_classification = '3D - restart run'
+ ELSE
+ IF ( INDEX( initializing_actions, 'set_constant_profiles' ) /= 0 ) THEN
+ run_classification = '3D - run without 1D - prerun'
+ ELSEIF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 ) THEN
+ run_classification = '3D - run with 1D - prerun'
+ ELSE
+ PRINT*,'+++ header: unknown action(s): ',initializing_actions
+ ENDIF
+ ENDIF
+ IF ( ocean ) THEN
+ run_classification = 'ocean - ' // run_classification
+ ELSE
+ run_classification = 'atmosphere - ' // run_classification
+ ENDIF
+
+!
+!-- Run-identification, date, time, host
+ host_chr = host(1:10)
+ ver_rev = TRIM( version ) // ' ' // TRIM( revision )
+ WRITE ( io, 100 ) ver_rev, TRIM( run_classification )
+ IF ( coupling_mode /= 'uncoupled' ) WRITE ( io, 101 ) coupling_mode
+ WRITE ( io, 102 ) run_date, run_identifier, run_time, runnr, &
+ ADJUSTR( host_chr )
+#if defined( __parallel )
+ IF ( npex == -1 .AND. pdims(2) /= 1 ) THEN
+ char1 = 'calculated'
+ ELSEIF ( ( host(1:3) == 'ibm' .OR. host(1:3) == 'nec' .OR. &
+ host(1:2) == 'lc' ) .AND. &
+ npex == -1 .AND. pdims(2) == 1 ) THEN
+ char1 = 'forced'
+ ELSE
+ char1 = 'predefined'
+ ENDIF
+ IF ( threads_per_task == 1 ) THEN
+ WRITE ( io, 103 ) numprocs, pdims(1), pdims(2), TRIM( char1 )
+ ELSE
+ WRITE ( io, 104 ) numprocs*threads_per_task, numprocs, &
+ threads_per_task, pdims(1), pdims(2), TRIM( char1 )
+ ENDIF
+ IF ( ( host(1:3) == 'ibm' .OR. host(1:3) == 'nec' .OR. &
+ host(1:2) == 'lc' .OR. host(1:3) == 'dec' ) .AND. &
+ npex == -1 .AND. pdims(2) == 1 ) &
+ THEN
+ WRITE ( io, 106 )
+ ELSEIF ( pdims(2) == 1 ) THEN
+ WRITE ( io, 107 ) 'x'
+ ELSEIF ( pdims(1) == 1 ) THEN
+ WRITE ( io, 107 ) 'y'
+ ENDIF
+ IF ( use_seperate_pe_for_dvrp_output ) WRITE ( io, 105 )
+#endif
+ WRITE ( io, 99 )
+
+!
+!-- Numerical schemes
+ WRITE ( io, 110 )
+ IF ( psolver(1:7) == 'poisfft' ) THEN
+ WRITE ( io, 111 ) TRIM( fft_method )
+ IF ( psolver == 'poisfft_hybrid' ) WRITE ( io, 138 )
+ ELSEIF ( psolver == 'sor' ) THEN
+ WRITE ( io, 112 ) nsor_ini, nsor, omega_sor
+ ELSEIF ( psolver == 'multigrid' ) THEN
+ WRITE ( io, 135 ) cycle_mg, maximum_grid_level, ngsrb
+ IF ( mg_cycles == -1 ) THEN
+ WRITE ( io, 140 ) residual_limit
+ ELSE
+ WRITE ( io, 141 ) mg_cycles
+ ENDIF
+ IF ( mg_switch_to_pe0_level == 0 ) THEN
+ WRITE ( io, 136 ) nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
+ nzt_mg(1)
+ ELSE
+ WRITE ( io, 137 ) mg_switch_to_pe0_level, &
+ mg_loc_ind(2,0)-mg_loc_ind(1,0)+1, &
+ mg_loc_ind(4,0)-mg_loc_ind(3,0)+1, &
+ nzt_mg(mg_switch_to_pe0_level), &
+ nxr_mg(1)-nxl_mg(1)+1, nyn_mg(1)-nys_mg(1)+1, &
+ nzt_mg(1)
+ ENDIF
+ ENDIF
+ IF ( call_psolver_at_all_substeps .AND. timestep_scheme(1:5) == 'runge' ) &
+ THEN
+ WRITE ( io, 142 )
+ ENDIF
+
+ IF ( momentum_advec == 'pw-scheme' ) THEN
+ WRITE ( io, 113 )
+ ELSE
+ WRITE ( io, 114 )
+ IF ( cut_spline_overshoot ) WRITE ( io, 124 )
+ IF ( overshoot_limit_u /= 0.0 .OR. overshoot_limit_v /= 0.0 .OR. &
+ overshoot_limit_w /= 0.0 ) THEN
+ WRITE ( io, 127 ) overshoot_limit_u, overshoot_limit_v, &
+ overshoot_limit_w
+ ENDIF
+ IF ( ups_limit_u /= 0.0 .OR. ups_limit_v /= 0.0 .OR. &
+ ups_limit_w /= 0.0 ) &
+ THEN
+ WRITE ( io, 125 ) ups_limit_u, ups_limit_v, ups_limit_w
+ ENDIF
+ IF ( long_filter_factor /= 0.0 ) WRITE ( io, 115 ) long_filter_factor
+ ENDIF
+ IF ( scalar_advec == 'pw-scheme' ) THEN
+ WRITE ( io, 116 )
+ ELSEIF ( scalar_advec == 'ups-scheme' ) THEN
+ WRITE ( io, 117 )
+ IF ( cut_spline_overshoot ) WRITE ( io, 124 )
+ IF ( overshoot_limit_e /= 0.0 .OR. overshoot_limit_pt /= 0.0 ) THEN
+ WRITE ( io, 128 ) overshoot_limit_e, overshoot_limit_pt
+ ENDIF
+ IF ( ups_limit_e /= 0.0 .OR. ups_limit_pt /= 0.0 ) THEN
+ WRITE ( io, 126 ) ups_limit_e, ups_limit_pt
+ ENDIF
+ ELSE
+ WRITE ( io, 118 )
+ ENDIF
+
+ WRITE ( io, 139 ) TRIM( loop_optimization )
+
+ IF ( galilei_transformation ) THEN
+ IF ( use_ug_for_galilei_tr ) THEN
+ char1 = 'geostrophic wind'
+ ELSE
+ char1 = 'mean wind in model domain'
+ ENDIF
+ IF ( simulated_time_at_begin == simulated_time ) THEN
+ char2 = 'at the start of the run'
+ ELSE
+ char2 = 'at the end of the run'
+ ENDIF
+ WRITE ( io, 119 ) TRIM( char1 ), TRIM( char2 ), &
+ advected_distance_x/1000.0, advected_distance_y/1000.0
+ ENDIF
+ IF ( timestep_scheme == 'leapfrog' ) THEN
+ WRITE ( io, 120 )
+ ELSEIF ( timestep_scheme == 'leapfrog+euler' ) THEN
+ WRITE ( io, 121 )
+ ELSE
+ WRITE ( io, 122 ) timestep_scheme
+ ENDIF
+ IF ( use_upstream_for_tke ) WRITE ( io, 143 )
+ IF ( rayleigh_damping_factor /= 0.0 ) THEN
+ IF ( .NOT. ocean ) THEN
+ WRITE ( io, 123 ) 'above', rayleigh_damping_height, &
+ rayleigh_damping_factor
+ ELSE
+ WRITE ( io, 123 ) 'below', rayleigh_damping_height, &
+ rayleigh_damping_factor
+ ENDIF
+ ENDIF
+ IF ( humidity ) THEN
+ IF ( .NOT. cloud_physics ) THEN
+ WRITE ( io, 129 )
+ ELSE
+ WRITE ( io, 130 )
+ WRITE ( io, 131 )
+ IF ( radiation ) WRITE ( io, 132 )
+ IF ( precipitation ) WRITE ( io, 133 )
+ ENDIF
+ ENDIF
+ IF ( passive_scalar ) WRITE ( io, 134 )
+ IF ( conserve_volume_flow ) WRITE ( io, 150 )
+ WRITE ( io, 99 )
+
+!
+!-- Runtime and timestep informations
+ WRITE ( io, 200 )
+ IF ( .NOT. dt_fixed ) THEN
+ WRITE ( io, 201 ) dt_max, cfl_factor
+ ELSE
+ WRITE ( io, 202 ) dt
+ ENDIF
+ WRITE ( io, 203 ) simulated_time_at_begin, end_time
+
+ IF ( time_restart /= 9999999.9 .AND. &
+ simulated_time_at_begin == simulated_time ) THEN
+ IF ( dt_restart == 9999999.9 ) THEN
+ WRITE ( io, 204 ) ' Restart at: ',time_restart
+ ELSE
+ WRITE ( io, 205 ) ' Restart at: ',time_restart, dt_restart
+ ENDIF
+ ENDIF
+
+ IF ( simulated_time_at_begin /= simulated_time ) THEN
+ i = MAX ( log_point_s(10)%counts, 1 )
+ IF ( ( simulated_time - simulated_time_at_begin ) == 0.0 ) THEN
+ cpuseconds_per_simulated_second = 0.0
+ ELSE
+ cpuseconds_per_simulated_second = log_point_s(10)%sum / &
+ ( simulated_time - &
+ simulated_time_at_begin )
+ ENDIF
+ WRITE ( io, 206 ) simulated_time, log_point_s(10)%sum, &
+ log_point_s(10)%sum / REAL( i ), &
+ cpuseconds_per_simulated_second
+ IF ( time_restart /= 9999999.9 .AND. time_restart < end_time ) THEN
+ IF ( dt_restart == 9999999.9 ) THEN
+ WRITE ( io, 204 ) ' Next restart at: ',time_restart
+ ELSE
+ WRITE ( io, 205 ) ' Next restart at: ',time_restart, dt_restart
+ ENDIF
+ ENDIF
+ ENDIF
+
+!
+!-- Computational grid
+ IF ( .NOT. ocean ) THEN
+ WRITE ( io, 250 ) dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(nzt+1)
+ IF ( dz_stretch_level_index < nzt+1 ) THEN
+ WRITE ( io, 252 ) dz_stretch_level, dz_stretch_level_index, &
+ dz_stretch_factor, dz_max
+ ENDIF
+ ELSE
+ WRITE ( io, 250 ) dx, dy, dz, (nx+1)*dx, (ny+1)*dy, zu(0)
+ IF ( dz_stretch_level_index > 0 ) THEN
+ WRITE ( io, 252 ) dz_stretch_level, dz_stretch_level_index, &
+ dz_stretch_factor, dz_max
+ ENDIF
+ ENDIF
+ WRITE ( io, 254 ) nx, ny, nzt+1, MIN( nnx, nx+1 ), MIN( nny, ny+1 ), &
+ MIN( nnz+2, nzt+2 )
+ IF ( numprocs > 1 ) THEN
+ IF ( nxa == nx .AND. nya == ny .AND. nza == nz ) THEN
+ WRITE ( io, 255 )
+ ELSE
+ WRITE ( io, 256 ) nnx-(nxa-nx), nny-(nya-ny), nzt+2
+ ENDIF
+ ENDIF
+ IF ( sloping_surface ) WRITE ( io, 260 ) alpha_surface
+
+!
+!-- Topography
+ WRITE ( io, 270 ) topography
+ SELECT CASE ( TRIM( topography ) )
+
+ CASE ( 'flat' )
+ ! no actions necessary
+
+ CASE ( 'single_building' )
+ blx = INT( building_length_x / dx )
+ bly = INT( building_length_y / dy )
+ bh = INT( building_height / dz )
+
+ IF ( building_wall_left == 9999999.9 ) THEN
+ building_wall_left = ( nx + 1 - blx ) / 2 * dx
+ ENDIF
+ bxl = INT ( building_wall_left / dx + 0.5 )
+ bxr = bxl + blx
+
+ IF ( building_wall_south == 9999999.9 ) THEN
+ building_wall_south = ( ny + 1 - bly ) / 2 * dy
+ ENDIF
+ bys = INT ( building_wall_south / dy + 0.5 )
+ byn = bys + bly
+
+ WRITE ( io, 271 ) building_length_x, building_length_y, &
+ building_height, bxl, bxr, bys, byn
+
+ END SELECT
+
+ IF ( plant_canopy ) THEN
+
+ WRITE ( io, 280 ) canopy_mode, pch_index, drag_coefficient
+
+!
+!-- Leaf area density profile
+!-- Building output strings, starting with surface value
+ WRITE ( learde, '(F6.2)' ) lad_surface
+ gradients = '------'
+ slices = ' 0'
+ coordinates = ' 0.0'
+ i = 1
+ DO WHILE ( lad_vertical_gradient_level_ind(i) /= -9999 )
+
+ WRITE (coor_chr,'(F7.2)') lad(lad_vertical_gradient_level_ind(i))
+ learde = TRIM( learde ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(F7.2)') lad_vertical_gradient(i)
+ gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(I7)') lad_vertical_gradient_level_ind(i)
+ slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(F7.1)') lad_vertical_gradient_level(i)
+ coordinates = TRIM( coordinates ) // ' ' // TRIM( coor_chr )
+
+ i = i + 1
+ ENDDO
+
+ WRITE ( io, 281 ) TRIM( coordinates ), TRIM( learde ), &
+ TRIM( gradients ), TRIM( slices )
+
+ ENDIF
+
+!
+!-- Boundary conditions
+ IF ( ibc_p_b == 0 ) THEN
+ runten = 'p(0) = 0 |'
+ ELSEIF ( ibc_p_b == 1 ) THEN
+ runten = 'p(0) = p(1) |'
+ ELSE
+ runten = 'p(0) = p(1) +R|'
+ ENDIF
+ IF ( ibc_p_t == 0 ) THEN
+ roben = 'p(nzt+1) = 0 |'
+ ELSE
+ roben = 'p(nzt+1) = p(nzt) |'
+ ENDIF
+
+ IF ( ibc_uv_b == 0 ) THEN
+ runten = TRIM( runten ) // ' uv(0) = -uv(1) |'
+ ELSE
+ runten = TRIM( runten ) // ' uv(0) = uv(1) |'
+ ENDIF
+ IF ( TRIM( bc_uv_t ) == 'dirichlet_0' ) THEN
+ roben = TRIM( roben ) // ' uv(nzt+1) = 0 |'
+ ELSEIF ( ibc_uv_t == 0 ) THEN
+ roben = TRIM( roben ) // ' uv(nzt+1) = ug(nzt+1), vg(nzt+1) |'
+ ELSE
+ roben = TRIM( roben ) // ' uv(nzt+1) = uv(nzt) |'
+ ENDIF
+
+ IF ( ibc_pt_b == 0 ) THEN
+ runten = TRIM( runten ) // ' pt(0) = pt_surface'
+ ELSEIF ( ibc_pt_b == 1 ) THEN
+ runten = TRIM( runten ) // ' pt(0) = pt(1)'
+ ELSEIF ( ibc_pt_b == 2 ) THEN
+ runten = TRIM( runten ) // ' pt(0) = from coupled model'
+ ENDIF
+ IF ( ibc_pt_t == 0 ) THEN
+ roben = TRIM( roben ) // ' pt(nzt+1) = pt_top'
+ ELSEIF( ibc_pt_t == 1 ) THEN
+ roben = TRIM( roben ) // ' pt(nzt+1) = pt(nzt)'
+ ELSEIF( ibc_pt_t == 2 ) THEN
+ roben = TRIM( roben ) // ' pt(nzt+1) = pt(nzt) + dpt/dz_ini'
+ ENDIF
+
+ WRITE ( io, 300 ) runten, roben
+
+ IF ( .NOT. constant_diffusion ) THEN
+ IF ( ibc_e_b == 1 ) THEN
+ runten = 'e(0) = e(1)'
+ ELSE
+ runten = 'e(0) = e(1) = (u*/0.1)**2'
+ ENDIF
+ roben = 'e(nzt+1) = e(nzt) = e(nzt-1)'
+
+ WRITE ( io, 301 ) 'e', runten, roben
+
+ ENDIF
+
+ IF ( ocean ) THEN
+ runten = 'sa(0) = sa(1)'
+ IF ( ibc_sa_t == 0 ) THEN
+ roben = 'sa(nzt+1) = sa_surface'
+ ELSE
+ roben = 'sa(nzt+1) = sa(nzt)'
+ ENDIF
+ WRITE ( io, 301 ) 'sa', runten, roben
+ ENDIF
+
+ IF ( humidity ) THEN
+ IF ( ibc_q_b == 0 ) THEN
+ runten = 'q(0) = q_surface'
+ ELSE
+ runten = 'q(0) = q(1)'
+ ENDIF
+ IF ( ibc_q_t == 0 ) THEN
+ roben = 'q(nzt) = q_top'
+ ELSE
+ roben = 'q(nzt) = q(nzt-1) + dq/dz'
+ ENDIF
+ WRITE ( io, 301 ) 'q', runten, roben
+ ENDIF
+
+ IF ( passive_scalar ) THEN
+ IF ( ibc_q_b == 0 ) THEN
+ runten = 's(0) = s_surface'
+ ELSE
+ runten = 's(0) = s(1)'
+ ENDIF
+ IF ( ibc_q_t == 0 ) THEN
+ roben = 's(nzt) = s_top'
+ ELSE
+ roben = 's(nzt) = s(nzt-1) + ds/dz'
+ ENDIF
+ WRITE ( io, 301 ) 's', runten, roben
+ ENDIF
+
+ IF ( use_surface_fluxes ) THEN
+ WRITE ( io, 303 )
+ IF ( constant_heatflux ) THEN
+ WRITE ( io, 306 ) surface_heatflux
+ IF ( random_heatflux ) WRITE ( io, 307 )
+ ENDIF
+ IF ( humidity .AND. constant_waterflux ) THEN
+ WRITE ( io, 311 ) surface_waterflux
+ ENDIF
+ IF ( passive_scalar .AND. constant_waterflux ) THEN
+ WRITE ( io, 313 ) surface_waterflux
+ ENDIF
+ ENDIF
+
+ IF ( use_top_fluxes ) THEN
+ WRITE ( io, 304 )
+ IF ( coupling_mode == 'uncoupled' ) THEN
+ WRITE ( io, 319 ) top_momentumflux_u, top_momentumflux_v
+ IF ( constant_top_heatflux ) THEN
+ WRITE ( io, 306 ) top_heatflux
+ ENDIF
+ ELSEIF ( coupling_mode == 'ocean_to_atmosphere' ) THEN
+ WRITE ( io, 316 )
+ ENDIF
+ IF ( ocean .AND. constant_top_salinityflux ) THEN
+ WRITE ( io, 309 ) top_salinityflux
+ ENDIF
+ IF ( humidity .OR. passive_scalar ) THEN
+ WRITE ( io, 315 )
+ ENDIF
+ ENDIF
+
+ IF ( prandtl_layer ) THEN
+ WRITE ( io, 305 ) 0.5 * (zu(1)-zu(0)), roughness_length, kappa, &
+ rif_min, rif_max
+ IF ( .NOT. constant_heatflux ) WRITE ( io, 308 )
+ IF ( humidity .AND. .NOT. constant_waterflux ) THEN
+ WRITE ( io, 312 )
+ ENDIF
+ IF ( passive_scalar .AND. .NOT. constant_waterflux ) THEN
+ WRITE ( io, 314 )
+ ENDIF
+ ELSE
+ IF ( INDEX(initializing_actions, 'set_1d-model_profiles') /= 0 ) THEN
+ WRITE ( io, 310 ) rif_min, rif_max
+ ENDIF
+ ENDIF
+
+ WRITE ( io, 317 ) bc_lr, bc_ns
+ IF ( bc_lr /= 'cyclic' .OR. bc_ns /= 'cyclic' ) THEN
+ WRITE ( io, 318 ) outflow_damping_width, km_damp_max
+ ENDIF
+
+!
+!-- Listing of 1D-profiles
+ WRITE ( io, 320 ) dt_dopr_listing
+ IF ( averaging_interval_pr /= 0.0 ) THEN
+ WRITE ( io, 321 ) averaging_interval_pr, dt_averaging_input_pr
+ ENDIF
+
+!
+!-- DATA output
+ WRITE ( io, 330 )
+ IF ( averaging_interval_pr /= 0.0 ) THEN
+ WRITE ( io, 321 ) averaging_interval_pr, dt_averaging_input_pr
+ ENDIF
+
+!
+!-- 1D-profiles
+ dopr_chr = 'Profile:'
+ IF ( dopr_n /= 0 ) THEN
+ WRITE ( io, 331 )
+
+ output_format = ''
+ IF ( netcdf_output ) THEN
+ IF ( netcdf_64bit ) THEN
+ output_format = 'netcdf (64 bit offset)'
+ ELSE
+ output_format = 'netcdf'
+ ENDIF
+ ENDIF
+ IF ( profil_output ) THEN
+ IF ( netcdf_output ) THEN
+ output_format = TRIM( output_format ) // ' and profil'
+ ELSE
+ output_format = 'profil'
+ ENDIF
+ ENDIF
+ WRITE ( io, 345 ) output_format
+
+ DO i = 1, dopr_n
+ dopr_chr = TRIM( dopr_chr ) // ' ' // TRIM( data_output_pr(i) ) // ','
+ IF ( LEN_TRIM( dopr_chr ) >= 60 ) THEN
+ WRITE ( io, 332 ) dopr_chr
+ dopr_chr = ' :'
+ ENDIF
+ ENDDO
+
+ IF ( dopr_chr /= '' ) THEN
+ WRITE ( io, 332 ) dopr_chr
+ ENDIF
+ WRITE ( io, 333 ) dt_dopr, averaging_interval_pr, dt_averaging_input_pr
+ IF ( skip_time_dopr /= 0.0 ) WRITE ( io, 339 ) skip_time_dopr
+ ENDIF
+
+!
+!-- 2D-arrays
+ DO av = 0, 1
+
+ i = 1
+ do2d_xy = ''
+ do2d_xz = ''
+ do2d_yz = ''
+ DO WHILE ( do2d(av,i) /= ' ' )
+
+ l = MAX( 2, LEN_TRIM( do2d(av,i) ) )
+ do2d_mode = do2d(av,i)(l-1:l)
+
+ SELECT CASE ( do2d_mode )
+ CASE ( 'xy' )
+ ll = LEN_TRIM( do2d_xy )
+ do2d_xy = do2d_xy(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
+ CASE ( 'xz' )
+ ll = LEN_TRIM( do2d_xz )
+ do2d_xz = do2d_xz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
+ CASE ( 'yz' )
+ ll = LEN_TRIM( do2d_yz )
+ do2d_yz = do2d_yz(1:ll) // ' ' // do2d(av,i)(1:l-3) // ','
+ END SELECT
+
+ i = i + 1
+
+ ENDDO
+
+ IF ( ( ( do2d_xy /= '' .AND. section(1,1) /= -9999 ) .OR. &
+ ( do2d_xz /= '' .AND. section(1,2) /= -9999 ) .OR. &
+ ( do2d_yz /= '' .AND. section(1,3) /= -9999 ) ) .AND. &
+ ( netcdf_output .OR. iso2d_output ) ) THEN
+
+ IF ( av == 0 ) THEN
+ WRITE ( io, 334 ) ''
+ ELSE
+ WRITE ( io, 334 ) '(time-averaged)'
+ ENDIF
+
+ IF ( do2d_at_begin ) THEN
+ begin_chr = 'and at the start'
+ ELSE
+ begin_chr = ''
+ ENDIF
+
+ output_format = ''
+ IF ( netcdf_output ) THEN
+ IF ( netcdf_64bit ) THEN
+ output_format = 'netcdf (64 bit offset)'
+ ELSE
+ output_format = 'netcdf'
+ ENDIF
+ ENDIF
+ IF ( iso2d_output ) THEN
+ IF ( netcdf_output ) THEN
+ output_format = TRIM( output_format ) // ' and iso2d'
+ ELSE
+ output_format = 'iso2d'
+ ENDIF
+ ENDIF
+ WRITE ( io, 345 ) output_format
+
+ IF ( do2d_xy /= '' .AND. section(1,1) /= -9999 ) THEN
+ i = 1
+ slices = '/'
+ coordinates = '/'
+!
+!-- Building strings with index and coordinate informations of the
+!-- slices
+ DO WHILE ( section(i,1) /= -9999 )
+
+ WRITE (section_chr,'(I5)') section(i,1)
+ section_chr = ADJUSTL( section_chr )
+ slices = TRIM( slices ) // TRIM( section_chr ) // '/'
+
+ WRITE (coor_chr,'(F10.1)') zu(section(i,1))
+ coor_chr = ADJUSTL( coor_chr )
+ coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
+
+ i = i + 1
+ ENDDO
+ IF ( av == 0 ) THEN
+ WRITE ( io, 335 ) 'XY', do2d_xy, dt_do2d_xy, &
+ TRIM( begin_chr ), 'k', TRIM( slices ), &
+ TRIM( coordinates )
+ IF ( skip_time_do2d_xy /= 0.0 ) THEN
+ WRITE ( io, 339 ) skip_time_do2d_xy
+ ENDIF
+ ELSE
+ WRITE ( io, 342 ) 'XY', do2d_xy, dt_data_output_av, &
+ TRIM( begin_chr ), averaging_interval, &
+ dt_averaging_input, 'k', TRIM( slices ), &
+ TRIM( coordinates )
+ IF ( skip_time_data_output_av /= 0.0 ) THEN
+ WRITE ( io, 339 ) skip_time_data_output_av
+ ENDIF
+ ENDIF
+
+ ENDIF
+
+ IF ( do2d_xz /= '' .AND. section(1,2) /= -9999 ) THEN
+ i = 1
+ slices = '/'
+ coordinates = '/'
+!
+!-- Building strings with index and coordinate informations of the
+!-- slices
+ DO WHILE ( section(i,2) /= -9999 )
+
+ WRITE (section_chr,'(I5)') section(i,2)
+ section_chr = ADJUSTL( section_chr )
+ slices = TRIM( slices ) // TRIM( section_chr ) // '/'
+
+ WRITE (coor_chr,'(F10.1)') section(i,2) * dy
+ coor_chr = ADJUSTL( coor_chr )
+ coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
+
+ i = i + 1
+ ENDDO
+ IF ( av == 0 ) THEN
+ WRITE ( io, 335 ) 'XZ', do2d_xz, dt_do2d_xz, &
+ TRIM( begin_chr ), 'j', TRIM( slices ), &
+ TRIM( coordinates )
+ IF ( skip_time_do2d_xz /= 0.0 ) THEN
+ WRITE ( io, 339 ) skip_time_do2d_xz
+ ENDIF
+ ELSE
+ WRITE ( io, 342 ) 'XZ', do2d_xz, dt_data_output_av, &
+ TRIM( begin_chr ), averaging_interval, &
+ dt_averaging_input, 'j', TRIM( slices ), &
+ TRIM( coordinates )
+ IF ( skip_time_data_output_av /= 0.0 ) THEN
+ WRITE ( io, 339 ) skip_time_data_output_av
+ ENDIF
+ ENDIF
+ ENDIF
+
+ IF ( do2d_yz /= '' .AND. section(1,3) /= -9999 ) THEN
+ i = 1
+ slices = '/'
+ coordinates = '/'
+!
+!-- Building strings with index and coordinate informations of the
+!-- slices
+ DO WHILE ( section(i,3) /= -9999 )
+
+ WRITE (section_chr,'(I5)') section(i,3)
+ section_chr = ADJUSTL( section_chr )
+ slices = TRIM( slices ) // TRIM( section_chr ) // '/'
+
+ WRITE (coor_chr,'(F10.1)') section(i,3) * dx
+ coor_chr = ADJUSTL( coor_chr )
+ coordinates = TRIM( coordinates ) // TRIM( coor_chr ) // '/'
+
+ i = i + 1
+ ENDDO
+ IF ( av == 0 ) THEN
+ WRITE ( io, 335 ) 'YZ', do2d_yz, dt_do2d_yz, &
+ TRIM( begin_chr ), 'i', TRIM( slices ), &
+ TRIM( coordinates )
+ IF ( skip_time_do2d_yz /= 0.0 ) THEN
+ WRITE ( io, 339 ) skip_time_do2d_yz
+ ENDIF
+ ELSE
+ WRITE ( io, 342 ) 'YZ', do2d_yz, dt_data_output_av, &
+ TRIM( begin_chr ), averaging_interval, &
+ dt_averaging_input, 'i', TRIM( slices ), &
+ TRIM( coordinates )
+ IF ( skip_time_data_output_av /= 0.0 ) THEN
+ WRITE ( io, 339 ) skip_time_data_output_av
+ ENDIF
+ ENDIF
+ ENDIF
+
+ ENDIF
+
+ ENDDO
+
+!
+!-- 3d-arrays
+ DO av = 0, 1
+
+ i = 1
+ do3d_chr = ''
+ DO WHILE ( do3d(av,i) /= ' ' )
+
+ do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // ','
+ i = i + 1
+
+ ENDDO
+
+ IF ( do3d_chr /= '' ) THEN
+ IF ( av == 0 ) THEN
+ WRITE ( io, 336 ) ''
+ ELSE
+ WRITE ( io, 336 ) '(time-averaged)'
+ ENDIF
+
+ output_format = ''
+ IF ( netcdf_output ) THEN
+ IF ( netcdf_64bit .AND. netcdf_64bit_3d ) THEN
+ output_format = 'netcdf (64 bit offset)'
+ ELSE
+ output_format = 'netcdf'
+ ENDIF
+ ENDIF
+ IF ( avs_output ) THEN
+ IF ( netcdf_output ) THEN
+ output_format = TRIM( output_format ) // ' and avs'
+ ELSE
+ output_format = 'avs'
+ ENDIF
+ ENDIF
+ WRITE ( io, 345 ) output_format
+
+ IF ( do3d_at_begin ) THEN
+ begin_chr = 'and at the start'
+ ELSE
+ begin_chr = ''
+ ENDIF
+ IF ( av == 0 ) THEN
+ WRITE ( io, 337 ) do3d_chr, dt_do3d, TRIM( begin_chr ), &
+ zu(nz_do3d), nz_do3d
+ ELSE
+ WRITE ( io, 343 ) do3d_chr, dt_data_output_av, &
+ TRIM( begin_chr ), averaging_interval, &
+ dt_averaging_input, zu(nz_do3d), nz_do3d
+ ENDIF
+
+ IF ( do3d_compress ) THEN
+ do3d_chr = ''
+ i = 1
+ DO WHILE ( do3d(av,i) /= ' ' )
+
+ SELECT CASE ( do3d(av,i) )
+ CASE ( 'u' )
+ j = 1
+ CASE ( 'v' )
+ j = 2
+ CASE ( 'w' )
+ j = 3
+ CASE ( 'p' )
+ j = 4
+ CASE ( 'pt' )
+ j = 5
+ END SELECT
+ WRITE ( prec, '(I1)' ) plot_3d_precision(j)%precision
+ do3d_chr = TRIM( do3d_chr ) // ' ' // TRIM( do3d(av,i) ) // &
+ ':' // prec // ','
+ i = i + 1
+
+ ENDDO
+ WRITE ( io, 338 ) do3d_chr
+
+ ENDIF
+
+ IF ( av == 0 ) THEN
+ IF ( skip_time_do3d /= 0.0 ) THEN
+ WRITE ( io, 339 ) skip_time_do3d
+ ENDIF
+ ELSE
+ IF ( skip_time_data_output_av /= 0.0 ) THEN
+ WRITE ( io, 339 ) skip_time_data_output_av
+ ENDIF
+ ENDIF
+
+ ENDIF
+
+ ENDDO
+
+!
+!-- Timeseries
+ IF ( dt_dots /= 9999999.9 ) THEN
+ WRITE ( io, 340 )
+
+ output_format = ''
+ IF ( netcdf_output ) THEN
+ IF ( netcdf_64bit ) THEN
+ output_format = 'netcdf (64 bit offset)'
+ ELSE
+ output_format = 'netcdf'
+ ENDIF
+ ENDIF
+ IF ( profil_output ) THEN
+ IF ( netcdf_output ) THEN
+ output_format = TRIM( output_format ) // ' and profil'
+ ELSE
+ output_format = 'profil'
+ ENDIF
+ ENDIF
+ WRITE ( io, 345 ) output_format
+ WRITE ( io, 341 ) dt_dots
+ ENDIF
+
+#if defined( __dvrp_graphics )
+!
+!-- Dvrp-output
+ IF ( dt_dvrp /= 9999999.9 ) THEN
+ WRITE ( io, 360 ) dt_dvrp, TRIM( dvrp_output ), TRIM( dvrp_host ), &
+ TRIM( dvrp_username ), TRIM( dvrp_directory )
+ i = 1
+ l = 0
+ DO WHILE ( mode_dvrp(i) /= ' ' )
+ IF ( mode_dvrp(i)(1:10) == 'isosurface' ) THEN
+ READ ( mode_dvrp(i), '(10X,I2)' ) j
+ l = l + 1
+ IF ( do3d(0,j) /= ' ' ) THEN
+ WRITE ( io, 361 ) TRIM( do3d(0,j) ), threshold(l)
+ ENDIF
+ ELSEIF ( mode_dvrp(i)(1:6) == 'slicer' ) THEN
+ READ ( mode_dvrp(i), '(6X,I2)' ) j
+ IF ( do2d(0,j) /= ' ' ) WRITE ( io, 362 ) TRIM( do2d(0,j) )
+ ELSEIF ( mode_dvrp(i)(1:9) == 'particles' ) THEN
+ WRITE ( io, 363 )
+ ENDIF
+ i = i + 1
+ ENDDO
+ ENDIF
+#endif
+
+#if defined( __spectra )
+!
+!-- Spectra output
+ IF ( dt_dosp /= 9999999.9 ) THEN
+ WRITE ( io, 370 )
+
+ output_format = ''
+ IF ( netcdf_output ) THEN
+ IF ( netcdf_64bit ) THEN
+ output_format = 'netcdf (64 bit offset)'
+ ELSE
+ output_format = 'netcdf'
+ ENDIF
+ ENDIF
+ IF ( profil_output ) THEN
+ IF ( netcdf_output ) THEN
+ output_format = TRIM( output_format ) // ' and profil'
+ ELSE
+ output_format = 'profil'
+ ENDIF
+ ENDIF
+ WRITE ( io, 345 ) output_format
+ WRITE ( io, 371 ) dt_dosp
+ IF ( skip_time_dosp /= 0.0 ) WRITE ( io, 339 ) skip_time_dosp
+ WRITE ( io, 372 ) ( data_output_sp(i), i = 1,10 ), &
+ ( spectra_direction(i), i = 1,10 ), &
+ ( comp_spectra_level(i), i = 1,10 ), &
+ ( plot_spectra_level(i), i = 1,10 ), &
+ averaging_interval_sp, dt_averaging_input_pr
+ ENDIF
+#endif
+
+ WRITE ( io, 99 )
+
+!
+!-- Physical quantities
+ WRITE ( io, 400 )
+
+!
+!-- Geostrophic parameters
+ WRITE ( io, 410 ) omega, phi, f, fs
+
+!
+!-- Other quantities
+ WRITE ( io, 411 ) g
+ IF ( use_reference ) THEN
+ IF ( ocean ) THEN
+ WRITE ( io, 412 ) prho_reference
+ ELSE
+ WRITE ( io, 413 ) pt_reference
+ ENDIF
+ ENDIF
+
+!
+!-- Cloud physics parameters
+ IF ( cloud_physics ) THEN
+ WRITE ( io, 415 )
+ WRITE ( io, 416 ) surface_pressure, r_d, rho_surface, cp, l_v
+ ENDIF
+
+!-- Profile of the geostrophic wind (component ug)
+!-- Building output strings
+ WRITE ( ugcomponent, '(F6.2)' ) ug_surface
+ gradients = '------'
+ slices = ' 0'
+ coordinates = ' 0.0'
+ i = 1
+ DO WHILE ( ug_vertical_gradient_level_ind(i) /= -9999 )
+
+ WRITE (coor_chr,'(F6.2,4X)') ug(ug_vertical_gradient_level_ind(i))
+ ugcomponent = TRIM( ugcomponent ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(F6.2,4X)') ug_vertical_gradient(i)
+ gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(I6,4X)') ug_vertical_gradient_level_ind(i)
+ slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(F6.1,4X)') ug_vertical_gradient_level(i)
+ coordinates = TRIM( coordinates ) // ' ' // TRIM( coor_chr )
+
+ i = i + 1
+ ENDDO
+
+ WRITE ( io, 423 ) TRIM( coordinates ), TRIM( ugcomponent ), &
+ TRIM( gradients ), TRIM( slices )
+
+!-- Profile of the geostrophic wind (component vg)
+!-- Building output strings
+ WRITE ( vgcomponent, '(F6.2)' ) vg_surface
+ gradients = '------'
+ slices = ' 0'
+ coordinates = ' 0.0'
+ i = 1
+ DO WHILE ( vg_vertical_gradient_level_ind(i) /= -9999 )
+
+ WRITE (coor_chr,'(F6.2,4X)') vg(vg_vertical_gradient_level_ind(i))
+ vgcomponent = TRIM( vgcomponent ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(F6.2,4X)') vg_vertical_gradient(i)
+ gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(I6,4X)') vg_vertical_gradient_level_ind(i)
+ slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(F6.1,4X)') vg_vertical_gradient_level(i)
+ coordinates = TRIM( coordinates ) // ' ' // TRIM( coor_chr )
+
+ i = i + 1
+ ENDDO
+
+ WRITE ( io, 424 ) TRIM( coordinates ), TRIM( vgcomponent ), &
+ TRIM( gradients ), TRIM( slices )
+
+!
+!-- Initial temperature profile
+!-- Building output strings, starting with surface temperature
+ WRITE ( temperatures, '(F6.2)' ) pt_surface
+ gradients = '------'
+ slices = ' 0'
+ coordinates = ' 0.0'
+ i = 1
+ DO WHILE ( pt_vertical_gradient_level_ind(i) /= -9999 )
+
+ WRITE (coor_chr,'(F7.2)') pt_init(pt_vertical_gradient_level_ind(i))
+ temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(F7.2)') pt_vertical_gradient(i)
+ gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(I7)') pt_vertical_gradient_level_ind(i)
+ slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(F7.1)') pt_vertical_gradient_level(i)
+ coordinates = TRIM( coordinates ) // ' ' // TRIM( coor_chr )
+
+ i = i + 1
+ ENDDO
+
+ WRITE ( io, 420 ) TRIM( coordinates ), TRIM( temperatures ), &
+ TRIM( gradients ), TRIM( slices )
+
+!
+!-- Initial humidity profile
+!-- Building output strings, starting with surface humidity
+ IF ( humidity .OR. passive_scalar ) THEN
+ WRITE ( temperatures, '(E8.1)' ) q_surface
+ gradients = '--------'
+ slices = ' 0'
+ coordinates = ' 0.0'
+ i = 1
+ DO WHILE ( q_vertical_gradient_level_ind(i) /= -9999 )
+
+ WRITE (coor_chr,'(E8.1,4X)') q_init(q_vertical_gradient_level_ind(i))
+ temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(E8.1,4X)') q_vertical_gradient(i)
+ gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(I8,4X)') q_vertical_gradient_level_ind(i)
+ slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(F8.1,4X)') q_vertical_gradient_level(i)
+ coordinates = TRIM( coordinates ) // ' ' // TRIM( coor_chr )
+
+ i = i + 1
+ ENDDO
+
+ IF ( humidity ) THEN
+ WRITE ( io, 421 ) TRIM( coordinates ), TRIM( temperatures ), &
+ TRIM( gradients ), TRIM( slices )
+ ELSE
+ WRITE ( io, 422 ) TRIM( coordinates ), TRIM( temperatures ), &
+ TRIM( gradients ), TRIM( slices )
+ ENDIF
+ ENDIF
+
+!
+!-- Initial salinity profile
+!-- Building output strings, starting with surface salinity
+ IF ( ocean ) THEN
+ WRITE ( temperatures, '(F6.2)' ) sa_surface
+ gradients = '------'
+ slices = ' 0'
+ coordinates = ' 0.0'
+ i = 1
+ DO WHILE ( sa_vertical_gradient_level_ind(i) /= -9999 )
+
+ WRITE (coor_chr,'(F7.2)') sa_init(sa_vertical_gradient_level_ind(i))
+ temperatures = TRIM( temperatures ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(F7.2)') sa_vertical_gradient(i)
+ gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(I7)') sa_vertical_gradient_level_ind(i)
+ slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
+
+ WRITE (coor_chr,'(F7.1)') sa_vertical_gradient_level(i)
+ coordinates = TRIM( coordinates ) // ' ' // TRIM( coor_chr )
+
+ i = i + 1
+ ENDDO
+
+ WRITE ( io, 425 ) TRIM( coordinates ), TRIM( temperatures ), &
+ TRIM( gradients ), TRIM( slices )
+ ENDIF
+
+!
+!-- LES / turbulence parameters
+ WRITE ( io, 450 )
+
+!--
+! ... LES-constants used must still be added here
+!--
+ IF ( constant_diffusion ) THEN
+ WRITE ( io, 451 ) km_constant, km_constant/prandtl_number, &
+ prandtl_number
+ ENDIF
+ IF ( .NOT. constant_diffusion) THEN
+ IF ( e_init > 0.0 ) WRITE ( io, 455 ) e_init
+ IF ( e_min > 0.0 ) WRITE ( io, 454 ) e_min
+ IF ( wall_adjustment ) WRITE ( io, 453 ) wall_adjustment_factor
+ IF ( adjust_mixing_length .AND. prandtl_layer ) WRITE ( io, 452 )
+ ENDIF
+
+!
+!-- Special actions during the run
+ WRITE ( io, 470 )
+ IF ( create_disturbances ) THEN
+ WRITE ( io, 471 ) dt_disturb, disturbance_amplitude, &
+ zu(disturbance_level_ind_b), disturbance_level_ind_b,&
+ zu(disturbance_level_ind_t), disturbance_level_ind_t
+ IF ( bc_lr /= 'cyclic' .OR. bc_ns /= 'cyclic' ) THEN
+ WRITE ( io, 472 ) inflow_disturbance_begin, inflow_disturbance_end
+ ELSE
+ WRITE ( io, 473 ) disturbance_energy_limit
+ ENDIF
+ WRITE ( io, 474 ) TRIM( random_generator )
+ ENDIF
+ IF ( pt_surface_initial_change /= 0.0 ) THEN
+ WRITE ( io, 475 ) pt_surface_initial_change
+ ENDIF
+ IF ( humidity .AND. q_surface_initial_change /= 0.0 ) THEN
+ WRITE ( io, 476 ) q_surface_initial_change
+ ENDIF
+ IF ( passive_scalar .AND. q_surface_initial_change /= 0.0 ) THEN
+ WRITE ( io, 477 ) q_surface_initial_change
+ ENDIF
+
+ IF ( particle_advection ) THEN
+!
+!-- Particle attributes
+ WRITE ( io, 480 ) particle_advection_start, dt_prel, bc_par_lr, &
+ bc_par_ns, bc_par_b, bc_par_t, particle_maximum_age, &
+ end_time_prel, dt_sort_particles
+ IF ( use_sgs_for_particles ) WRITE ( io, 488 ) dt_min_part
+ IF ( random_start_position ) WRITE ( io, 481 )
+ IF ( particles_per_point > 1 ) WRITE ( io, 489 ) particles_per_point
+ WRITE ( io, 495 ) total_number_of_particles
+ IF ( .NOT. vertical_particle_advection ) WRITE ( io, 482 )
+ IF ( maximum_number_of_tailpoints /= 0 ) THEN
+ WRITE ( io, 483 ) maximum_number_of_tailpoints
+ IF ( minimum_tailpoint_distance /= 0 ) THEN
+ WRITE ( io, 484 ) total_number_of_tails, &
+ minimum_tailpoint_distance, &
+ maximum_tailpoint_age
+ ENDIF
+ ENDIF
+ IF ( dt_write_particle_data /= 9999999.9 ) THEN
+ WRITE ( io, 485 ) dt_write_particle_data
+ output_format = ''
+ IF ( netcdf_output ) THEN
+ IF ( netcdf_64bit ) THEN
+ output_format = 'netcdf (64 bit offset) and binary'
+ ELSE
+ output_format = 'netcdf and binary'
+ ENDIF
+ ELSE
+ output_format = 'binary'
+ ENDIF
+ WRITE ( io, 345 ) output_format
+ ENDIF
+ IF ( dt_dopts /= 9999999.9 ) WRITE ( io, 494 ) dt_dopts
+ IF ( write_particle_statistics ) WRITE ( io, 486 )
+
+ WRITE ( io, 487 ) number_of_particle_groups
+
+ DO i = 1, number_of_particle_groups
+ IF ( i == 1 .AND. density_ratio(i) == 9999999.9 ) THEN
+ WRITE ( io, 490 ) i, 0.0
+ WRITE ( io, 492 )
+ ELSE
+ WRITE ( io, 490 ) i, radius(i)
+ IF ( density_ratio(i) /= 0.0 ) THEN
+ WRITE ( io, 491 ) density_ratio(i)
+ ELSE
+ WRITE ( io, 492 )
+ ENDIF
+ ENDIF
+ WRITE ( io, 493 ) psl(i), psr(i), pss(i), psn(i), psb(i), pst(i), &
+ pdx(i), pdy(i), pdz(i)
+ ENDDO
+
+ ENDIF
+
+
+!
+!-- Parameters of 1D-model
+ IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 ) THEN
+ WRITE ( io, 500 ) end_time_1d, dt_run_control_1d, dt_pr_1d, &
+ mixing_length_1d, dissipation_1d
+ IF ( damp_level_ind_1d /= nzt+1 ) THEN
+ WRITE ( io, 502 ) zu(damp_level_ind_1d), damp_level_ind_1d
+ ENDIF
+ ENDIF
+
+!
+!-- User-defined informations
+ CALL user_header( io )
+
+ WRITE ( io, 99 )
+
+!
+!-- Write buffer contents to disc immediately
+ CALL local_flush( io )
+
+!
+!-- Here the FORMATs start
+
+ 99 FORMAT (1X,78('-'))
+100 FORMAT (/1X,'*************************',11X,42('-')/ &
+ 1X,'* ',A,' *',11X,A/ &
+ 1X,'*************************',11X,42('-'))
+101 FORMAT (37X,'coupled run: ',A/ &
+ 37X,42('-'))
+102 FORMAT (/' Date: ',A8,11X,'Run: ',A20/ &
+ ' Time: ',A8,11X,'Run-No.: ',I2.2/ &
+ ' Run on host: ',A10)
+#if defined( __parallel )
+103 FORMAT (' Number of PEs:',7X,I4,11X,'Processor grid (x,y): (',I3,',',I3, &
+ ')',1X,A)
+104 FORMAT (' Number of PEs:',7X,I4,11X,'Tasks:',I4,' threads per task:',I4/ &
+ 37X,'Processor grid (x,y): (',I3,',',I3,')',1X,A)
+105 FORMAT (37X,'One additional PE is used to handle'/37X,'the dvrp output!')
+106 FORMAT (37X,'A 1d-decomposition along x is forced'/ &
+ 37X,'because the job is running on an SMP-cluster')
+107 FORMAT (37X,'A 1d-decomposition along ',A,' is used')
+#endif
+110 FORMAT (/' Numerical Schemes:'/ &
+ ' -----------------'/)
+111 FORMAT (' --> Solve perturbation pressure via FFT using ',A,' routines')
+112 FORMAT (' --> Solve perturbation pressure via SOR-Red/Black-Schema'/ &
+ ' Iterations (initial/other): ',I3,'/',I3,' omega = ',F5.3)
+113 FORMAT (' --> Momentum advection via Piascek-Williams-Scheme (Form C3)', &
+ ' or Upstream')
+114 FORMAT (' --> Momentum advection via Upstream-Spline-Scheme')
+115 FORMAT (' Tendencies are smoothed via Long-Filter with factor ',F5.3)
+116 FORMAT (' --> Scalar advection via Piascek-Williams-Scheme (Form C3)', &
+ ' or Upstream')
+117 FORMAT (' --> Scalar advection via Upstream-Spline-Scheme')
+118 FORMAT (' --> Scalar advection via Bott-Chlond-Scheme')
+119 FORMAT (' --> Galilei-Transform applied to horizontal advection', &
+ ' Translation velocity = ',A/ &
+ ' distance advected ',A,': ',F8.3,' km(x) ',F8.3,' km(y)')
+120 FORMAT (' --> Time differencing scheme: leapfrog only (no euler in case', &
+ ' of timestep changes)')
+121 FORMAT (' --> Time differencing scheme: leapfrog + euler in case of', &
+ ' timestep changes')
+122 FORMAT (' --> Time differencing scheme: ',A)
+123 FORMAT (' --> Rayleigh-Damping active, starts ',A,' z = ',F8.2,' m'/ &
+ ' maximum damping coefficient: ',F5.3, ' 1/s')
+124 FORMAT (' Spline-overshoots are being suppressed')
+125 FORMAT (' Upstream-Scheme is used if Upstream-differences fall short', &
+ ' of'/ &
+ ' delta_u = ',F6.4,4X,'delta_v = ',F6.4,4X,'delta_w = ',F6.4)
+126 FORMAT (' Upstream-Scheme is used if Upstream-differences fall short', &
+ ' of'/ &
+ ' delta_e = ',F6.4,4X,'delta_pt = ',F6.4)
+127 FORMAT (' The following absolute overshoot differences are tolerated:'/&
+ ' delta_u = ',F6.4,4X,'delta_v = ',F6.4,4X,'delta_w = ',F6.4)
+128 FORMAT (' The following absolute overshoot differences are tolerated:'/&
+ ' delta_e = ',F6.4,4X,'delta_pt = ',F6.4)
+129 FORMAT (' --> Additional prognostic equation for the specific humidity')
+130 FORMAT (' --> Additional prognostic equation for the total water content')
+131 FORMAT (' --> Parameterization of condensation processes via (0%-or100%)')
+132 FORMAT (' --> Parameterization of long-wave radiation processes via'/ &
+ ' effective emissivity scheme')
+133 FORMAT (' --> Precipitation parameterization via Kessler-Scheme')
+134 FORMAT (' --> Additional prognostic equation for a passive scalar')
+135 FORMAT (' --> Solve perturbation pressure via multigrid method (', &
+ A,'-cycle)'/ &
+ ' number of grid levels: ',I2/ &
+ ' Gauss-Seidel red/black iterations: ',I2)
+136 FORMAT (' gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
+ I3,')')
+137 FORMAT (' level data gathered on PE0 at level: ',I2/ &
+ ' gridpoints of coarsest subdomain (x,y,z): (',I3,',',I3,',', &
+ I3,')'/ &
+ ' gridpoints of coarsest domain (x,y,z): (',I3,',',I3,',', &
+ I3,')')
+138 FORMAT (' Using hybrid version for 1d-domain-decomposition')
+139 FORMAT (' --> Loop optimization method: ',A)
+140 FORMAT (' maximum residual allowed: ',E10.3)
+141 FORMAT (' fixed number of multigrid cycles: ',I4)
+142 FORMAT (' perturbation pressure is calculated at every Runge-Kutta ', &
+ 'step')
+143 FORMAT (' Euler/upstream scheme is used for the SGS turbulent ', &
+ 'kinetic energy')
+150 FORMAT (' --> Volume flow at the right and north boundary will be ', &
+ 'conserved')
+200 FORMAT (//' Run time and time step information:'/ &
+ ' ----------------------------------'/)
+201 FORMAT ( ' Timestep: variable maximum value: ',F6.3,' s', &
+ ' CFL-factor: ',F4.2)
+202 FORMAT ( ' Timestep: dt = ',F6.3,' s'/)
+203 FORMAT ( ' Start time: ',F9.3,' s'/ &
+ ' End time: ',F9.3,' s')
+204 FORMAT ( A,F9.3,' s')
+205 FORMAT ( A,F9.3,' s',5X,'restart every',17X,F9.3,' s')
+206 FORMAT (/' Time reached: ',F9.3,' s'/ &
+ ' CPU-time used: ',F9.3,' s per timestep: ', &
+ ' ',F9.3,' s'/ &
+ ' per second of simulated tim', &
+ 'e: ',F9.3,' s')
+250 FORMAT (//' Computational grid and domain size:'/ &
+ ' ----------------------------------'// &
+ ' Grid length: dx = ',F7.3,' m dy = ',F7.3, &
+ ' m dz = ',F7.3,' m'/ &
+ ' Domain size: x = ',F10.3,' m y = ',F10.3, &
+ ' m z(u) = ',F10.3,' m'/)
+252 FORMAT (' dz constant up to ',F10.3,' m (k=',I4,'), then stretched by', &
+ ' factor: ',F5.3/ &
+ ' maximum dz not to be exceeded is dz_max = ',F10.3,' m'/)
+254 FORMAT (' Number of gridpoints (x,y,z): (0:',I4,', 0:',I4,', 0:',I4,')'/ &
+ ' Subdomain size (x,y,z): ( ',I4,', ',I4,', ',I4,')'/)
+255 FORMAT (' Subdomains have equal size')
+256 FORMAT (' Subdomains at the upper edges of the virtual processor grid ', &
+ 'have smaller sizes'/ &
+ ' Size of smallest subdomain: ( ',I4,', ',I4,', ',I4,')')
+260 FORMAT (/' The model has a slope in x-direction. Inclination angle: ',F6.2,&
+ ' degrees')
+270 FORMAT (//' Topography informations:'/ &
+ ' -----------------------'// &
+ 1X,'Topography: ',A)
+271 FORMAT ( ' Building size (x/y/z) in m: ',F5.1,' / ',F5.1,' / ',F5.1/ &
+ ' Horizontal index bounds (l/r/s/n): ',I4,' / ',I4,' / ',I4, &
+ ' / ',I4)
+280 FORMAT (//' Vegetation canopy (drag) model:'/ &
+ ' ------------------------------'// &
+ ' Canopy mode: ', A / &
+ ' Canopy top: ',I4 / &
+ ' Leaf drag coefficient: ',F6.2 /)
+281 FORMAT (/ ' Characteristic levels of the leaf area density:'// &
+ ' Height: ',A,' m'/ &
+ ' Leaf area density: ',A,' m**2/m**3'/ &
+ ' Gradient: ',A,' m**2/m**4'/ &
+ ' Gridpoint: ',A)
+
+300 FORMAT (//' Boundary conditions:'/ &
+ ' -------------------'// &
+ ' p uv ', &
+ ' pt'// &
+ ' B. bound.: ',A/ &
+ ' T. bound.: ',A)
+301 FORMAT (/' ',A// &
+ ' B. bound.: ',A/ &
+ ' T. bound.: ',A)
+303 FORMAT (/' Bottom surface fluxes are used in diffusion terms at k=1')
+304 FORMAT (/' Top surface fluxes are used in diffusion terms at k=nzt')
+305 FORMAT (//' Prandtl-Layer between bottom surface and first ', &
+ 'computational u,v-level:'// &
+ ' zp = ',F6.2,' m z0 = ',F6.4,' m kappa = ',F4.2/ &
+ ' Rif value range: ',F6.2,' <= rif <=',F6.2)
+306 FORMAT (' Predefined constant heatflux: ',F9.6,' K m/s')
+307 FORMAT (' Heatflux has a random normal distribution')
+308 FORMAT (' Predefined surface temperature')
+309 FORMAT (' Predefined constant salinityflux: ',F9.6,' psu m/s')
+310 FORMAT (//' 1D-Model:'// &
+ ' Rif value range: ',F6.2,' <= rif <=',F6.2)
+311 FORMAT (' Predefined constant humidity flux: ',E10.3,' m/s')
+312 FORMAT (' Predefined surface humidity')
+313 FORMAT (' Predefined constant scalar flux: ',E10.3,' kg/(m**2 s)')
+314 FORMAT (' Predefined scalar value at the surface')
+315 FORMAT (' Humidity / scalar flux at top surface is 0.0')
+316 FORMAT (' Sensible heatflux and momentum flux from coupled ', &
+ 'atmosphere model')
+317 FORMAT (//' Lateral boundaries:'/ &
+ ' left/right: ',A/ &
+ ' north/south: ',A)
+318 FORMAT (/' outflow damping layer width: ',I3,' gridpoints with km_', &
+ 'max =',F5.1,' m**2/s')
+319 FORMAT (' Predefined constant momentumflux: u: ',F9.6,' m**2/s**2'/ &
+ ' v: ',F9.6,' m**2/s**2')
+320 FORMAT (//' List output:'/ &
+ ' -----------'// &
+ ' 1D-Profiles:'/ &
+ ' Output every ',F8.2,' s')
+321 FORMAT (' Time averaged over ',F8.2,' s'/ &
+ ' Averaging input every ',F8.2,' s')
+330 FORMAT (//' Data output:'/ &
+ ' -----------'/)
+331 FORMAT (/' 1D-Profiles:')
+332 FORMAT (/' ',A)
+333 FORMAT (' Output every ',F8.2,' s',/ &
+ ' Time averaged over ',F8.2,' s'/ &
+ ' Averaging input every ',F8.2,' s')
+334 FORMAT (/' 2D-Arrays',A,':')
+335 FORMAT (/' ',A2,'-cross-section Arrays: ',A/ &
+ ' Output every ',F8.2,' s ',A/ &
+ ' Cross sections at ',A1,' = ',A/ &
+ ' scalar-coordinates: ',A,' m'/)
+336 FORMAT (/' 3D-Arrays',A,':')
+337 FORMAT (/' Arrays: ',A/ &
+ ' Output every ',F8.2,' s ',A/ &
+ ' Upper output limit at ',F8.2,' m (GP ',I4,')'/)
+338 FORMAT (' Compressed data output'/ &
+ ' Decimal precision: ',A/)
+339 FORMAT (' No output during initial ',F8.2,' s')
+340 FORMAT (/' Time series:')
+341 FORMAT (' Output every ',F8.2,' s'/)
+342 FORMAT (/' ',A2,'-cross-section Arrays: ',A/ &
+ ' Output every ',F8.2,' s ',A/ &
+ ' Time averaged over ',F8.2,' s'/ &
+ ' Averaging input every ',F8.2,' s'/ &
+ ' Cross sections at ',A1,' = ',A/ &
+ ' scalar-coordinates: ',A,' m'/)
+343 FORMAT (/' Arrays: ',A/ &
+ ' Output every ',F8.2,' s ',A/ &
+ ' Time averaged over ',F8.2,' s'/ &
+ ' Averaging input every ',F8.2,' s'/ &
+ ' Upper output limit at ',F8.2,' m (GP ',I4,')'/)
+345 FORMAT (' Output format: ',A/)
+#if defined( __dvrp_graphics )
+360 FORMAT (' Plot-Sequence with dvrp-software:'/ &
+ ' Output every ',F7.1,' s'/ &
+ ' Output mode: ',A/ &
+ ' Host / User: ',A,' / ',A/ &
+ ' Directory: ',A// &
+ ' The sequence contains:')
+361 FORMAT (' Isosurface of ',A,' Threshold value: ', E12.3)
+362 FORMAT (' Sectional plane ',A)
+363 FORMAT (' Particles')
+#endif
+#if defined( __spectra )
+370 FORMAT (' Spectra:')
+371 FORMAT (' Output every ',F7.1,' s'/)
+372 FORMAT (' Arrays: ', 10(A5,',')/ &
+ ' Directions: ', 10(A5,',')/ &
+ ' height levels k = ', 9(I3,','),I3,'.'/ &
+ ' height levels selected for standard plot:'/ &
+ ' k = ', 9(I3,','),I3,'.'/ &
+ ' Time averaged over ', F7.1, ' s,' / &
+ ' Profiles for the time averaging are taken every ', &
+ F6.1,' s')
+#endif
+400 FORMAT (//' Physical quantities:'/ &
+ ' -------------------'/)
+410 FORMAT (' Angular velocity : omega = ',E9.3,' rad/s'/ &
+ ' Geograph. latitude : phi = ',F4.1,' degr'/ &
+ ' Coriolis parameter : f = ',F9.6,' 1/s'/ &
+ ' f* = ',F9.6,' 1/s')
+411 FORMAT (/' Gravity : g = ',F4.1,' m/s**2')
+412 FORMAT (/' Reference density in buoyancy terms: ',F8.3,' kg/m**3')
+413 FORMAT (/' Reference temperature in buoyancy terms: ',F8.4,' K')
+415 FORMAT (/' Cloud physics parameters:'/ &
+ ' ------------------------'/)
+416 FORMAT (' Surface pressure : p_0 = ',F7.2,' hPa'/ &
+ ' Gas constant : R = ',F5.1,' J/(kg K)'/ &
+ ' Density of air : rho_0 = ',F5.3,' kg/m**3'/ &
+ ' Specific heat cap. : c_p = ',F6.1,' J/(kg K)'/ &
+ ' Vapourization heat : L_v = ',E8.2,' J/kg')
+420 FORMAT (/' Characteristic levels of the initial temperature profile:'// &
+ ' Height: ',A,' m'/ &
+ ' Temperature: ',A,' K'/ &
+ ' Gradient: ',A,' K/100m'/ &
+ ' Gridpoint: ',A)
+421 FORMAT (/' Characteristic levels of the initial humidity profile:'// &
+ ' Height: ',A,' m'/ &
+ ' Humidity: ',A,' kg/kg'/ &
+ ' Gradient: ',A,' (kg/kg)/100m'/ &
+ ' Gridpoint: ',A)
+422 FORMAT (/' Characteristic levels of the initial scalar profile:'// &
+ ' Height: ',A,' m'/ &
+ ' Scalar concentration: ',A,' kg/m**3'/ &
+ ' Gradient: ',A,' (kg/m**3)/100m'/ &
+ ' Gridpoint: ',A)
+423 FORMAT (/' Characteristic levels of the geo. wind component ug:'// &
+ ' Height: ',A,' m'/ &
+ ' ug: ',A,' m/s'/ &
+ ' Gradient: ',A,' 1/100s'/ &
+ ' Gridpoint: ',A)
+424 FORMAT (/' Characteristic levels of the geo. wind component vg:'// &
+ ' Height: ',A,' m'/ &
+ ' vg: ',A,' m/s'/ &
+ ' Gradient: ',A,' 1/100s'/ &
+ ' Gridpoint: ',A)
+425 FORMAT (/' Characteristic levels of the initial salinity profile:'// &
+ ' Height: ',A,' m'/ &
+ ' Salinity: ',A,' psu'/ &
+ ' Gradient: ',A,' psu/100m'/ &
+ ' Gridpoint: ',A)
+450 FORMAT (//' LES / Turbulence quantities:'/ &
+ ' ---------------------------'/)
+451 FORMAT (' Diffusion coefficients are constant:'/ &
+ ' Km = ',F6.2,' m**2/s Kh = ',F6.2,' m**2/s Pr = ',F5.2)
+452 FORMAT (' Mixing length is limited to the Prandtl mixing lenth.')
+453 FORMAT (' Mixing length is limited to ',F4.2,' * z')
+454 FORMAT (' TKE is not allowed to fall below ',E9.2,' (m/s)**2')
+455 FORMAT (' initial TKE is prescribed as ',E9.2,' (m/s)**2')
+470 FORMAT (//' Actions during the simulation:'/ &
+ ' -----------------------------'/)
+471 FORMAT (' Disturbance impulse (u,v) every : ',F6.2,' s'/ &
+ ' Disturbance amplitude : ',F4.2, ' m/s'/ &
+ ' Lower disturbance level : ',F8.2,' m (GP ',I4,')'/ &
+ ' Upper disturbance level : ',F8.2,' m (GP ',I4,')')
+472 FORMAT (' Disturbances continued during the run from i/j =',I4, &
+ ' to i/j =',I4)
+473 FORMAT (' Disturbances cease as soon as the disturbance energy exceeds',&
+ 1X,F5.3, ' m**2/s**2')
+474 FORMAT (' Random number generator used : ',A/)
+475 FORMAT (' The surface temperature is increased (or decreased, ', &
+ 'respectively, if'/ &
+ ' the value is negative) by ',F5.2,' K at the beginning of the',&
+ ' 3D-simulation'/)
+476 FORMAT (' The surface humidity is increased (or decreased, ',&
+ 'respectively, if the'/ &
+ ' value is negative) by ',E8.1,' kg/kg at the beginning of', &
+ ' the 3D-simulation'/)
+477 FORMAT (' The scalar value is increased at the surface (or decreased, ',&
+ 'respectively, if the'/ &
+ ' value is negative) by ',E8.1,' kg/m**3 at the beginning of', &
+ ' the 3D-simulation'/)
+480 FORMAT (' Particles:'/ &
+ ' ---------'// &
+ ' Particle advection is active (switched on at t = ', F7.1, &
+ ' s)'/ &
+ ' Start of new particle generations every ',F6.1,' s'/ &
+ ' Boundary conditions: left/right: ', A, ' north/south: ', A/&
+ ' bottom: ', A, ' top: ', A/&
+ ' Maximum particle age: ',F9.1,' s'/ &
+ ' Advection stopped at t = ',F9.1,' s'/ &
+ ' Particles are sorted every ',F9.1,' s'/)
+481 FORMAT (' Particles have random start positions'/)
+482 FORMAT (' Particles are advected only horizontally'/)
+483 FORMAT (' Particles have tails with a maximum of ',I3,' points')
+484 FORMAT (' Number of tails of the total domain: ',I10/ &
+ ' Minimum distance between tailpoints: ',F8.2,' m'/ &
+ ' Maximum age of the end of the tail: ',F8.2,' s')
+485 FORMAT (' Particle data are written on file every ', F9.1, ' s')
+486 FORMAT (' Particle statistics are written on file'/)
+487 FORMAT (' Number of particle groups: ',I2/)
+488 FORMAT (' SGS velocity components are used for particle advection'/ &
+ ' minimum timestep for advection: ', F7.5/)
+489 FORMAT (' Number of particles simultaneously released at each ', &
+ 'point: ', I5/)
+490 FORMAT (' Particle group ',I2,':'/ &
+ ' Particle radius: ',E10.3, 'm')
+491 FORMAT (' Particle inertia is activated'/ &
+ ' density_ratio (rho_fluid/rho_particle) = ',F5.3/)
+492 FORMAT (' Particles are advected only passively (no inertia)'/)
+493 FORMAT (' Boundaries of particle source: x:',F8.1,' - ',F8.1,' m'/&
+ ' y:',F8.1,' - ',F8.1,' m'/&
+ ' z:',F8.1,' - ',F8.1,' m'/&
+ ' Particle distances: dx = ',F8.1,' m dy = ',F8.1, &
+ ' m dz = ',F8.1,' m'/)
+494 FORMAT (' Output of particle time series in NetCDF format every ', &
+ F8.2,' s'/)
+495 FORMAT (' Number of particles in total domain: ',I10/)
+500 FORMAT (//' 1D-Model parameters:'/ &
+ ' -------------------'// &
+ ' Simulation time: ',F8.1,' s'/ &
+ ' Run-controll output every: ',F8.1,' s'/ &
+ ' Vertical profile output every: ',F8.1,' s'/ &
+ ' Mixing length calculation: ',A/ &
+ ' Dissipation calculation: ',A/)
+502 FORMAT (' Damping layer starts from ',F7.1,' m (GP ',I4,')'/)
+
+
+ END SUBROUTINE header
Index: /palm/tags/release-3.4a/SOURCE/impact_of_latent_heat.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/impact_of_latent_heat.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/impact_of_latent_heat.f90 (revision 141)
@@ -0,0 +1,107 @@
+ MODULE impact_of_latent_heat_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 72 2007-03-19 08:20:46Z
+! precipitation_rate renamed dqdt_precip
+!
+! 19 2007-02-23 04:53:48Z raasch
+! Calculation extended for gridpoint nzt
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.5 2004/01/30 10:25:59 raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.1 2000/04/13 14:48:40 schroeter
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Calculate the impact of latent heat due to precipitation
+! (simplified Kessler scheme)
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC impact_of_latent_heat
+
+ INTERFACE impact_of_latent_heat
+ MODULE PROCEDURE impact_of_latent_heat
+ MODULE PROCEDURE impact_of_latent_heat_ij
+ END INTERFACE impact_of_latent_heat
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE impact_of_latent_heat
+
+ USE arrays_3d
+ USE cloud_parameters
+ USE constants
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: dqdt_precip
+
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_2d(j,i)+1, nzt
+
+ IF ( ql(k,j,i) > ql_crit ) THEN
+ dqdt_precip = prec_time_const * ( ql(k,j,i) - ql_crit )
+ ELSE
+ dqdt_precip = 0.0
+ ENDIF
+ tend(k,j,i) = tend(k,j,i) + dqdt_precip * l_d_cp * pt_d_t(k)
+
+ ENDDO
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE impact_of_latent_heat
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE impact_of_latent_heat_ij( i, j )
+
+ USE arrays_3d
+ USE cloud_parameters
+ USE constants
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: dqdt_precip
+
+
+ DO k = nzb_2d(j,i)+1, nzt
+
+ IF ( ql(k,j,i) > ql_crit ) THEN
+ dqdt_precip = prec_time_const * ( ql(k,j,i) - ql_crit )
+ ELSE
+ dqdt_precip = 0.0
+ ENDIF
+ tend(k,j,i) = tend(k,j,i) + dqdt_precip * l_d_cp * pt_d_t(k)
+
+ ENDDO
+
+ END SUBROUTINE impact_of_latent_heat_ij
+
+ END MODULE impact_of_latent_heat_mod
Index: /palm/tags/release-3.4a/SOURCE/init_1d_model.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/init_1d_model.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/init_1d_model.f90 (revision 141)
@@ -0,0 +1,979 @@
+ SUBROUTINE init_1d_model
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 135 2007-11-22 12:24:23Z raasch
+! Bugfix: absolute value of f must be used when calculating the Blackadar
+! mixing length
+!
+! 82 2007-04-16 15:40:52Z raasch
+! Preprocessor strings for different linux clusters changed to "lc",
+! routine local_flush is used for buffer flushing
+!
+! 75 2007-03-22 09:54:05Z raasch
+! Bugfix: preset of tendencies te_em, te_um, te_vm,
+! moisture renamed humidity
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.21 2006/06/02 15:19:57 raasch
+! cpp-directives extended for lctit
+!
+! Revision 1.1 1998/03/09 16:22:10 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! 1D-model to initialize the 3D-arrays.
+! The temperature profile is set as steady and a corresponding steady solution
+! of the wind profile is being computed.
+! All subroutines required can be found within this file.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE indices
+ USE model_1d
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=9) :: time_to_string
+ INTEGER :: k
+ REAL :: lambda
+
+!
+!-- Allocate required 1D-arrays
+ ALLOCATE( e1d(nzb:nzt+1), e1d_m(nzb:nzt+1), e1d_p(nzb:nzt+1), &
+ kh1d(nzb:nzt+1), kh1d_m(nzb:nzt+1), km1d(nzb:nzt+1), &
+ km1d_m(nzb:nzt+1), l_black(nzb:nzt+1), l1d(nzb:nzt+1), &
+ l1d_m(nzb:nzt+1), rif1d(nzb:nzt+1), te_e(nzb:nzt+1), &
+ te_em(nzb:nzt+1), te_u(nzb:nzt+1), te_um(nzb:nzt+1), &
+ te_v(nzb:nzt+1), te_vm(nzb:nzt+1), u1d(nzb:nzt+1), &
+ u1d_m(nzb:nzt+1), u1d_p(nzb:nzt+1), v1d(nzb:nzt+1), &
+ v1d_m(nzb:nzt+1), v1d_p(nzb:nzt+1) )
+
+!
+!-- Initialize arrays
+ IF ( constant_diffusion ) THEN
+ km1d = km_constant
+ km1d_m = km_constant
+ kh1d = km_constant / prandtl_number
+ kh1d_m = km_constant / prandtl_number
+ ELSE
+ e1d = 0.0; e1d_m = 0.0; e1d_p = 0.0
+ kh1d = 0.0; kh1d_m = 0.0; km1d = 0.0; km1d_m = 0.0
+ rif1d = 0.0
+!
+!-- Compute the mixing length
+ l_black(nzb) = 0.0
+
+ IF ( TRIM( mixing_length_1d ) == 'blackadar' ) THEN
+!
+!-- Blackadar mixing length
+ IF ( f /= 0.0 ) THEN
+ lambda = 2.7E-4 * SQRT( ug(nzt+1)**2 + vg(nzt+1)**2 ) / &
+ ABS( f ) + 1E-10
+ ELSE
+ lambda = 30.0
+ ENDIF
+
+ DO k = nzb+1, nzt+1
+ l_black(k) = kappa * zu(k) / ( 1.0 + kappa * zu(k) / lambda )
+ ENDDO
+
+ ELSEIF ( TRIM( mixing_length_1d ) == 'as_in_3d_model' ) THEN
+!
+!-- Use the same mixing length as in 3D model
+ l_black(1:nzt) = l_grid
+ l_black(nzt+1) = l_black(nzt)
+
+ ENDIF
+
+!
+!-- Adjust mixing length to the prandtl mixing length (within the prandtl
+!-- layer)
+ IF ( adjust_mixing_length .AND. prandtl_layer ) THEN
+ k = nzb+1
+ l_black(k) = MIN( l_black(k), kappa * zu(k) )
+ ENDIF
+ ENDIF
+ l1d = l_black
+ l1d_m = l_black
+ u1d = u_init
+ u1d_m = u_init
+ u1d_p = u_init
+ v1d = v_init
+ v1d_m = v_init
+ v1d_p = v_init
+
+!
+!-- Set initial horizontal velocities at the lowest grid levels to a very small
+!-- value in order to avoid too small time steps caused by the diffusion limit
+!-- in the initial phase of a run (at k=1, dz/2 occurs in the limiting formula!)
+ u1d(0:1) = 0.1
+ u1d_m(0:1) = 0.1
+ u1d_p(0:1) = 0.1
+ v1d(0:1) = 0.1
+ v1d_m(0:1) = 0.1
+ v1d_p(0:1) = 0.1
+
+!
+!-- For u*, theta* and the momentum fluxes plausible values are set
+ IF ( prandtl_layer ) THEN
+ us1d = 0.1 ! without initial friction the flow would not change
+ ELSE
+ e1d(nzb+1) = 1.0
+ km1d(nzb+1) = 1.0
+ us1d = 0.0
+ ENDIF
+ ts1d = 0.0
+ usws1d = 0.0; usws1d_m = 0.0
+ vsws1d = 0.0; vsws1d_m = 0.0
+ z01d = roughness_length
+ IF ( humidity .OR. passive_scalar ) qs1d = 0.0
+
+!
+!-- Tendencies must be preset in order to avoid runtime errors within the
+!-- first Runge-Kutta step
+ te_em = 0.0
+ te_um = 0.0
+ te_vm = 0.0
+
+!
+!-- Set start time in hh:mm:ss - format
+ simulated_time_chr = time_to_string( simulated_time_1d )
+
+!
+!-- Integrate the 1D-model equations using the leap-frog scheme
+ CALL time_integration_1d
+
+
+ END SUBROUTINE init_1d_model
+
+
+
+ SUBROUTINE time_integration_1d
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Leap-frog time differencing scheme for the 1D-model.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE indices
+ USE model_1d
+ USE pegrid
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=9) :: time_to_string
+ INTEGER :: k
+ REAL :: a, b, dissipation, dpt_dz, flux, kmzm, kmzp, l_stable, pt_0, &
+ uv_total
+
+!
+!-- Determine the time step at the start of a 1D-simulation and
+!-- determine and printout quantities used for run control
+ CALL timestep_1d
+ CALL run_control_1d
+
+!
+!-- Start of time loop
+ DO WHILE ( simulated_time_1d < end_time_1d .AND. .NOT. stop_dt_1d )
+
+!
+!-- Depending on the timestep scheme, carry out one or more intermediate
+!-- timesteps
+
+ intermediate_timestep_count = 0
+ DO WHILE ( intermediate_timestep_count < &
+ intermediate_timestep_count_max )
+
+ intermediate_timestep_count = intermediate_timestep_count + 1
+
+ CALL timestep_scheme_steering
+
+!
+!-- Compute all tendency terms. If a Prandtl-layer is simulated, k starts
+!-- at nzb+2.
+ DO k = nzb_diff, nzt
+
+ kmzm = 0.5 * ( km1d_m(k-1) + km1d_m(k) )
+ kmzp = 0.5 * ( km1d_m(k) + km1d_m(k+1) )
+!
+!-- u-component
+ te_u(k) = f * ( v1d(k) - vg(k) ) + ( &
+ kmzp * ( u1d_m(k+1) - u1d_m(k) ) * ddzu(k+1) &
+ - kmzm * ( u1d_m(k) - u1d_m(k-1) ) * ddzu(k) &
+ ) * ddzw(k)
+!
+!-- v-component
+ te_v(k) = -f * ( u1d(k) - ug(k) ) + ( &
+ kmzp * ( v1d_m(k+1) - v1d_m(k) ) * ddzu(k+1) &
+ - kmzm * ( v1d_m(k) - v1d_m(k-1) ) * ddzu(k) &
+ ) * ddzw(k)
+ ENDDO
+ IF ( .NOT. constant_diffusion ) THEN
+ DO k = nzb_diff, nzt
+!
+!-- TKE
+ kmzm = 0.5 * ( km1d_m(k-1) + km1d_m(k) )
+ kmzp = 0.5 * ( km1d_m(k) + km1d_m(k+1) )
+ IF ( .NOT. humidity ) THEN
+ pt_0 = pt_init(k)
+ flux = ( pt_init(k+1)-pt_init(k-1) ) * dd2zu(k)
+ ELSE
+ pt_0 = pt_init(k) * ( 1.0 + 0.61 * q_init(k) )
+ flux = ( ( pt_init(k+1) - pt_init(k-1) ) + &
+ 0.61 * pt_init(k) * ( q_init(k+1) - q_init(k-1) ) &
+ ) * dd2zu(k)
+ ENDIF
+
+ IF ( dissipation_1d == 'detering' ) THEN
+!
+!-- According to Detering, c_e=0.064
+ dissipation = 0.064 * e1d_m(k) * SQRT( e1d_m(k) ) / l1d_m(k)
+ ELSEIF ( dissipation_1d == 'as_in_3d_model' ) THEN
+ dissipation = ( 0.19 + 0.74 * l1d_m(k) / l_grid(k) ) &
+ * e1d_m(k) * SQRT( e1d_m(k) ) / l1d_m(k)
+ ENDIF
+
+ te_e(k) = km1d(k) * ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2&
+ + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2&
+ ) &
+ - g / pt_0 * kh1d(k) * flux &
+ + ( &
+ kmzp * ( e1d_m(k+1) - e1d_m(k) ) * ddzu(k+1) &
+ - kmzm * ( e1d_m(k) - e1d_m(k-1) ) * ddzu(k) &
+ ) * ddzw(k) &
+ - dissipation
+ ENDDO
+ ENDIF
+
+!
+!-- Tendency terms at the top of the Prandtl-layer.
+!-- Finite differences of the momentum fluxes are computed using half the
+!-- normal grid length (2.0*ddzw(k)) for the sake of enhanced accuracy
+ IF ( prandtl_layer ) THEN
+
+ k = nzb+1
+ kmzm = 0.5 * ( km1d_m(k-1) + km1d_m(k) )
+ kmzp = 0.5 * ( km1d_m(k) + km1d_m(k+1) )
+ IF ( .NOT. humidity ) THEN
+ pt_0 = pt_init(k)
+ flux = ( pt_init(k+1)-pt_init(k-1) ) * dd2zu(k)
+ ELSE
+ pt_0 = pt_init(k) * ( 1.0 + 0.61 * q_init(k) )
+ flux = ( ( pt_init(k+1) - pt_init(k-1) ) + &
+ 0.61 * pt_init(k) * ( q_init(k+1) - q_init(k-1) ) &
+ ) * dd2zu(k)
+ ENDIF
+
+ IF ( dissipation_1d == 'detering' ) THEN
+!
+!-- According to Detering, c_e=0.064
+ dissipation = 0.064 * e1d_m(k) * SQRT( e1d_m(k) ) / l1d_m(k)
+ ELSEIF ( dissipation_1d == 'as_in_3d_model' ) THEN
+ dissipation = ( 0.19 + 0.74 * l1d_m(k) / l_grid(k) ) &
+ * e1d_m(k) * SQRT( e1d_m(k) ) / l1d_m(k)
+ ENDIF
+
+!
+!-- u-component
+ te_u(k) = f * ( v1d(k) - vg(k) ) + ( &
+ kmzp * ( u1d_m(k+1) - u1d_m(k) ) * ddzu(k+1) + usws1d_m &
+ ) * 2.0 * ddzw(k)
+!
+!-- v-component
+ te_v(k) = -f * ( u1d(k) - ug(k) ) + ( &
+ kmzp * ( v1d_m(k+1) - v1d_m(k) ) * ddzu(k+1) + vsws1d_m &
+ ) * 2.0 * ddzw(k)
+!
+!-- TKE
+ te_e(k) = km1d(k) * ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 &
+ + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 &
+ ) &
+ - g / pt_0 * kh1d(k) * flux &
+ + ( &
+ kmzp * ( e1d_m(k+1) - e1d_m(k) ) * ddzu(k+1) &
+ - kmzm * ( e1d_m(k) - e1d_m(k-1) ) * ddzu(k) &
+ ) * ddzw(k) &
+ - dissipation
+ ENDIF
+
+!
+!-- Prognostic equations for all 1D variables
+ DO k = nzb+1, nzt
+
+ u1d_p(k) = ( 1. - tsc(1) ) * u1d_m(k) + &
+ tsc(1) * u1d(k) + dt_1d * ( tsc(2) * te_u(k) + &
+ tsc(3) * te_um(k) )
+ v1d_p(k) = ( 1. - tsc(1) ) * v1d_m(k) + &
+ tsc(1) * v1d(k) + dt_1d * ( tsc(2) * te_v(k) + &
+ tsc(3) * te_vm(k) )
+
+ ENDDO
+ IF ( .NOT. constant_diffusion ) THEN
+ DO k = nzb+1, nzt
+
+ e1d_p(k) = ( 1. - tsc(1) ) * e1d_m(k) + &
+ tsc(1) * e1d(k) + dt_1d * ( tsc(2) * te_e(k) + &
+ tsc(3) * te_em(k) )
+
+ ENDDO
+!
+!-- Eliminate negative TKE values, which can result from the
+!-- integration due to numerical inaccuracies. In such cases the TKE
+!-- value is reduced to 10 percent of its old value.
+ WHERE ( e1d_p < 0.0 ) e1d_p = 0.1 * e1d
+ ENDIF
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+
+ DO k = nzb+1, nzt
+ te_um(k) = te_u(k)
+ te_vm(k) = te_v(k)
+ ENDDO
+
+ IF ( .NOT. constant_diffusion ) THEN
+ DO k = nzb+1, nzt
+ te_em(k) = te_e(k)
+ ENDDO
+ ENDIF
+
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+
+ DO k = nzb+1, nzt
+ te_um(k) = -9.5625 * te_u(k) + 5.3125 * te_um(k)
+ te_vm(k) = -9.5625 * te_v(k) + 5.3125 * te_vm(k)
+ ENDDO
+
+ IF ( .NOT. constant_diffusion ) THEN
+ DO k = nzb+1, nzt
+ te_em(k) = -9.5625 * te_e(k) + 5.3125 * te_em(k)
+ ENDDO
+ ENDIF
+
+ ENDIF
+ ENDIF
+
+
+!
+!-- Boundary conditions for the prognostic variables.
+!-- At the top boundary (nzt+1) u,v and e keep their initial values
+!-- (ug(nzt+1), vg(nzt+1), 0), at the bottom boundary the mirror
+!-- boundary condition applies to u and v.
+!-- The boundary condition for e is set further below ( (u*/cm)**2 ).
+ u1d_p(nzb) = -u1d_p(nzb+1)
+ v1d_p(nzb) = -v1d_p(nzb+1)
+
+!
+!-- If necessary, apply the time filter
+ IF ( asselin_filter_factor /= 0.0 .AND. &
+ timestep_scheme(1:5) /= 'runge' ) THEN
+
+ u1d = u1d + asselin_filter_factor * ( u1d_p - 2.0 * u1d + u1d_m )
+ v1d = v1d + asselin_filter_factor * ( v1d_p - 2.0 * v1d + v1d_m )
+
+ IF ( .NOT. constant_diffusion ) THEN
+ e1d = e1d + asselin_filter_factor * &
+ ( e1d_p - 2.0 * e1d + e1d_m )
+ ENDIF
+
+ ENDIF
+
+!
+!-- Swap the time levels in preparation for the next time step.
+ IF ( timestep_scheme(1:4) == 'leap' ) THEN
+ u1d_m = u1d
+ v1d_m = v1d
+ IF ( .NOT. constant_diffusion ) THEN
+ e1d_m = e1d
+ kh1d_m = kh1d ! The old diffusion quantities are required for
+ km1d_m = km1d ! explicit diffusion in the leap-frog scheme.
+ l1d_m = l1d
+ IF ( prandtl_layer ) THEN
+ usws1d_m = usws1d
+ vsws1d_m = vsws1d
+ ENDIF
+ ENDIF
+ ENDIF
+ u1d = u1d_p
+ v1d = v1d_p
+ IF ( .NOT. constant_diffusion ) THEN
+ e1d = e1d_p
+ ENDIF
+
+!
+!-- Compute diffusion quantities
+ IF ( .NOT. constant_diffusion ) THEN
+
+!
+!-- First compute the vertical fluxes in the Prandtl-layer
+ IF ( prandtl_layer ) THEN
+!
+!-- Compute theta* using Rif numbers of the previous time step
+ IF ( rif1d(1) >= 0.0 ) THEN
+!
+!-- Stable stratification
+ ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) / &
+ ( LOG( zu(nzb+1) / z01d ) + 5.0 * rif1d(nzb+1) * &
+ ( zu(nzb+1) - z01d ) / zu(nzb+1) &
+ )
+ ELSE
+!
+!-- Unstable stratification
+ a = SQRT( 1.0 - 16.0 * rif1d(nzb+1) )
+ b = SQRT( 1.0 - 16.0 * rif1d(nzb+1) / zu(nzb+1) * z01d )
+!
+!-- In the borderline case the formula for stable stratification
+!-- must be applied, because otherwise a zero division would
+!-- occur in the argument of the logarithm.
+ IF ( a == 0.0 .OR. b == 0.0 ) THEN
+ ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) / &
+ ( LOG( zu(nzb+1) / z01d ) + 5.0 * rif1d(nzb+1) * &
+ ( zu(nzb+1) - z01d ) / zu(nzb+1) &
+ )
+ ELSE
+ ts1d = kappa * ( pt_init(nzb+1) - pt_init(nzb) ) / &
+ LOG( (a-1.0) / (a+1.0) * (b+1.0) / (b-1.0) )
+ ENDIF
+ ENDIF
+
+ ENDIF ! prandtl_layer
+
+!
+!-- Compute the Richardson-flux numbers,
+!-- first at the top of the Prandtl-layer using u* of the previous
+!-- time step (+1E-30, if u* = 0), then in the remaining area. There
+!-- the rif-numbers of the previous time step are used.
+
+ IF ( prandtl_layer ) THEN
+ IF ( .NOT. humidity ) THEN
+ pt_0 = pt_init(nzb+1)
+ flux = ts1d
+ ELSE
+ pt_0 = pt_init(nzb+1) * ( 1.0 + 0.61 * q_init(nzb+1) )
+ flux = ts1d + 0.61 * pt_init(k) * qs1d
+ ENDIF
+ rif1d(nzb+1) = zu(nzb+1) * kappa * g * flux / &
+ ( pt_0 * ( us1d**2 + 1E-30 ) )
+ ENDIF
+
+ DO k = nzb_diff, nzt
+ IF ( .NOT. humidity ) THEN
+ pt_0 = pt_init(k)
+ flux = ( pt_init(k+1) - pt_init(k-1) ) * dd2zu(k)
+ ELSE
+ pt_0 = pt_init(k) * ( 1.0 + 0.61 * q_init(k) )
+ flux = ( ( pt_init(k+1) - pt_init(k-1) ) &
+ + 0.61 * pt_init(k) * ( q_init(k+1) - q_init(k-1) )&
+ ) * dd2zu(k)
+ ENDIF
+ IF ( rif1d(k) >= 0.0 ) THEN
+ rif1d(k) = g / pt_0 * flux / &
+ ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 &
+ + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 &
+ + 1E-30 &
+ )
+ ELSE
+ rif1d(k) = g / pt_0 * flux / &
+ ( ( ( u1d(k+1) - u1d(k-1) ) * dd2zu(k) )**2 &
+ + ( ( v1d(k+1) - v1d(k-1) ) * dd2zu(k) )**2 &
+ + 1E-30 &
+ ) * ( 1.0 - 16.0 * rif1d(k) )**0.25
+ ENDIF
+ ENDDO
+!
+!-- Richardson-numbers must remain restricted to a realistic value
+!-- range. It is exceeded excessively for very small velocities
+!-- (u,v --> 0).
+ WHERE ( rif1d < rif_min ) rif1d = rif_min
+ WHERE ( rif1d > rif_max ) rif1d = rif_max
+
+!
+!-- Compute u* from the absolute velocity value
+ IF ( prandtl_layer ) THEN
+ uv_total = SQRT( u1d(nzb+1)**2 + v1d(nzb+1)**2 )
+
+ IF ( rif1d(nzb+1) >= 0.0 ) THEN
+!
+!-- Stable stratification
+ us1d = kappa * uv_total / ( &
+ LOG( zu(nzb+1) / z01d ) + 5.0 * rif1d(nzb+1) * &
+ ( zu(nzb+1) - z01d ) / zu(nzb+1) &
+ )
+ ELSE
+!
+!-- Unstable stratification
+ a = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif1d(nzb+1) ) )
+ b = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif1d(nzb+1) / zu(nzb+1) &
+ * z01d ) )
+!
+!-- In the borderline case the formula for stable stratification
+!-- must be applied, because otherwise a zero division would
+!-- occur in the argument of the logarithm.
+ IF ( a == 1.0 .OR. b == 1.0 ) THEN
+ us1d = kappa * uv_total / ( &
+ LOG( zu(nzb+1) / z01d ) + &
+ 5.0 * rif1d(nzb+1) * ( zu(nzb+1) - z01d ) / &
+ zu(nzb+1) )
+ ELSE
+ us1d = kappa * uv_total / ( &
+ LOG( (1.0+b) / (1.0-b) * (1.0-a) / (1.0+a) ) +&
+ 2.0 * ( ATAN( b ) - ATAN( a ) ) &
+ )
+ ENDIF
+ ENDIF
+
+!
+!-- Compute the momentum fluxes for the diffusion terms
+ usws1d = - u1d(nzb+1) / uv_total * us1d**2
+ vsws1d = - v1d(nzb+1) / uv_total * us1d**2
+
+!
+!-- Boundary condition for the turbulent kinetic energy at the top
+!-- of the Prandtl-layer. c_m = 0.4 according to Detering.
+!-- Additional Neumann condition de/dz = 0 at nzb is set to ensure
+!-- compatibility with the 3D model.
+ IF ( ibc_e_b == 2 ) THEN
+ e1d(nzb+1) = ( us1d / 0.1 )**2
+! e1d(nzb+1) = ( us1d / 0.4 )**2 !not used so far, see also
+ !prandtl_fluxes
+ ENDIF
+ e1d(nzb) = e1d(nzb+1)
+
+ IF ( humidity .OR. passive_scalar ) THEN
+!
+!-- Compute q*
+ IF ( rif1d(1) >= 0.0 ) THEN
+!
+!-- Stable stratification
+ qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) / &
+ ( LOG( zu(nzb+1) / z01d ) + 5.0 * rif1d(nzb+1) * &
+ ( zu(nzb+1) - z01d ) / zu(nzb+1) &
+ )
+ ELSE
+!
+!-- Unstable stratification
+ a = SQRT( 1.0 - 16.0 * rif1d(nzb+1) )
+ b = SQRT( 1.0 - 16.0 * rif1d(nzb+1) / zu(nzb+1) * z01d )
+!
+!-- In the borderline case the formula for stable stratification
+!-- must be applied, because otherwise a zero division would
+!-- occur in the argument of the logarithm.
+ IF ( a == 1.0 .OR. b == 1.0 ) THEN
+ qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) / &
+ ( LOG( zu(nzb+1) / z01d ) + 5.0 * rif1d(nzb+1) * &
+ ( zu(nzb+1) - z01d ) / zu(nzb+1) &
+ )
+ ELSE
+ qs1d = kappa * ( q_init(nzb+1) - q_init(nzb) ) / &
+ LOG( (a-1.0) / (a+1.0) * (b+1.0) / (b-1.0) )
+ ENDIF
+ ENDIF
+ ELSE
+ qs1d = 0.0
+ ENDIF
+
+ ENDIF ! prandtl_layer
+
+!
+!-- Compute the diabatic mixing length
+ IF ( mixing_length_1d == 'blackadar' ) THEN
+ DO k = nzb+1, nzt
+ IF ( rif1d(k) >= 0.0 ) THEN
+ l1d(k) = l_black(k) / ( 1.0 + 5.0 * rif1d(k) )
+ ELSE
+ l1d(k) = l_black(k) * ( 1.0 - 16.0 * rif1d(k) )**0.25
+ ENDIF
+ l1d(k) = l_black(k)
+ ENDDO
+
+ ELSEIF ( mixing_length_1d == 'as_in_3d_model' ) THEN
+ DO k = nzb+1, nzt
+ dpt_dz = ( pt_init(k+1) - pt_init(k-1) ) * dd2zu(k)
+ IF ( dpt_dz > 0.0 ) THEN
+ l_stable = 0.76 * SQRT( e1d(k) ) / &
+ SQRT( g / pt_init(k) * dpt_dz ) + 1E-5
+ ELSE
+ l_stable = l_grid(k)
+ ENDIF
+ l1d(k) = MIN( l_grid(k), l_stable )
+ ENDDO
+ ENDIF
+
+!
+!-- Adjust mixing length to the prandtl mixing length
+ IF ( adjust_mixing_length .AND. prandtl_layer ) THEN
+ k = nzb+1
+ IF ( rif1d(k) >= 0.0 ) THEN
+ l1d(k) = MIN( l1d(k), kappa * zu(k) / ( 1.0 + 5.0 * &
+ rif1d(k) ) )
+ ELSE
+ l1d(k) = MIN( l1d(k), kappa * zu(k) * &
+ SQRT( SQRT( 1.0 - 16.0 * rif1d(k) ) ) )
+ ENDIF
+ ENDIF
+
+!
+!-- Compute the diffusion coefficients for momentum via the
+!-- corresponding Prandtl-layer relationship and according to
+!-- Prandtl-Kolmogorov, respectively. The unstable stratification is
+!-- computed via the adiabatic mixing length, for the unstability has
+!-- already been taken account of via the TKE (cf. also Diss.).
+ IF ( prandtl_layer ) THEN
+ IF ( rif1d(nzb+1) >= 0.0 ) THEN
+ km1d(nzb+1) = us1d * kappa * zu(nzb+1) / &
+ ( 1.0 + 5.0 * rif1d(nzb+1) )
+ ELSE
+ km1d(nzb+1) = us1d * kappa * zu(nzb+1) * &
+ ( 1.0 - 16.0 * rif1d(nzb+1) )**0.25
+ ENDIF
+ ENDIF
+ DO k = nzb_diff, nzt
+! km1d(k) = 0.4 * SQRT( e1d(k) ) !changed: adjustment to 3D-model
+ km1d(k) = 0.1 * SQRT( e1d(k) )
+ IF ( rif1d(k) >= 0.0 ) THEN
+ km1d(k) = km1d(k) * l1d(k)
+ ELSE
+ km1d(k) = km1d(k) * l_black(k)
+ ENDIF
+ ENDDO
+
+!
+!-- Add damping layer
+ DO k = damp_level_ind_1d+1, nzt+1
+ km1d(k) = 1.1 * km1d(k-1)
+ km1d(k) = MIN( km1d(k), 10.0 )
+ ENDDO
+
+!
+!-- Compute the diffusion coefficient for heat via the relationship
+!-- kh = phim / phih * km
+ DO k = nzb+1, nzt
+ IF ( rif1d(k) >= 0.0 ) THEN
+ kh1d(k) = km1d(k)
+ ELSE
+ kh1d(k) = km1d(k) * ( 1.0 - 16.0 * rif1d(k) )**0.25
+ ENDIF
+ ENDDO
+
+ ENDIF ! .NOT. constant_diffusion
+
+!
+!-- The Runge-Kutta scheme needs the recent diffusion quantities
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ u1d_m = u1d
+ v1d_m = v1d
+ IF ( .NOT. constant_diffusion ) THEN
+ e1d_m = e1d
+ kh1d_m = kh1d
+ km1d_m = km1d
+ l1d_m = l1d
+ IF ( prandtl_layer ) THEN
+ usws1d_m = usws1d
+ vsws1d_m = vsws1d
+ ENDIF
+ ENDIF
+ ENDIF
+
+
+ ENDDO ! intermediate step loop
+
+!
+!-- Increment simulated time and output times
+ current_timestep_number_1d = current_timestep_number_1d + 1
+ simulated_time_1d = simulated_time_1d + dt_1d
+ simulated_time_chr = time_to_string( simulated_time_1d )
+ time_pr_1d = time_pr_1d + dt_1d
+ time_run_control_1d = time_run_control_1d + dt_1d
+
+!
+!-- Determine and print out quantities for run control
+ IF ( time_run_control_1d >= dt_run_control_1d ) THEN
+ CALL run_control_1d
+ time_run_control_1d = time_run_control_1d - dt_run_control_1d
+ ENDIF
+
+!
+!-- Profile output on file
+ IF ( time_pr_1d >= dt_pr_1d ) THEN
+ CALL print_1d_model
+ time_pr_1d = time_pr_1d - dt_pr_1d
+ ENDIF
+
+!
+!-- Determine size of next time step
+ CALL timestep_1d
+
+ ENDDO ! time loop
+
+
+ END SUBROUTINE time_integration_1d
+
+
+ SUBROUTINE run_control_1d
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Compute and print out quantities for run control of the 1D model.
+!------------------------------------------------------------------------------!
+
+ USE constants
+ USE indices
+ USE model_1d
+ USE pegrid
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ INTEGER :: k
+ REAL :: alpha, energy, umax, uv_total, vmax
+
+!
+!-- Output
+ IF ( myid == 0 ) THEN
+!
+!-- If necessary, write header
+ IF ( .NOT. run_control_header_1d ) THEN
+ WRITE ( 15, 100 )
+ run_control_header_1d = .TRUE.
+ ENDIF
+
+!
+!-- Compute control quantities
+!-- grid level nzp is excluded due to mirror boundary condition
+ umax = 0.0; vmax = 0.0; energy = 0.0
+ DO k = nzb+1, nzt+1
+ umax = MAX( ABS( umax ), ABS( u1d(k) ) )
+ vmax = MAX( ABS( vmax ), ABS( v1d(k) ) )
+ energy = energy + 0.5 * ( u1d(k)**2 + v1d(k)**2 )
+ ENDDO
+ energy = energy / REAL( nzt - nzb + 1 )
+
+ uv_total = SQRT( u1d(nzb+1)**2 + v1d(nzb+1)**2 )
+ IF ( ABS( v1d(nzb+1) ) .LT. 1.0E-5 ) THEN
+ alpha = ACOS( SIGN( 1.0 , u1d(nzb+1) ) )
+ ELSE
+ alpha = ACOS( u1d(nzb+1) / uv_total )
+ IF ( v1d(nzb+1) <= 0.0 ) alpha = 2.0 * pi - alpha
+ ENDIF
+ alpha = alpha / ( 2.0 * pi ) * 360.0
+
+ WRITE ( 15, 101 ) current_timestep_number_1d, simulated_time_chr, &
+ dt_1d, umax, vmax, us1d, alpha, energy
+!
+!-- Write buffer contents to disc immediately
+ CALL local_flush( 15 )
+
+ ENDIF
+
+!
+!-- formats
+100 FORMAT (///'1D-Zeitschrittkontrollausgaben:'/ &
+ &'------------------------------'// &
+ &'ITER. HH:MM:SS DT UMAX VMAX U* ALPHA ENERG.'/ &
+ &'-------------------------------------------------------------')
+101 FORMAT (I5,2X,A9,1X,F6.2,2X,F6.2,1X,F6.2,2X,F5.3,2X,F5.1,2X,F7.2)
+
+
+ END SUBROUTINE run_control_1d
+
+
+
+ SUBROUTINE timestep_1d
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Compute the time step w.r.t. the diffusion criterion
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE indices
+ USE model_1d
+ USE pegrid
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ INTEGER :: k
+ REAL :: div, dt_diff, fac, percent_change, value
+
+
+!
+!-- Compute the currently feasible time step according to the diffusion
+!-- criterion. At nzb+1 the half grid length is used.
+ IF ( timestep_scheme(1:4) == 'leap' ) THEN
+ fac = 0.25
+ ELSE
+ fac = 0.35
+ ENDIF
+ dt_diff = dt_max_1d
+ DO k = nzb+2, nzt
+ value = fac * dzu(k) * dzu(k) / ( km1d(k) + 1E-20 )
+ dt_diff = MIN( value, dt_diff )
+ ENDDO
+ value = fac * zu(nzb+1) * zu(nzb+1) / ( km1d(nzb+1) + 1E-20 )
+ dt_1d = MIN( value, dt_diff )
+
+!
+!-- Set flag when the time step becomes too small
+ IF ( dt_1d < ( 0.00001 * dt_max_1d ) ) THEN
+ stop_dt_1d = .TRUE.
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ timestep_1d: timestep has exceeded the lower limit'
+ PRINT*,' dt_1d = ',dt_1d,' s simulation stopped!'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ IF ( timestep_scheme(1:4) == 'leap' ) THEN
+
+!
+!-- The current time step will only be changed if the new time step exceeds
+!-- its previous value by 5 % or falls 2 % below. After a time step
+!-- reduction at least 30 iterations must be done with this value before a
+!-- new reduction will be allowed again.
+!-- The control parameters for application of Euler- or leap-frog schemes are
+!-- set accordingly.
+ percent_change = dt_1d / old_dt_1d - 1.0
+ IF ( percent_change > 0.05 .OR. percent_change < -0.02 ) THEN
+
+!
+!-- Each time step increase is by at most 2 %
+ IF ( percent_change > 0.0 .AND. simulated_time_1d /= 0.0 ) THEN
+ dt_1d = 1.02 * old_dt_1d
+ ENDIF
+
+!
+!-- A more or less simple new time step value is obtained taking only the
+!-- first two significant digits
+ div = 1000.0
+ DO WHILE ( dt_1d < div )
+ div = div / 10.0
+ ENDDO
+ dt_1d = NINT( dt_1d * 100.0 / div ) * div / 100.0
+
+!
+!-- Now the time step can be changed.
+ IF ( percent_change < 0.0 ) THEN
+!
+!-- Time step reduction
+ old_dt_1d = dt_1d
+ last_dt_change_1d = current_timestep_number_1d
+ ELSE
+!
+!-- Time step will only be increased if at least 30 iterations have
+!-- been done since the previous time step change, and of course at
+!-- simulation start, respectively.
+ IF ( current_timestep_number_1d >= last_dt_change_1d + 30 .OR. &
+ simulated_time_1d == 0.0 ) THEN
+ old_dt_1d = dt_1d
+ last_dt_change_1d = current_timestep_number_1d
+ ELSE
+ dt_1d = old_dt_1d
+ ENDIF
+ ENDIF
+ ELSE
+!
+!-- No time step change since the difference is too small
+ dt_1d = old_dt_1d
+ ENDIF
+
+ ELSE ! Runge-Kutta
+
+!-- A more or less simple new time step value is obtained taking only the
+!-- first two significant digits
+ div = 1000.0
+ DO WHILE ( dt_1d < div )
+ div = div / 10.0
+ ENDDO
+ dt_1d = NINT( dt_1d * 100.0 / div ) * div / 100.0
+
+ old_dt_1d = dt_1d
+ last_dt_change_1d = current_timestep_number_1d
+
+ ENDIF
+
+ END SUBROUTINE timestep_1d
+
+
+
+ SUBROUTINE print_1d_model
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! List output of profiles from the 1D-model
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE indices
+ USE model_1d
+ USE pegrid
+ USE control_parameters
+
+ IMPLICIT NONE
+
+
+ INTEGER :: k
+
+
+ IF ( myid == 0 ) THEN
+!
+!-- Open list output file for profiles from the 1D-model
+ CALL check_open( 17 )
+
+!
+!-- Write Header
+ WRITE ( 17, 100 ) TRIM( run_description_header ), &
+ TRIM( simulated_time_chr )
+ WRITE ( 17, 101 )
+
+!
+!-- Write the values
+ WRITE ( 17, 102 )
+ WRITE ( 17, 101 )
+ DO k = nzt+1, nzb, -1
+ WRITE ( 17, 103) k, zu(k), u1d(k), v1d(k), pt_init(k), e1d(k), &
+ rif1d(k), km1d(k), kh1d(k), l1d(k), zu(k), k
+ ENDDO
+ WRITE ( 17, 101 )
+ WRITE ( 17, 102 )
+ WRITE ( 17, 101 )
+
+!
+!-- Write buffer contents to disc immediately
+ CALL local_flush( 17 )
+
+ ENDIF
+
+!
+!-- Formats
+100 FORMAT (//1X,A/1X,10('-')/' 1d-model profiles'/ &
+ ' Time: ',A)
+101 FORMAT (1X,79('-'))
+102 FORMAT (' k zu u v pt e rif Km Kh ', &
+ 'l zu k')
+103 FORMAT (1X,I4,1X,F7.1,1X,F6.2,1X,F6.2,1X,F6.2,1X,F6.2,1X,F5.2,1X,F5.2, &
+ 1X,F5.2,1X,F6.2,1X,F7.1,2X,I4)
+
+
+ END SUBROUTINE print_1d_model
Index: /palm/tags/release-3.4a/SOURCE/init_3d_model.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/init_3d_model.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/init_3d_model.f90 (revision 141)
@@ -0,0 +1,1203 @@
+#if defined( __ibmy_special )
+@PROCESS NOOPTimize
+#endif
+ SUBROUTINE init_3d_model
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 138 2007-11-28 10:03:58Z letzel
+! New counter ngp_2dh_s_inner.
+! Allow new case bc_uv_t = 'dirichlet_0' for channel flow.
+! Corrected calculation of initial volume flow for 'set_1d-model_profiles' and
+! 'set_constant_profiles' in case of buildings in the reference cross-sections.
+!
+! 108 2007-08-24 15:10:38Z letzel
+! Flux initialization in case of coupled runs, +momentum fluxes at top boundary,
+! +arrays for phase speed c_u, c_v, c_w, indices for u|v|w_m_l|r changed
+! +qswst_remote in case of atmosphere model with humidity coupled to ocean
+! Rayleigh damping for ocean, optionally calculate km and kh from initial
+! TKE e_init
+!
+! 97 2007-06-21 08:23:15Z raasch
+! Initialization of salinity, call of init_ocean
+!
+! 87 2007-05-22 15:46:47Z raasch
+! var_hom and var_sum renamed pr_palm
+!
+! 75 2007-03-22 09:54:05Z raasch
+! Arrays for radiation boundary conditions are allocated (u_m_l, u_m_r, etc.),
+! bugfix for cases with the outflow damping layer extending over more than one
+! subdomain, moisture renamed humidity,
+! new initializing action "by_user" calls user_init_3d_model,
+! precipitation_amount/rate, ts_value are allocated, +module netcdf_control,
+! initial velocities at nzb+1 are regarded for volume
+! flow control in case they have been set zero before (to avoid small timesteps)
+! -uvmean_outflow, uxrp, vynp eliminated
+!
+! 19 2007-02-23 04:53:48Z raasch
+! +handling of top fluxes
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.49 2006/08/22 15:59:07 raasch
+! No optimization of this file on the ibmy (Yonsei Univ.)
+!
+! Revision 1.1 1998/03/09 16:22:22 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Allocation of arrays and initialization of the 3D model via
+! a) pre-run the 1D model
+! or
+! b) pre-set constant linear profiles
+! or
+! c) read values of a previous run
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE averaging
+ USE cloud_parameters
+ USE constants
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE model_1d
+ USE netcdf_control
+ USE particle_attributes
+ USE pegrid
+ USE profil_parameter
+ USE random_function_mod
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, sr
+
+ INTEGER, DIMENSION(:), ALLOCATABLE :: ngp_2dh_l, ngp_3d_inner_l
+
+ INTEGER, DIMENSION(:,:), ALLOCATABLE :: ngp_2dh_outer_l, &
+ ngp_2dh_s_inner_l
+
+ REAL, DIMENSION(1:2) :: volume_flow_area_l, volume_flow_initial_l
+
+
+!
+!-- Allocate arrays
+ ALLOCATE( ngp_2dh(0:statistic_regions), ngp_2dh_l(0:statistic_regions), &
+ ngp_3d(0:statistic_regions), &
+ ngp_3d_inner(0:statistic_regions), &
+ ngp_3d_inner_l(0:statistic_regions), &
+ sums_divnew_l(0:statistic_regions), &
+ sums_divold_l(0:statistic_regions) )
+ ALLOCATE( rdf(nzb+1:nzt) )
+ ALLOCATE( hom_sum(nzb:nzt+1,pr_palm+max_pr_user,0:statistic_regions), &
+ ngp_2dh_outer(nzb:nzt+1,0:statistic_regions), &
+ ngp_2dh_outer_l(nzb:nzt+1,0:statistic_regions), &
+ ngp_2dh_s_inner(nzb:nzt+1,0:statistic_regions), &
+ ngp_2dh_s_inner_l(nzb:nzt+1,0:statistic_regions), &
+ rmask(nys-1:nyn+1,nxl-1:nxr+1,0:statistic_regions), &
+ sums(nzb:nzt+1,pr_palm+max_pr_user), &
+ sums_l(nzb:nzt+1,pr_palm+max_pr_user,0:threads_per_task-1), &
+ sums_l_l(nzb:nzt+1,0:statistic_regions,0:threads_per_task-1), &
+ sums_up_fraction_l(10,3,0:statistic_regions), &
+ sums_wsts_bc_l(nzb:nzt+1,0:statistic_regions), &
+ ts_value(var_ts,0:statistic_regions) )
+ ALLOCATE( km_damp_x(nxl-1:nxr+1), km_damp_y(nys-1:nyn+1) )
+
+ ALLOCATE( rif_1(nys-1:nyn+1,nxl-1:nxr+1), shf_1(nys-1:nyn+1,nxl-1:nxr+1), &
+ ts(nys-1:nyn+1,nxl-1:nxr+1), tswst_1(nys-1:nyn+1,nxl-1:nxr+1), &
+ us(nys-1:nyn+1,nxl-1:nxr+1), usws_1(nys-1:nyn+1,nxl-1:nxr+1), &
+ uswst_1(nys-1:nyn+1,nxl-1:nxr+1), &
+ vsws_1(nys-1:nyn+1,nxl-1:nxr+1), &
+ vswst_1(nys-1:nyn+1,nxl-1:nxr+1), z0(nys-1:nyn+1,nxl-1:nxr+1) )
+
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+!
+!-- Leapfrog scheme needs two timelevels of diffusion quantities
+ ALLOCATE( rif_2(nys-1:nyn+1,nxl-1:nxr+1), &
+ shf_2(nys-1:nyn+1,nxl-1:nxr+1), &
+ tswst_2(nys-1:nyn+1,nxl-1:nxr+1), &
+ usws_2(nys-1:nyn+1,nxl-1:nxr+1), &
+ uswst_2(nys-1:nyn+1,nxl-1:nxr+1), &
+ vswst_2(nys-1:nyn+1,nxl-1:nxr+1), &
+ vsws_2(nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+
+ ALLOCATE( d(nzb+1:nzta,nys:nyna,nxl:nxra), &
+ e_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ e_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ e_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ kh_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ km_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ p(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ pt_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ pt_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ pt_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ u_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ u_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ u_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ v_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ v_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ v_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ w_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ w_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ w_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+ ALLOCATE( kh_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ km_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+
+ IF ( humidity .OR. passive_scalar ) THEN
+!
+!-- 2D-humidity/scalar arrays
+ ALLOCATE ( qs(nys-1:nyn+1,nxl-1:nxr+1), &
+ qsws_1(nys-1:nyn+1,nxl-1:nxr+1), &
+ qswst_1(nys-1:nyn+1,nxl-1:nxr+1) )
+
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+ ALLOCATE( qsws_2(nys-1:nyn+1,nxl-1:nxr+1), &
+ qswst_2(nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+!
+!-- 3D-humidity/scalar arrays
+ ALLOCATE( q_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ q_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ q_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+
+!
+!-- 3D-arrays needed for humidity only
+ IF ( humidity ) THEN
+ ALLOCATE( vpt_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+ ALLOCATE( vpt_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+
+ IF ( cloud_physics ) THEN
+!
+!-- Liquid water content
+ ALLOCATE ( ql_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+!
+!-- Precipitation amount and rate (only needed if output is switched)
+ ALLOCATE( precipitation_amount(nys-1:nyn+1,nxl-1:nxr+1), &
+ precipitation_rate(nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+
+ IF ( cloud_droplets ) THEN
+!
+!-- Liquid water content, change in liquid water content,
+!-- real volume of particles (with weighting), volume of particles
+ ALLOCATE ( ql_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ ql_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ ql_v(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ ql_vp(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+
+ ENDIF
+
+ ENDIF
+
+ IF ( ocean ) THEN
+ ALLOCATE( saswsb_1(nys-1:nyn+1,nxl-1:nxr+1), &
+ saswst_1(nys-1:nyn+1,nxl-1:nxr+1) )
+ ALLOCATE( rho_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ sa_1(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ sa_2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ sa_3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ rho => rho_1 ! routine calc_mean_profile requires density to be a
+ ! pointer
+ IF ( humidity_remote ) THEN
+ ALLOCATE( qswst_remote(nys-1:nyn+1,nxl-1:nxr+1) )
+ qswst_remote = 0.0
+ ENDIF
+ ENDIF
+
+!
+!-- 3D-array for storing the dissipation, needed for calculating the sgs
+!-- particle velocities
+ IF ( use_sgs_for_particles ) THEN
+ ALLOCATE ( diss(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+
+ IF ( dt_dosp /= 9999999.9 ) THEN
+ ALLOCATE( spectrum_x( 1:nx/2, 1:10, 1:10 ), &
+ spectrum_y( 1:ny/2, 1:10, 1:10 ) )
+ ENDIF
+
+!
+!-- 3D-arrays for the leaf area density and the canopy drag coefficient
+ IF ( plant_canopy ) THEN
+ ALLOCATE ( lad_s(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ lad_u(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ lad_v(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ lad_w(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ cdc(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+
+!
+!-- 4D-array for storing the Rif-values at vertical walls
+ IF ( topography /= 'flat' ) THEN
+ ALLOCATE( rif_wall(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1,1:4) )
+ rif_wall = 0.0
+ ENDIF
+
+!
+!-- Velocities at nzb+1 needed for volume flow control
+ IF ( conserve_volume_flow ) THEN
+ ALLOCATE( u_nzb_p1_for_vfc(nys:nyn), v_nzb_p1_for_vfc(nxl:nxr) )
+ u_nzb_p1_for_vfc = 0.0
+ v_nzb_p1_for_vfc = 0.0
+ ENDIF
+
+!
+!-- Arrays to store velocity data from t-dt and the phase speeds which
+!-- are needed for radiation boundary conditions
+ IF ( outflow_l ) THEN
+ ALLOCATE( u_m_l(nzb:nzt+1,nys-1:nyn+1,1:2), &
+ v_m_l(nzb:nzt+1,nys-1:nyn+1,0:1), &
+ w_m_l(nzb:nzt+1,nys-1:nyn+1,0:1) )
+ ENDIF
+ IF ( outflow_r ) THEN
+ ALLOCATE( u_m_r(nzb:nzt+1,nys-1:nyn+1,nx-1:nx), &
+ v_m_r(nzb:nzt+1,nys-1:nyn+1,nx-1:nx), &
+ w_m_r(nzb:nzt+1,nys-1:nyn+1,nx-1:nx) )
+ ENDIF
+ IF ( outflow_l .OR. outflow_r ) THEN
+ ALLOCATE( c_u(nzb:nzt+1,nys-1:nyn+1), c_v(nzb:nzt+1,nys-1:nyn+1), &
+ c_w(nzb:nzt+1,nys-1:nyn+1) )
+ ENDIF
+ IF ( outflow_s ) THEN
+ ALLOCATE( u_m_s(nzb:nzt+1,0:1,nxl-1:nxr+1), &
+ v_m_s(nzb:nzt+1,1:2,nxl-1:nxr+1), &
+ w_m_s(nzb:nzt+1,0:1,nxl-1:nxr+1) )
+ ENDIF
+ IF ( outflow_n ) THEN
+ ALLOCATE( u_m_n(nzb:nzt+1,ny-1:ny,nxl-1:nxr+1), &
+ v_m_n(nzb:nzt+1,ny-1:ny,nxl-1:nxr+1), &
+ w_m_n(nzb:nzt+1,ny-1:ny,nxl-1:nxr+1) )
+ ENDIF
+ IF ( outflow_s .OR. outflow_n ) THEN
+ ALLOCATE( c_u(nzb:nzt+1,nxl-1:nxr+1), c_v(nzb:nzt+1,nxl-1:nxr+1), &
+ c_w(nzb:nzt+1,nxl-1:nxr+1) )
+ ENDIF
+
+!
+!-- Initial assignment of the pointers
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+
+ rif_m => rif_1; rif => rif_2
+ shf_m => shf_1; shf => shf_2
+ tswst_m => tswst_1; tswst => tswst_2
+ usws_m => usws_1; usws => usws_2
+ uswst_m => uswst_1; uswst => uswst_2
+ vsws_m => vsws_1; vsws => vsws_2
+ vswst_m => vswst_1; vswst => vswst_2
+ e_m => e_1; e => e_2; e_p => e_3; te_m => e_3
+ kh_m => kh_1; kh => kh_2
+ km_m => km_1; km => km_2
+ pt_m => pt_1; pt => pt_2; pt_p => pt_3; tpt_m => pt_3
+ u_m => u_1; u => u_2; u_p => u_3; tu_m => u_3
+ v_m => v_1; v => v_2; v_p => v_3; tv_m => v_3
+ w_m => w_1; w => w_2; w_p => w_3; tw_m => w_3
+
+ IF ( humidity .OR. passive_scalar ) THEN
+ qsws_m => qsws_1; qsws => qsws_2
+ qswst_m => qswst_1; qswst => qswst_2
+ q_m => q_1; q => q_2; q_p => q_3; tq_m => q_3
+ IF ( humidity ) vpt_m => vpt_1; vpt => vpt_2
+ IF ( cloud_physics ) ql => ql_1
+ IF ( cloud_droplets ) THEN
+ ql => ql_1
+ ql_c => ql_2
+ ENDIF
+ ENDIF
+
+ ELSE
+
+ rif => rif_1
+ shf => shf_1
+ tswst => tswst_1
+ usws => usws_1
+ uswst => uswst_1
+ vsws => vsws_1
+ vswst => vswst_1
+ e => e_1; e_p => e_2; te_m => e_3; e_m => e_3
+ kh => kh_1
+ km => km_1
+ pt => pt_1; pt_p => pt_2; tpt_m => pt_3; pt_m => pt_3
+ u => u_1; u_p => u_2; tu_m => u_3; u_m => u_3
+ v => v_1; v_p => v_2; tv_m => v_3; v_m => v_3
+ w => w_1; w_p => w_2; tw_m => w_3; w_m => w_3
+
+ IF ( humidity .OR. passive_scalar ) THEN
+ qsws => qsws_1
+ qswst => qswst_1
+ q => q_1; q_p => q_2; tq_m => q_3; q_m => q_3
+ IF ( humidity ) vpt => vpt_1
+ IF ( cloud_physics ) ql => ql_1
+ IF ( cloud_droplets ) THEN
+ ql => ql_1
+ ql_c => ql_2
+ ENDIF
+ ENDIF
+
+ IF ( ocean ) THEN
+ saswsb => saswsb_1
+ saswst => saswst_1
+ sa => sa_1; sa_p => sa_2; tsa_m => sa_3
+ ENDIF
+
+ ENDIF
+
+!
+!-- Initialize model variables
+ IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
+!
+!-- First model run of a possible job queue.
+!-- Initial profiles of the variables must be computes.
+ IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 ) THEN
+!
+!-- Use solutions of the 1D model as initial profiles,
+!-- start 1D model
+ CALL init_1d_model
+!
+!-- Transfer initial profiles to the arrays of the 3D model
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ e(:,j,i) = e1d
+ kh(:,j,i) = kh1d
+ km(:,j,i) = km1d
+ pt(:,j,i) = pt_init
+ u(:,j,i) = u1d
+ v(:,j,i) = v1d
+ ENDDO
+ ENDDO
+
+ IF ( humidity .OR. passive_scalar ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ q(:,j,i) = q_init
+ ENDDO
+ ENDDO
+ ENDIF
+
+ IF ( .NOT. constant_diffusion ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ e(:,j,i) = e1d
+ ENDDO
+ ENDDO
+!
+!-- Store initial profiles for output purposes etc.
+ hom(:,1,25,:) = SPREAD( l1d, 2, statistic_regions+1 )
+
+ IF ( prandtl_layer ) THEN
+ rif = rif1d(nzb+1)
+ ts = 0.0 ! could actually be computed more accurately in the
+ ! 1D model. Update when opportunity arises.
+ us = us1d
+ usws = usws1d
+ vsws = vsws1d
+ ELSE
+ ts = 0.0 ! must be set, because used in
+ rif = 0.0 ! flowste
+ us = 0.0
+ usws = 0.0
+ vsws = 0.0
+ ENDIF
+
+ ELSE
+ e = 0.0 ! must be set, because used in
+ rif = 0.0 ! flowste
+ ts = 0.0
+ us = 0.0
+ usws = 0.0
+ vsws = 0.0
+ ENDIF
+ uswst = top_momentumflux_u
+ vswst = top_momentumflux_v
+
+!
+!-- In every case qs = 0.0 (see also pt)
+!-- This could actually be computed more accurately in the 1D model.
+!-- Update when opportunity arises!
+ IF ( humidity .OR. passive_scalar ) qs = 0.0
+
+!
+!-- inside buildings set velocities back to zero
+ IF ( topography /= 'flat' ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ u(nzb:nzb_u_inner(j,i),j,i) = 0.0
+ v(nzb:nzb_v_inner(j,i),j,i) = 0.0
+ ENDDO
+ ENDDO
+ IF ( conserve_volume_flow ) THEN
+ IF ( nxr == nx ) THEN
+ DO j = nys, nyn
+ DO k = nzb + 1, nzb_u_inner(j,nx)
+ u_nzb_p1_for_vfc(j) = u1d(k) * dzu(k)
+ ENDDO
+ ENDDO
+ ENDIF
+ IF ( nyn == ny ) THEN
+ DO i = nxl, nxr
+ DO k = nzb + 1, nzb_v_inner(ny,i)
+ v_nzb_p1_for_vfc(i) = v1d(k) * dzu(k)
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+!
+!-- WARNING: The extra boundary conditions set after running the
+!-- ------- 1D model impose an error on the divergence one layer
+!-- below the topography; need to correct later
+!-- ATTENTION: Provisional correction for Piacsek & Williams
+!-- --------- advection scheme: keep u and v zero one layer below
+!-- the topography.
+ IF ( ibc_uv_b == 0 ) THEN
+!
+!-- Satisfying the Dirichlet condition with an extra layer below
+!-- the surface where the u and v component change their sign.
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ IF ( nzb_u_inner(j,i) == 0 ) u(0,j,i) = -u(1,j,i)
+ IF ( nzb_v_inner(j,i) == 0 ) v(0,j,i) = -v(1,j,i)
+ ENDDO
+ ENDDO
+
+ ELSE
+!
+!-- Neumann condition
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ IF ( nzb_u_inner(j,i) == 0 ) u(0,j,i) = u(1,j,i)
+ IF ( nzb_v_inner(j,i) == 0 ) v(0,j,i) = v(1,j,i)
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+ ENDIF
+
+ ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 ) &
+ THEN
+!
+!-- Use constructed initial profiles (velocity constant with height,
+!-- temperature profile with constant gradient)
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ pt(:,j,i) = pt_init
+ u(:,j,i) = u_init
+ v(:,j,i) = v_init
+ ENDDO
+ ENDDO
+
+!
+!-- Set initial horizontal velocities at the lowest computational grid levels
+!-- to zero in order to avoid too small time steps caused by the diffusion
+!-- limit in the initial phase of a run (at k=1, dz/2 occurs in the
+!-- limiting formula!). The original values are stored to be later used for
+!-- volume flow control.
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ u(nzb:nzb_u_inner(j,i)+1,j,i) = 0.0
+ v(nzb:nzb_v_inner(j,i)+1,j,i) = 0.0
+ ENDDO
+ ENDDO
+ IF ( conserve_volume_flow ) THEN
+ IF ( nxr == nx ) THEN
+ DO j = nys, nyn
+ DO k = nzb + 1, nzb_u_inner(j,nx) + 1
+ u_nzb_p1_for_vfc(j) = u_init(k) * dzu(k)
+ ENDDO
+ ENDDO
+ ENDIF
+ IF ( nyn == ny ) THEN
+ DO i = nxl, nxr
+ DO k = nzb + 1, nzb_v_inner(ny,i) + 1
+ v_nzb_p1_for_vfc(i) = v_init(k) * dzu(k)
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+
+ IF ( humidity .OR. passive_scalar ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ q(:,j,i) = q_init
+ ENDDO
+ ENDDO
+ ENDIF
+
+ IF ( ocean ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ sa(:,j,i) = sa_init
+ ENDDO
+ ENDDO
+ ENDIF
+
+ IF ( constant_diffusion ) THEN
+ km = km_constant
+ kh = km / prandtl_number
+ e = 0.0
+ ELSEIF ( e_init > 0.0 ) THEN
+ DO k = nzb+1, nzt
+ km(k,:,:) = 0.1 * l_grid(k) * SQRT( e_init )
+ ENDDO
+ km(nzb,:,:) = km(nzb+1,:,:)
+ km(nzt+1,:,:) = km(nzt,:,:)
+ kh = km / prandtl_number
+ e = e_init
+ ELSE
+ IF ( .NOT. ocean ) THEN
+ kh = 0.01 ! there must exist an initial diffusion, because
+ km = 0.01 ! otherwise no TKE would be produced by the
+ ! production terms, as long as not yet
+ ! e = (u*/cm)**2 at k=nzb+1
+ ELSE
+ kh = 0.00001
+ km = 0.00001
+ ENDIF
+ e = 0.0
+ ENDIF
+ rif = 0.0
+ ts = 0.0
+ us = 0.0
+ usws = 0.0
+ uswst = top_momentumflux_u
+ vsws = 0.0
+ vswst = top_momentumflux_v
+ IF ( humidity .OR. passive_scalar ) qs = 0.0
+
+!
+!-- Compute initial temperature field and other constants used in case
+!-- of a sloping surface
+ IF ( sloping_surface ) CALL init_slope
+
+ ELSEIF ( INDEX(initializing_actions, 'by_user') /= 0 ) &
+ THEN
+!
+!-- Initialization will completely be done by the user
+ CALL user_init_3d_model
+
+ ENDIF
+
+!
+!-- apply channel flow boundary condition
+ IF ( TRIM( bc_uv_t ) == 'dirichlet_0' ) THEN
+
+ u(nzt+1,:,:) = 0.0
+ v(nzt+1,:,:) = 0.0
+
+!-- for the Dirichlet condition to be correctly applied at the top, set
+!-- ug and vg to zero there
+ ug(nzt+1) = 0.0
+ vg(nzt+1) = 0.0
+
+ ENDIF
+
+!
+!-- Calculate virtual potential temperature
+ IF ( humidity ) vpt = pt * ( 1.0 + 0.61 * q )
+
+!
+!-- Store initial profiles for output purposes etc.
+ hom(:,1,5,:) = SPREAD( u(:,nys,nxl), 2, statistic_regions+1 )
+ hom(:,1,6,:) = SPREAD( v(:,nys,nxl), 2, statistic_regions+1 )
+ IF ( ibc_uv_b == 0 ) THEN
+ hom(nzb,1,5,:) = -hom(nzb+1,1,5,:) ! due to satisfying the Dirichlet
+ hom(nzb,1,6,:) = -hom(nzb+1,1,6,:) ! condition with an extra layer
+ ! below the surface where the u and v component change their sign
+ ENDIF
+ hom(:,1,7,:) = SPREAD( pt(:,nys,nxl), 2, statistic_regions+1 )
+ hom(:,1,23,:) = SPREAD( km(:,nys,nxl), 2, statistic_regions+1 )
+ hom(:,1,24,:) = SPREAD( kh(:,nys,nxl), 2, statistic_regions+1 )
+
+ IF ( ocean ) THEN
+!
+!-- Store initial salinity profile
+ hom(:,1,26,:) = SPREAD( sa(:,nys,nxl), 2, statistic_regions+1 )
+ ENDIF
+
+ IF ( humidity ) THEN
+!
+!-- Store initial profile of total water content, virtual potential
+!-- temperature
+ hom(:,1,26,:) = SPREAD( q(:,nys,nxl), 2, statistic_regions+1 )
+ hom(:,1,29,:) = SPREAD( vpt(:,nys,nxl), 2, statistic_regions+1 )
+ IF ( cloud_physics .OR. cloud_droplets ) THEN
+!
+!-- Store initial profile of specific humidity and potential
+!-- temperature
+ hom(:,1,27,:) = SPREAD( q(:,nys,nxl), 2, statistic_regions+1 )
+ hom(:,1,28,:) = SPREAD( pt(:,nys,nxl), 2, statistic_regions+1 )
+ ENDIF
+ ENDIF
+
+ IF ( passive_scalar ) THEN
+!
+!-- Store initial scalar profile
+ hom(:,1,26,:) = SPREAD( q(:,nys,nxl), 2, statistic_regions+1 )
+ ENDIF
+
+!
+!-- Initialize fluxes at bottom surface
+ IF ( use_surface_fluxes ) THEN
+
+ IF ( constant_heatflux ) THEN
+!
+!-- Heat flux is prescribed
+ IF ( random_heatflux ) THEN
+ CALL disturb_heatflux
+ ELSE
+ shf = surface_heatflux
+!
+!-- Over topography surface_heatflux is replaced by wall_heatflux(0)
+ IF ( TRIM( topography ) /= 'flat' ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ IF ( nzb_s_inner(j,i) /= 0 ) THEN
+ shf(j,i) = wall_heatflux(0)
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+ IF ( ASSOCIATED( shf_m ) ) shf_m = shf
+ ENDIF
+
+!
+!-- Determine the near-surface water flux
+ IF ( humidity .OR. passive_scalar ) THEN
+ IF ( constant_waterflux ) THEN
+ qsws = surface_waterflux
+ IF ( ASSOCIATED( qsws_m ) ) qsws_m = qsws
+ ENDIF
+ ENDIF
+
+ ENDIF
+
+!
+!-- Initialize fluxes at top surface
+!-- Currently, only the heatflux and salinity flux can be prescribed.
+!-- The latent flux is zero in this case!
+ IF ( use_top_fluxes ) THEN
+
+ IF ( constant_top_heatflux ) THEN
+!
+!-- Heat flux is prescribed
+ tswst = top_heatflux
+ IF ( ASSOCIATED( tswst_m ) ) tswst_m = tswst
+
+ IF ( humidity .OR. passive_scalar ) THEN
+ qswst = 0.0
+ IF ( ASSOCIATED( qswst_m ) ) qswst_m = qswst
+ ENDIF
+
+ IF ( ocean ) THEN
+ saswsb = bottom_salinityflux
+ saswst = top_salinityflux
+ ENDIF
+ ENDIF
+
+!
+!-- Initialization in case of a coupled model run
+ IF ( coupling_mode == 'ocean_to_atmosphere' ) THEN
+ tswst = 0.0
+ IF ( ASSOCIATED( tswst_m ) ) tswst_m = tswst
+ ENDIF
+
+ ENDIF
+
+!
+!-- Initialize Prandtl layer quantities
+ IF ( prandtl_layer ) THEN
+
+ z0 = roughness_length
+
+ IF ( .NOT. constant_heatflux ) THEN
+!
+!-- Surface temperature is prescribed. Here the heat flux cannot be
+!-- simply estimated, because therefore rif, u* and theta* would have
+!-- to be computed by iteration. This is why the heat flux is assumed
+!-- to be zero before the first time step. It approaches its correct
+!-- value in the course of the first few time steps.
+ shf = 0.0
+ IF ( ASSOCIATED( shf_m ) ) shf_m = 0.0
+ ENDIF
+
+ IF ( humidity .OR. passive_scalar ) THEN
+ IF ( .NOT. constant_waterflux ) THEN
+ qsws = 0.0
+ IF ( ASSOCIATED( qsws_m ) ) qsws_m = 0.0
+ ENDIF
+ ENDIF
+
+ ENDIF
+
+!
+!-- Calculate the initial volume flow at the right and north boundary
+ IF ( conserve_volume_flow ) THEN
+
+ volume_flow_initial_l = 0.0
+ volume_flow_area_l = 0.0
+
+ IF ( nxr == nx ) THEN
+ DO j = nys, nyn
+ DO k = nzb_2d(j,nx) + 1, nzt
+ volume_flow_initial_l(1) = volume_flow_initial_l(1) + &
+ u(k,j,nx) * dzu(k)
+ volume_flow_area_l(1) = volume_flow_area_l(1) + dzu(k)
+ ENDDO
+!
+!-- Correction if velocity at nzb+1 has been set zero further above
+ volume_flow_initial_l(1) = volume_flow_initial_l(1) + &
+ u_nzb_p1_for_vfc(j)
+ ENDDO
+ ENDIF
+
+ IF ( nyn == ny ) THEN
+ DO i = nxl, nxr
+ DO k = nzb_2d(ny,i) + 1, nzt
+ volume_flow_initial_l(2) = volume_flow_initial_l(2) + &
+ v(k,ny,i) * dzu(k)
+ volume_flow_area_l(2) = volume_flow_area_l(2) + dzu(k)
+ ENDDO
+!
+!-- Correction if velocity at nzb+1 has been set zero further above
+ volume_flow_initial_l(2) = volume_flow_initial_l(2) + &
+ v_nzb_p1_for_vfc(i)
+ ENDDO
+ ENDIF
+
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( volume_flow_initial_l(1), volume_flow_initial(1),&
+ 2, MPI_REAL, MPI_SUM, comm2d, ierr )
+ CALL MPI_ALLREDUCE( volume_flow_area_l(1), volume_flow_area(1), &
+ 2, MPI_REAL, MPI_SUM, comm2d, ierr )
+#else
+ volume_flow_initial = volume_flow_initial_l
+ volume_flow_area = volume_flow_area_l
+#endif
+ ENDIF
+
+!
+!-- For the moment, perturbation pressure and vertical velocity are zero
+ p = 0.0; w = 0.0
+
+!
+!-- Initialize array sums (must be defined in first call of pres)
+ sums = 0.0
+
+!
+!-- Treating cloud physics, liquid water content and precipitation amount
+!-- are zero at beginning of the simulation
+ IF ( cloud_physics ) THEN
+ ql = 0.0
+ IF ( precipitation ) precipitation_amount = 0.0
+ ENDIF
+
+!
+!-- Initialize spectra
+ IF ( dt_dosp /= 9999999.9 ) THEN
+ spectrum_x = 0.0
+ spectrum_y = 0.0
+ ENDIF
+
+!
+!-- Impose vortex with vertical axis on the initial velocity profile
+ IF ( INDEX( initializing_actions, 'initialize_vortex' ) /= 0 ) THEN
+ CALL init_rankine
+ ENDIF
+
+!
+!-- Impose temperature anomaly (advection test only)
+ IF ( INDEX( initializing_actions, 'initialize_ptanom' ) /= 0 ) THEN
+ CALL init_pt_anomaly
+ ENDIF
+
+!
+!-- If required, change the surface temperature at the start of the 3D run
+ IF ( pt_surface_initial_change /= 0.0 ) THEN
+ pt(nzb,:,:) = pt(nzb,:,:) + pt_surface_initial_change
+ ENDIF
+
+!
+!-- If required, change the surface humidity/scalar at the start of the 3D
+!-- run
+ IF ( ( humidity .OR. passive_scalar ) .AND. &
+ q_surface_initial_change /= 0.0 ) THEN
+ q(nzb,:,:) = q(nzb,:,:) + q_surface_initial_change
+ ENDIF
+
+!
+!-- Initialize the random number generator (from numerical recipes)
+ CALL random_function_ini
+
+!
+!-- Impose random perturbation on the horizontal velocity field and then
+!-- remove the divergences from the velocity field
+ IF ( create_disturbances ) THEN
+ CALL disturb_field( nzb_u_inner, tend, u )
+ CALL disturb_field( nzb_v_inner, tend, v )
+ n_sor = nsor_ini
+ CALL pres
+ n_sor = nsor
+ ENDIF
+
+!
+!-- Once again set the perturbation pressure explicitly to zero in order to
+!-- assure that it does not generate any divergences in the first time step.
+!-- At t=0 the velocity field is free of divergence (as constructed above).
+!-- Divergences being created during a time step are not yet known and thus
+!-- cannot be corrected during the time step yet.
+ p = 0.0
+
+!
+!-- Initialize old and new time levels.
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+ e_m = e; pt_m = pt; u_m = u; v_m = v; w_m = w; kh_m = kh; km_m = km
+ ELSE
+ te_m = 0.0; tpt_m = 0.0; tu_m = 0.0; tv_m = 0.0; tw_m = 0.0
+ ENDIF
+ e_p = e; pt_p = pt; u_p = u; v_p = v; w_p = w
+
+ IF ( humidity .OR. passive_scalar ) THEN
+ IF ( ASSOCIATED( q_m ) ) q_m = q
+ IF ( timestep_scheme(1:5) == 'runge' ) tq_m = 0.0
+ q_p = q
+ IF ( humidity .AND. ASSOCIATED( vpt_m ) ) vpt_m = vpt
+ ENDIF
+
+ IF ( ocean ) THEN
+ tsa_m = 0.0
+ sa_p = sa
+ ENDIF
+
+!
+!-- Initialize old timelevels needed for radiation boundary conditions
+ IF ( outflow_l ) THEN
+ u_m_l(:,:,:) = u(:,:,1:2)
+ v_m_l(:,:,:) = v(:,:,0:1)
+ w_m_l(:,:,:) = w(:,:,0:1)
+ ENDIF
+ IF ( outflow_r ) THEN
+ u_m_r(:,:,:) = u(:,:,nx-1:nx)
+ v_m_r(:,:,:) = v(:,:,nx-1:nx)
+ w_m_r(:,:,:) = w(:,:,nx-1:nx)
+ ENDIF
+ IF ( outflow_s ) THEN
+ u_m_s(:,:,:) = u(:,0:1,:)
+ v_m_s(:,:,:) = v(:,1:2,:)
+ w_m_s(:,:,:) = w(:,0:1,:)
+ ENDIF
+ IF ( outflow_n ) THEN
+ u_m_n(:,:,:) = u(:,ny-1:ny,:)
+ v_m_n(:,:,:) = v(:,ny-1:ny,:)
+ w_m_n(:,:,:) = w(:,ny-1:ny,:)
+ ENDIF
+
+ ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data' ) &
+ THEN
+!
+!-- Read binary data from restart file
+ CALL read_3d_binary
+
+!
+!-- Calculate initial temperature field and other constants used in case
+!-- of a sloping surface
+ IF ( sloping_surface ) CALL init_slope
+
+!
+!-- Initialize new time levels (only done in order to set boundary values
+!-- including ghost points)
+ e_p = e; pt_p = pt; u_p = u; v_p = v; w_p = w
+ IF ( humidity .OR. passive_scalar ) q_p = q
+ IF ( ocean ) sa_p = sa
+
+ ELSE
+!
+!-- Actually this part of the programm should not be reached
+ IF ( myid == 0 ) PRINT*,'+++ init_3d_model: unknown initializing ', &
+ 'problem'
+ CALL local_stop
+ ENDIF
+
+!
+!-- Initialization of the leaf area density
+ IF ( plant_canopy ) THEN
+
+ SELECT CASE ( TRIM( canopy_mode ) )
+
+ CASE( 'block' )
+
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ lad_s(:,j,i) = lad(:)
+ cdc(:,j,i) = drag_coefficient
+ ENDDO
+ ENDDO
+
+ CASE DEFAULT
+
+!
+!-- The DEFAULT case is reached either if the parameter
+!-- canopy mode contains a wrong character string or if the
+!-- user has coded a special case in the user interface.
+!-- There, the subroutine user_init_plant_canopy checks
+!-- which of these two conditions applies.
+ CALL user_init_plant_canopy
+
+ END SELECT
+
+ CALL exchange_horiz( lad_s )
+ CALL exchange_horiz( cdc )
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb, nzt+1
+ lad_u(k,j,i) = 0.5 * ( lad_s(k,j,i-1) + lad_s(k,j,i) )
+ lad_v(k,j,i) = 0.5 * ( lad_s(k,j-1,i) + lad_s(k,j,i) )
+ ENDDO
+ DO k = nzb, nzt
+ lad_w(k,j,i) = 0.5 * ( lad_s(k+1,j,i) + lad_s(k,j,i) )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ lad_w(nzt+1,:,:) = lad_w(nzt,:,:)
+
+ CALL exchange_horiz( lad_u )
+ CALL exchange_horiz( lad_v )
+ CALL exchange_horiz( lad_w )
+
+ ENDIF
+
+!
+!-- If required, initialize dvrp-software
+ IF ( dt_dvrp /= 9999999.9 ) CALL init_dvrp
+
+ IF ( ocean ) THEN
+!
+!-- Initialize quantities needed for the ocean model
+ CALL init_ocean
+ ELSE
+!
+!-- Initialize quantities for handling cloud physics
+!-- This routine must be called before init_particles, because
+!-- otherwise, array pt_d_t, needed in data_output_dvrp (called by
+!-- init_particles) is not defined.
+ CALL init_cloud_physics
+ ENDIF
+
+!
+!-- If required, initialize particles
+ IF ( particle_advection ) CALL init_particles
+
+!
+!-- Initialize quantities for special advections schemes
+ CALL init_advec
+
+!
+!-- Initialize Rayleigh damping factors
+ rdf = 0.0
+ IF ( rayleigh_damping_factor /= 0.0 ) THEN
+ IF ( .NOT. ocean ) THEN
+ DO k = nzb+1, nzt
+ IF ( zu(k) >= rayleigh_damping_height ) THEN
+ rdf(k) = rayleigh_damping_factor * &
+ ( SIN( pi * 0.5 * ( zu(k) - rayleigh_damping_height ) &
+ / ( zu(nzt) - rayleigh_damping_height ) )&
+ )**2
+ ENDIF
+ ENDDO
+ ELSE
+ DO k = nzt, nzb+1, -1
+ IF ( zu(k) <= rayleigh_damping_height ) THEN
+ rdf(k) = rayleigh_damping_factor * &
+ ( SIN( pi * 0.5 * ( rayleigh_damping_height - zu(k) ) &
+ / ( rayleigh_damping_height - zu(nzb+1)))&
+ )**2
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDIF
+
+!
+!-- Initialize diffusivities used within the outflow damping layer in case of
+!-- non-cyclic lateral boundaries. A linear increase is assumed over the first
+!-- half of the width of the damping layer
+ IF ( bc_lr == 'dirichlet/radiation' ) THEN
+
+ DO i = nxl-1, nxr+1
+ IF ( i >= nx - outflow_damping_width ) THEN
+ km_damp_x(i) = km_damp_max * MIN( 1.0, &
+ ( i - ( nx - outflow_damping_width ) ) / &
+ REAL( outflow_damping_width/2 ) &
+ )
+ ELSE
+ km_damp_x(i) = 0.0
+ ENDIF
+ ENDDO
+
+ ELSEIF ( bc_lr == 'radiation/dirichlet' ) THEN
+
+ DO i = nxl-1, nxr+1
+ IF ( i <= outflow_damping_width ) THEN
+ km_damp_x(i) = km_damp_max * MIN( 1.0, &
+ ( outflow_damping_width - i ) / &
+ REAL( outflow_damping_width/2 ) &
+ )
+ ELSE
+ km_damp_x(i) = 0.0
+ ENDIF
+ ENDDO
+
+ ENDIF
+
+ IF ( bc_ns == 'dirichlet/radiation' ) THEN
+
+ DO j = nys-1, nyn+1
+ IF ( j >= ny - outflow_damping_width ) THEN
+ km_damp_y(j) = km_damp_max * MIN( 1.0, &
+ ( j - ( ny - outflow_damping_width ) ) / &
+ REAL( outflow_damping_width/2 ) &
+ )
+ ELSE
+ km_damp_y(j) = 0.0
+ ENDIF
+ ENDDO
+
+ ELSEIF ( bc_ns == 'radiation/dirichlet' ) THEN
+
+ DO j = nys-1, nyn+1
+ IF ( j <= outflow_damping_width ) THEN
+ km_damp_y(j) = km_damp_max * MIN( 1.0, &
+ ( outflow_damping_width - j ) / &
+ REAL( outflow_damping_width/2 ) &
+ )
+ ELSE
+ km_damp_y(j) = 0.0
+ ENDIF
+ ENDDO
+
+ ENDIF
+
+!
+!-- Initialize local summation arrays for UP flow_statistics. This is necessary
+!-- because they may not yet have been initialized when they are called from
+!-- flow_statistics (or - depending on the chosen model run - are never
+!-- initialized)
+ sums_divnew_l = 0.0
+ sums_divold_l = 0.0
+ sums_l_l = 0.0
+ sums_up_fraction_l = 0.0
+ sums_wsts_bc_l = 0.0
+
+!
+!-- Pre-set masks for regional statistics. Default is the total model domain.
+ rmask = 1.0
+
+!
+!-- User-defined initializing actions. Check afterwards, if maximum number
+!-- of allowed timeseries is not exceeded
+ CALL user_init
+
+ IF ( dots_num > dots_max ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ user_init: number of time series quantities exceeds', &
+ ' its maximum of dots_max = ', dots_max
+ PRINT*, ' Please increase dots_max in modules.f90.'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Input binary data file is not needed anymore. This line must be placed
+!-- after call of user_init!
+ CALL close_file( 13 )
+
+!
+!-- Compute total sum of active mask grid points
+!-- ngp_2dh: number of grid points of a horizontal cross section through the
+!-- total domain
+!-- ngp_3d: number of grid points of the total domain
+ ngp_2dh_outer_l = 0
+ ngp_2dh_outer = 0
+ ngp_2dh_s_inner_l = 0
+ ngp_2dh_s_inner = 0
+ ngp_2dh_l = 0
+ ngp_2dh = 0
+ ngp_3d_inner_l = 0
+ ngp_3d_inner = 0
+ ngp_3d = 0
+ ngp_sums = ( nz + 2 ) * ( pr_palm + max_pr_user )
+
+ DO sr = 0, statistic_regions
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ IF ( rmask(j,i,sr) == 1.0 ) THEN
+!
+!-- All xy-grid points
+ ngp_2dh_l(sr) = ngp_2dh_l(sr) + 1
+!
+!-- xy-grid points above topography
+ DO k = nzb_s_outer(j,i), nz + 1
+ ngp_2dh_outer_l(k,sr) = ngp_2dh_outer_l(k,sr) + 1
+ ENDDO
+ DO k = nzb_s_inner(j,i), nz + 1
+ ngp_2dh_s_inner_l(k,sr) = ngp_2dh_s_inner_l(k,sr) + 1
+ ENDDO
+!
+!-- All grid points of the total domain above topography
+ ngp_3d_inner_l(sr) = ngp_3d_inner_l(sr) + &
+ ( nz - nzb_s_inner(j,i) + 2 )
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+
+ sr = statistic_regions + 1
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( ngp_2dh_l(0), ngp_2dh(0), sr, MPI_INTEGER, MPI_SUM, &
+ comm2d, ierr )
+ CALL MPI_ALLREDUCE( ngp_2dh_outer_l(0,0), ngp_2dh_outer(0,0), (nz+2)*sr, &
+ MPI_INTEGER, MPI_SUM, comm2d, ierr )
+ CALL MPI_ALLREDUCE( ngp_2dh_s_inner_l(0,0), ngp_2dh_s_inner(0,0), &
+ (nz+2)*sr, MPI_INTEGER, MPI_SUM, comm2d, ierr )
+ CALL MPI_ALLREDUCE( ngp_3d_inner_l(0), ngp_3d_inner(0), sr, MPI_INTEGER, &
+ MPI_SUM, comm2d, ierr )
+#else
+ ngp_2dh = ngp_2dh_l
+ ngp_2dh_outer = ngp_2dh_outer_l
+ ngp_2dh_s_inner = ngp_2dh_s_inner_l
+ ngp_3d_inner = ngp_3d_inner_l
+#endif
+
+ ngp_3d = ngp_2dh * ( nz + 2 )
+
+!
+!-- Set a lower limit of 1 in order to avoid zero divisions in flow_statistics,
+!-- buoyancy, etc. A zero value will occur for cases where all grid points of
+!-- the respective subdomain lie below the surface topography
+ ngp_2dh_outer = MAX( 1, ngp_2dh_outer(:,:) )
+ ngp_3d_inner = MAX( 1, ngp_3d_inner(:) )
+
+ DEALLOCATE( ngp_2dh_l, ngp_2dh_outer_l, ngp_3d_inner_l )
+
+
+ END SUBROUTINE init_3d_model
Index: /palm/tags/release-3.4a/SOURCE/init_advec.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/init_advec.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/init_advec.f90 (revision 141)
@@ -0,0 +1,236 @@
+ SUBROUTINE init_advec
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.6 2004/04/30 11:59:31 raasch
+! impulse_advec renamed momentum_advec
+!
+! Revision 1.1 1999/02/05 09:07:38 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Initialize constant coefficients and parameters for certain advection schemes.
+!------------------------------------------------------------------------------!
+
+ USE advection
+ USE arrays_3d
+ USE indices
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ INTEGER :: i, intervals, j, k
+ REAL :: delt, dn, dnneu, ex1, ex2, ex3, ex4, ex5, ex6, spl_alpha, &
+ spl_beta, sterm
+ REAL, DIMENSION(:), ALLOCATABLE :: spl_u, temp
+
+
+ IF ( scalar_advec == 'bc-scheme' ) THEN
+
+!
+!-- Compute exponential coefficients for the Bott-Chlond scheme
+ intervals = 1000
+ ALLOCATE( aex(intervals), bex(intervals), dex(intervals), eex(intervals) )
+
+ delt = 1.0 / REAL( intervals )
+ sterm = delt * 0.5
+
+ DO i = 1, intervals
+
+ IF ( sterm > 0.5 ) THEN
+ dn = -5.0
+ ELSE
+ dn = 5.0
+ ENDIF
+
+ DO j = 1, 15
+ ex1 = dn * EXP( -dn ) - EXP( 0.5 * dn ) + EXP( -0.5 * dn )
+ ex2 = EXP( dn ) - EXP( -dn )
+ ex3 = EXP( -dn ) * ( 1.0 - dn ) - 0.5 * EXP( 0.5 * dn ) &
+ - 0.5 * EXP( -0.5 * dn )
+ ex4 = EXP( dn ) + EXP( -dn )
+ ex5 = dn * sterm + ex1 / ex2
+ ex6 = sterm + ( ex3 * ex2 - ex4 * ex1 ) / ( ex2 * ex2 )
+ dnneu = dn - ex5 / ex6
+ dn = dnneu
+ ENDDO
+
+ IF ( sterm < 0.5 ) dn = MAX( 2.95E-2, dn )
+ IF ( sterm > 0.5 ) dn = MIN( -2.95E-2, dn )
+ ex1 = EXP( -dn )
+ ex2 = EXP( dn ) - ex1
+ aex(i) = -ex1 / ex2
+ bex(i) = 1.0 / ex2
+ dex(i) = dn
+ eex(i) = EXP( dex(i) * 0.5 )
+ sterm = sterm + delt
+
+ ENDDO
+
+ ENDIF
+
+ IF ( momentum_advec == 'ups-scheme' .OR. scalar_advec == 'ups-scheme' ) &
+ THEN
+
+!
+!-- Provide the constant parameters for the Upstream-Spline advection scheme.
+!-- In x- und y-direction the Sherman-Morrison formula is applied
+!-- (cf. Press et al, 1986 (Numerical Recipes)).
+!
+!-- Allocate nonlocal arrays
+ ALLOCATE( spl_z_x(0:nx), spl_z_y(0:ny), spl_tri_x(5,0:nx), &
+ spl_tri_y(5,0:ny), spl_tri_zu(5,nzb:nzt+1), &
+ spl_tri_zw(5,nzb:nzt+1) )
+
+!
+!-- Provide diagonal elements of the tridiagonal matrices for all
+!-- directions
+ spl_tri_x(1,:) = 2.0
+ spl_tri_y(1,:) = 2.0
+ spl_tri_zu(1,:) = 2.0
+ spl_tri_zw(1,:) = 2.0
+
+!
+!-- Elements of the cyclic tridiagonal matrix
+!-- (same for all horizontal directions)
+ spl_alpha = 0.5
+ spl_beta = 0.5
+
+!
+!-- Sub- and superdiagonal elements, x-direction
+ spl_tri_x(2,0:nx) = 0.5
+ spl_tri_x(3,0:nx) = 0.5
+
+!
+!-- mMdify the diagonal elements (Sherman-Morrison)
+ spl_gamma_x = -spl_tri_x(1,0)
+ spl_tri_x(1,0) = spl_tri_x(1,0) - spl_gamma_x
+ spl_tri_x(1,nx) = spl_tri_x(1,nx) - spl_alpha * spl_beta / spl_gamma_x
+
+!
+!-- Split the tridiagonal matrix for Thomas algorithm
+ spl_tri_x(4,0) = spl_tri_x(1,0)
+ DO i = 1, nx
+ spl_tri_x(5,i) = spl_tri_x(2,i) / spl_tri_x(4,i-1)
+ spl_tri_x(4,i) = spl_tri_x(1,i) - spl_tri_x(5,i) * spl_tri_x(3,i-1)
+ ENDDO
+
+!
+!-- Allocate arrays required locally
+ ALLOCATE( temp(0:nx), spl_u(0:nx) )
+
+!
+!-- Provide "corrective vector", x-direction
+ spl_u(0) = spl_gamma_x
+ spl_u(1:nx-1) = 0.0
+ spl_u(nx) = spl_alpha
+
+!
+!-- Solve the system of equations for the corrective vector
+!-- (Sherman-Morrison)
+ temp(0) = spl_u(0)
+ DO i = 1, nx
+ temp(i) = spl_u(i) - spl_tri_x(5,i) * temp(i-1)
+ ENDDO
+ spl_z_x(nx) = temp(nx) / spl_tri_x(4,nx)
+ DO i = nx-1, 0, -1
+ spl_z_x(i) = ( temp(i) - spl_tri_x(3,i) * spl_z_x(i+1) ) / &
+ spl_tri_x(4,i)
+ ENDDO
+
+!
+!-- Deallocate local arrays, for they are allocated in a different way for
+!-- operations in y-direction
+ DEALLOCATE( temp, spl_u )
+
+!
+!-- Provide sub- and superdiagonal elements, y-direction
+ spl_tri_y(2,0:ny) = 0.5
+ spl_tri_y(3,0:ny) = 0.5
+
+!
+!-- Modify the diagonal elements (Sherman-Morrison)
+ spl_gamma_y = -spl_tri_y(1,0)
+ spl_tri_y(1,0) = spl_tri_y(1,0) - spl_gamma_y
+ spl_tri_y(1,ny) = spl_tri_y(1,ny) - spl_alpha * spl_beta / spl_gamma_y
+
+!
+!-- Split the tridiagonal matrix for Thomas algorithm
+ spl_tri_y(4,0) = spl_tri_y(1,0)
+ DO j = 1, ny
+ spl_tri_y(5,j) = spl_tri_y(2,j) / spl_tri_y(4,j-1)
+ spl_tri_y(4,j) = spl_tri_y(1,j) - spl_tri_y(5,j) * spl_tri_y(3,j-1)
+ ENDDO
+
+!
+!-- Allocate arrays required locally
+ ALLOCATE( temp(0:ny), spl_u(0:ny) )
+
+!
+!-- Provide "corrective vector", y-direction
+ spl_u(0) = spl_gamma_y
+ spl_u(1:ny-1) = 0.0
+ spl_u(ny) = spl_alpha
+
+!
+!-- Solve the system of equations for the corrective vector
+!-- (Sherman-Morrison)
+ temp = 0.0
+ spl_z_y = 0.0
+ temp(0) = spl_u(0)
+ DO j = 1, ny
+ temp(j) = spl_u(j) - spl_tri_y(5,j) * temp(j-1)
+ ENDDO
+ spl_z_y(ny) = temp(ny) / spl_tri_y(4,ny)
+ DO j = ny-1, 0, -1
+ spl_z_y(j) = ( temp(j) - spl_tri_y(3,j) * spl_z_y(j+1) ) / &
+ spl_tri_y(4,j)
+ ENDDO
+
+!
+!-- deallocate local arrays, for they are no longer required
+ DEALLOCATE( temp, spl_u )
+
+!
+!-- provide sub- and superdiagonal elements, z-direction
+ spl_tri_zu(2,nzb) = 0.0
+ spl_tri_zu(2,nzt+1) = 1.0
+ spl_tri_zw(2,nzb) = 0.0
+ spl_tri_zw(2,nzt+1) = 1.0
+
+ spl_tri_zu(3,nzb) = 1.0
+ spl_tri_zu(3,nzt+1) = 0.0
+ spl_tri_zw(3,nzb) = 1.0
+ spl_tri_zw(3,nzt+1) = 0.0
+
+ DO k = nzb+1, nzt
+ spl_tri_zu(2,k) = dzu(k) / ( dzu(k) + dzu(k+1) )
+ spl_tri_zw(2,k) = dzw(k) / ( dzw(k) + dzw(k+1) )
+ spl_tri_zu(3,k) = 1.0 - spl_tri_zu(2,k)
+ spl_tri_zw(3,k) = 1.0 - spl_tri_zw(2,k)
+ ENDDO
+
+ spl_tri_zu(4,nzb) = spl_tri_zu(1,nzb)
+ spl_tri_zw(4,nzb) = spl_tri_zw(1,nzb)
+ DO k = nzb+1, nzt+1
+ spl_tri_zu(5,k) = spl_tri_zu(2,k) / spl_tri_zu(4,k-1)
+ spl_tri_zw(5,k) = spl_tri_zw(2,k) / spl_tri_zw(4,k-1)
+ spl_tri_zu(4,k) = spl_tri_zu(1,k) - spl_tri_zu(5,k) * &
+ spl_tri_zu(3,k-1)
+ spl_tri_zw(4,k) = spl_tri_zw(1,k) - spl_tri_zw(5,k) * &
+ spl_tri_zw(3,k-1)
+ ENDDO
+
+ ENDIF
+
+ END SUBROUTINE init_advec
Index: /palm/tags/release-3.4a/SOURCE/init_cloud_physics.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/init_cloud_physics.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/init_cloud_physics.f90 (revision 141)
@@ -0,0 +1,75 @@
+ SUBROUTINE init_cloud_physics
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! ------------------
+! $Id$
+!
+! 95 2007-06-02 16:48:38Z raasch
+! hydro_press renamed hyp
+!
+! February 2007
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.5 2005/06/26 19:55:58 raasch
+! Initialization of cloud droplet constants, gas_constant renamed r_d,
+! latent_heat renamed l_v
+!
+! Revision 1.1 2000/04/13 14:37:22 schroeter
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Initialization of parameters for handling cloud-physics
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE cloud_parameters
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: k
+ REAL :: t_surface
+
+ ALLOCATE( hyp(nzb:nzt+1), pt_d_t(nzb:nzt+1), t_d_pt(nzb:nzt+1) )
+
+!
+!-- Compute frequently used parameters
+ l_d_cp = l_v / cp
+ l_d_r = l_v / r_d
+ l_d_rv = l_v / r_v
+
+!
+!-- Constant b in equation for droplet growth by condensation / evaporation.
+!-- Factor 1E-3 is needed because formula is in cgs units
+ mass_of_solute = 1.0E-17 ! in kg
+ molecular_weight_of_solute = 58.5 ! NaCl
+ b_cond = 4.3 * 2.0 * mass_of_solute / molecular_weight_of_solute * 1.0E-6
+
+!
+!-- Calculate:
+!-- pt / t : ratio of potential and actual temperature (pt_d_t)
+!-- t / pt : ratio of actual and potential temperature (t_d_pt)
+!-- p_0(z) : vertical profile of the hydrostatic pressure (hyp)
+ t_surface = pt_surface * ( surface_pressure / 1000.0 )**0.286
+ DO k = nzb, nzt+1
+ hyp(k) = surface_pressure * 100.0 * &
+ ( (t_surface - g/cp * zu(k)) / t_surface )**(1.0/0.286)
+ pt_d_t(k) = ( 100000.0 / hyp(k) )**0.286
+ t_d_pt(k) = 1.0 / pt_d_t(k)
+ ENDDO
+
+!
+!-- Compute reference density
+ rho_surface = surface_pressure * 100.0 / ( r_d * t_surface )
+
+
+ END SUBROUTINE init_cloud_physics
Index: /palm/tags/release-3.4a/SOURCE/init_dvrp.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/init_dvrp.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/init_dvrp.f90 (revision 141)
@@ -0,0 +1,631 @@
+ SUBROUTINE init_dvrp
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+! TEST: print* statements
+! ToDo: checking of mode_dvrp for legal values is not correct
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 130 2007-11-13 14:08:40Z letzel
+! allow two instead of one digit to specify isosurface and slicer variables
+! Test output of isosurface on camera file
+!
+! 82 2007-04-16 15:40:52Z raasch
+! Preprocessor strings for different linux clusters changed to "lc",
+! routine local_flush is used for buffer flushing
+!
+! 17 2007-02-19 01:57:39Z raasch
+! dvrp_output_local activated for all streams
+!
+! 13 2007-02-14 12:15:07Z raasch
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.12 2006/02/23 12:30:22 raasch
+! ebene renamed section, pl.. replaced by do..,
+!
+! Revision 1.1 2000/04/27 06:24:39 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Initializing actions needed when using dvrp-software
+!------------------------------------------------------------------------------!
+#if defined( __dvrp_graphics )
+
+ USE arrays_3d
+ USE DVRP
+ USE dvrp_variables
+ USE grid_variables
+ USE indices
+ USE pegrid
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=2) :: section_chr
+ CHARACTER (LEN=80) :: dvrp_file_local
+ INTEGER :: i, j, k, l, m, pn, tv, vn
+ LOGICAL :: allocated
+ REAL :: center(3), distance
+
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: local_pf
+
+ TYPE(CSTRING), SAVE :: dvrp_directory_c, dvrp_file_c, &
+ dvrp_file_local_c,dvrp_host_c, &
+ dvrp_password_c, dvrp_username_c, name_c
+
+!
+!-- Set the maximum time the program can be suspended on user request (by
+!-- dvrp steering). This variable is defined in module DVRP.
+ DVRP_MAX_SUSPEND_TIME = 7200
+
+!
+!-- Allocate array holding the names and limits of the steering variables
+!-- (must have the same number of elements as array mode_dvrp!)
+ ALLOCATE( steering_dvrp(10) )
+
+!
+!-- Check, if output parameters are given and/or allowed
+!-- and set default-values, where necessary
+ IF ( dvrp_username == ' ' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ init_dvrp: dvrp_username is undefined'
+ CALL local_stop
+ ENDIF
+ ENDIF
+
+ IF ( dvrp_output /= 'ftp' .AND. dvrp_output /= 'rtsp' .AND. &
+ dvrp_output /= 'local' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ init_dvrp: dvrp_output="', dvrp_output, '" not allowed'
+ CALL local_stop
+ ENDIF
+ ENDIF
+
+ IF ( dvrp_directory == 'default' ) THEN
+ dvrp_directory = TRIM( dvrp_username ) // '/' // TRIM( run_identifier )
+ ENDIF
+
+ IF ( dvrp_output /= 'local' ) THEN
+ IF ( dvrp_file /= 'default' .AND. dvrp_file /= '/dev/null' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ init_dvrp: dvrp_file="', dvrp_file, '" not allowed'
+ CALL local_stop
+ ENDIF
+ ENDIF
+ ENDIF
+
+!
+!-- Strings are assigned to strings of special type which have a CHAR( 0 )
+!-- (C end-of-character symbol) at their end. This is needed when strings are
+!-- passed to C routines.
+ dvrp_directory_c = dvrp_directory
+ dvrp_file_c = dvrp_file
+ dvrp_host_c = dvrp_host
+ dvrp_password_c = dvrp_password
+ dvrp_username_c = dvrp_username
+
+!
+!-- Loop over all output modes choosed
+ m = 1
+ allocated = .FALSE.
+ DO WHILE ( mode_dvrp(m) /= ' ' )
+
+!
+!-- Check, if mode is allowed
+ IF ( mode_dvrp(m)(1:10) /= 'isosurface' .AND. &
+ mode_dvrp(m)(1:6) /= 'slicer' .AND. &
+ mode_dvrp(m)(1:9) /= 'particles' ) THEN
+
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ init_dvrp: mode_dvrp="', mode_dvrp, '" not allowed'
+ ENDIF
+ CALL local_stop
+
+ ENDIF
+
+!
+!-- Camera position must be computed and written on file when no dvrp-output
+!-- has been generated so far (in former runs)
+! IF ( dvrp_filecount == 0 ) THEN
+!
+!-- Compute center of domain and distance of camera from center
+ center(1) = ( nx + 1.0 ) * dx * 0.5 * superelevation_x
+ center(2) = ( ny + 1.0 ) * dy * 0.5 * superelevation_y
+ center(3) = ( zu(nz_do3d) - zu(nzb) ) * 0.5 * superelevation
+ distance = 1.5 * MAX( ( nx + 1.0 ) * dx * superelevation_x, &
+ ( ny + 1.0 ) * dy * superelevation_y, &
+ ( zu(nz_do3d) - zu(nzb) ) * superelevation )
+
+!
+!-- Write camera position on file
+ CALL DVRP_INIT( m-1, 0 )
+
+!
+!-- Create filename for camera
+ IF ( dvrp_output == 'rtsp' ) THEN
+
+ WRITE ( 9, * ) '*** vor dvrp_output_rtsp'
+ CALL local_flush( 9 )
+
+ dvrp_file = TRIM( mode_dvrp(m) ) // '/camera.dvr'
+ dvrp_file_c = dvrp_file
+ CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
+ dvrp_password_c, dvrp_directory_c, &
+ dvrp_file_c )
+ WRITE ( 9, * ) '*** nach dvrp_output_rtsp'
+ CALL local_flush( 9 )
+
+ ELSEIF ( dvrp_output == 'ftp' ) THEN
+
+ dvrp_file = TRIM( mode_dvrp(m) ) // '.camera.dvr'
+ dvrp_file_c = dvrp_file
+! CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
+! dvrp_password_c, dvrp_directory_c, &
+! dvrp_file_c )
+
+ ELSE
+
+ IF ( dvrp_file(1:9) /= '/dev/null' ) THEN
+ dvrp_file_local = TRIM( mode_dvrp(m) ) // '.camera.dvr'
+ dvrp_file_local_c = dvrp_file_local
+ ELSE
+ dvrp_file_local_c = dvrp_file_c
+ ENDIF
+ CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
+
+ ENDIF
+
+ CALL DVRP_CAMERA( m-1, center, distance )
+ WRITE ( 9, * ) '*** #1'
+ CALL local_flush( 9 )
+
+!
+!-- Define bounding box material and create a bounding box
+ CALL DVRP_MATERIAL_RGB( m-1, 1, 0.5, 0.5, 0.5, 0.0 )
+ CALL DVRP_BOUNDINGBOX( m-1, 1, 0.01, 0.0, 0.0, 0.0, &
+ (nx+1) * dx * superelevation_x, &
+ (ny+1) * dy * superelevation_y, &
+ zu(nz_do3d) * superelevation )
+
+ CALL DVRP_VISUALIZE( m-1, 0, 0 )
+ CALL DVRP_EXIT( m-1 )
+ WRITE ( 9, * ) '*** #2'
+ CALL local_flush( 9 )
+
+
+!
+!-- Write topography isosurface on file
+ CALL DVRP_INIT( m-1, 0 )
+
+!
+!-- Create filename for buildings
+ IF ( dvrp_output == 'rtsp' ) THEN
+
+ dvrp_file = TRIM( mode_dvrp(m) ) // '/buildings.dvr'
+ dvrp_file_c = dvrp_file
+ CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
+ dvrp_password_c, dvrp_directory_c, &
+ dvrp_file_c )
+ WRITE ( 9, * ) '*** #3'
+ CALL local_flush( 9 )
+
+ ELSEIF ( dvrp_output == 'ftp' ) THEN
+
+ dvrp_file = TRIM( mode_dvrp(m) ) // '.buildings.dvr'
+ dvrp_file_c = dvrp_file
+! CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
+! dvrp_password_c, dvrp_directory_c, &
+! dvrp_file_c )
+
+ ELSE
+
+ IF ( dvrp_file(1:9) /= '/dev/null' ) THEN
+ dvrp_file_local = TRIM( mode_dvrp(m) ) // '.buildings.dvr'
+ dvrp_file_local_c = dvrp_file_local
+ ELSE
+ dvrp_file_local_c = dvrp_file_c
+ ENDIF
+ CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
+
+ ENDIF
+
+!
+!-- Determine local gridpoint coordinates
+ IF ( .NOT. allocated ) THEN
+ ALLOCATE( xcoor_dvrp(nxl:nxr+1), ycoor_dvrp(nys:nyn+1), &
+ zcoor_dvrp(nzb:nz_do3d) )
+ allocated = .TRUE.
+
+ DO i = nxl, nxr+1
+ xcoor_dvrp(i) = i * dx * superelevation_x
+ ENDDO
+ DO j = nys, nyn+1
+ ycoor_dvrp(j) = j * dy * superelevation_y
+ ENDDO
+ zcoor_dvrp = zu(nzb:nz_do3d) * superelevation
+ nx_dvrp = nxr+1 - nxl + 1
+ ny_dvrp = nyn+1 - nys + 1
+ nz_dvrp = nz_do3d - nzb + 1
+ ENDIF
+
+!
+!-- Define the grid used by dvrp
+ CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, &
+ ycoor_dvrp, zcoor_dvrp )
+ CALL DVRP_MATERIAL_RGB( m-1, 1, 0.8, 0.7, 0.6, 0.0 )
+ WRITE ( 9, * ) '*** #4'
+ CALL local_flush( 9 )
+
+!
+!-- Compute and plot isosurface in dvr-format
+ ALLOCATE( local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) )
+ local_pf = 0.0
+ DO i = nxl, nxr+1
+ DO j = nys, nyn+1
+ IF ( nzb_s_inner(j,i) > 0 ) THEN
+ local_pf(i,j,nzb:nzb_s_inner(j,i)) = 1.0
+ ENDIF
+ ENDDO
+ ENDDO
+ WRITE ( 9, * ) '*** #4.1'
+ CALL local_flush( 9 )
+ CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
+ cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
+ WRITE ( 9, * ) '*** #4.2'
+ CALL local_flush( 9 )
+ CALL DVRP_THRESHOLD( m-1, 1.0 )
+ WRITE ( 9, * ) '*** #4.3'
+ CALL local_flush( 9 )
+ CALL DVRP_VISUALIZE( m-1, 1, 0 )
+ WRITE ( 9, * ) '*** #4.4'
+ CALL local_flush( 9 )
+
+ DEALLOCATE( local_pf )
+
+ CALL DVRP_EXIT( m-1 )
+ WRITE ( 9, * ) '*** #5'
+ CALL local_flush( 9 )
+
+!
+!-- Write the surface isosurface on file
+ CALL DVRP_INIT( m-1, 0 )
+
+!
+!-- Create filename for surface
+ IF ( dvrp_output == 'rtsp' ) THEN
+
+ dvrp_file = TRIM( mode_dvrp(m) ) // '/surface.dvr'
+ dvrp_file_c = dvrp_file
+ CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
+ dvrp_password_c, dvrp_directory_c, &
+ dvrp_file_c )
+ WRITE ( 9, * ) '*** #6'
+ CALL local_flush( 9 )
+
+ ELSEIF ( dvrp_output == 'ftp' ) THEN
+
+ dvrp_file = TRIM( mode_dvrp(m) ) // '.surface.dvr'
+ dvrp_file_c = dvrp_file
+! CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
+! dvrp_password_c, dvrp_directory_c, &
+! dvrp_file_c )
+
+ ELSE
+
+ IF ( dvrp_file(1:9) /= '/dev/null' ) THEN
+ dvrp_file_local = TRIM( mode_dvrp(m) ) // '.surface.dvr'
+ dvrp_file_local_c = dvrp_file_local
+ ELSE
+ dvrp_file_local_c = dvrp_file_c
+ ENDIF
+ CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
+
+ ENDIF
+
+!
+!-- Determine local gridpoint coordinates
+ IF ( .NOT. allocated ) THEN
+ ALLOCATE( xcoor_dvrp(nxl:nxr+1), ycoor_dvrp(nys:nyn+1), &
+ zcoor_dvrp(nzb:nz_do3d) )
+ allocated = .TRUE.
+
+ DO i = nxl, nxr+1
+ xcoor_dvrp(i) = i * dx * superelevation_x
+ ENDDO
+ DO j = nys, nyn+1
+ ycoor_dvrp(j) = j * dy * superelevation_y
+ ENDDO
+ zcoor_dvrp = zu(nzb:nz_do3d) * superelevation
+ nx_dvrp = nxr+1 - nxl + 1
+ ny_dvrp = nyn+1 - nys + 1
+ nz_dvrp = nz_do3d - nzb + 1
+ ENDIF
+
+!
+!-- Define the grid used by dvrp
+ CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, &
+ ycoor_dvrp, zcoor_dvrp )
+ CALL DVRP_MATERIAL_RGB( m-1, 1, 0.0, 0.6, 0.0, 0.0 )
+ WRITE ( 9, * ) '*** #7'
+ CALL local_flush( 9 )
+
+!
+!-- Compute and plot isosurface in dvr-format
+ ALLOCATE( local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) )
+ local_pf = 0.0
+ local_pf(:,:,0) = 1.0
+
+ CALL DVRP_DATA( m-1, local_pf, 1, nx_dvrp, ny_dvrp, nz_dvrp, &
+ cyclic_dvrp, cyclic_dvrp, cyclic_dvrp )
+ CALL DVRP_THRESHOLD( m-1, 1.0 )
+ CALL DVRP_VISUALIZE( m-1, 1, 0 )
+
+ DEALLOCATE( local_pf )
+
+ CALL DVRP_EXIT( m-1 )
+ WRITE ( 9, * ) '*** #8'
+ CALL local_flush( 9 )
+
+
+! ENDIF
+
+
+!
+!-- Initialize dvrp for all dvrp-calls during the run
+ CALL DVRP_INIT( m-1, 0 )
+
+!
+!-- Preliminary definition of filename for dvrp-output
+ IF ( dvrp_output == 'rtsp' ) THEN
+
+!
+!-- First initialize parameters for possible interactive steering.
+!-- Every parameter has to be passed to the respective stream.
+ pn = 1
+!
+!-- Initialize threshold counter needed for initialization of the
+!-- isosurface steering variables
+ tv = 0
+
+ DO WHILE ( mode_dvrp(pn) /= ' ' )
+
+ IF ( mode_dvrp(pn)(1:10) == 'isosurface' ) THEN
+
+ READ ( mode_dvrp(pn), '(10X,I2)' ) vn
+ steering_dvrp(pn)%name = do3d(0,vn)
+ tv = tv + 1
+
+ IF ( do3d(0,vn)(1:1) == 'w' ) THEN
+ steering_dvrp(pn)%min = -4.0
+ steering_dvrp(pn)%max = 5.0
+ ELSE
+ steering_dvrp(pn)%min = 288.0
+ steering_dvrp(pn)%max = 292.0
+ ENDIF
+
+ name_c = TRIM( do3d(0,vn) )
+ WRITE ( 9, * ) '*** #9'
+ CALL local_flush( 9 )
+ CALL DVRP_STEERING_INIT( m-1, name_c, steering_dvrp(pn)%min, &
+ steering_dvrp(pn)%max, threshold(tv) )
+ WRITE ( 9, * ) '*** #10'
+ CALL local_flush( 9 )
+
+ ELSEIF ( mode_dvrp(pn)(1:6) == 'slicer' ) THEN
+
+ READ ( mode_dvrp(pn), '(6X,I2)' ) vn
+ steering_dvrp(pn)%name = do2d(0,vn)
+ name_c = TRIM( do2d(0,vn) )
+
+ l = MAX( 2, LEN_TRIM( do2d(0,vn) ) )
+ section_chr = do2d(0,vn)(l-1:l)
+ SELECT CASE ( section_chr )
+ CASE ( 'xy' )
+ steering_dvrp(pn)%imin = 0
+ steering_dvrp(pn)%imax = nz_do3d
+ slicer_position_dvrp(pn) = section(1,1)
+ CALL DVRP_STEERING_INIT( m-1, name_c, &
+ steering_dvrp(pn)%imin, &
+ steering_dvrp(pn)%imax, &
+ slicer_position_dvrp(pn) )
+ CASE ( 'xz' )
+ steering_dvrp(pn)%imin = 0
+ steering_dvrp(pn)%imax = ny
+ slicer_position_dvrp(pn) = section(1,2)
+ CALL DVRP_STEERING_INIT( m-1, name_c, &
+ steering_dvrp(pn)%imin, &
+ steering_dvrp(pn)%imax, &
+ slicer_position_dvrp(pn) )
+ CASE ( 'yz' )
+ steering_dvrp(pn)%imin = 0
+ steering_dvrp(pn)%imax = nx
+ slicer_position_dvrp(pn) = section(1,3)
+ CALL DVRP_STEERING_INIT( m-1, name_c, &
+ steering_dvrp(pn)%imin, &
+ steering_dvrp(pn)%imax, &
+ slicer_position_dvrp(pn) )
+ END SELECT
+
+ ENDIF
+
+ pn = pn + 1
+
+ ENDDO
+
+ WRITE ( 9, * ) '*** #11'
+ CALL local_flush( 9 )
+
+ dvrp_file = TRIM( mode_dvrp(m) ) // '/*****.dvr'
+ dvrp_file_c = dvrp_file
+ CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host_c, dvrp_username_c, &
+ dvrp_password_c, dvrp_directory_c, &
+ dvrp_file_c )
+ WRITE ( 9, * ) '*** #12'
+ CALL local_flush( 9 )
+
+ ELSEIF ( dvrp_output == 'ftp' ) THEN
+
+ dvrp_file = TRIM( mode_dvrp(m) ) // '.%05d.dvr'
+ dvrp_file_c = dvrp_file
+! CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host_c, dvrp_username_c, &
+! dvrp_password_c, dvrp_directory_c, dvrp_file_c )
+
+ ELSE
+
+ IF ( dvrp_file(1:9) /= '/dev/null' ) THEN
+ dvrp_file_local = TRIM( mode_dvrp(m) ) // '_%05d.dvr'
+ dvrp_file_local_c = dvrp_file_local
+ ELSE
+ dvrp_file_local_c = dvrp_file_c
+ ENDIF
+ CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file_local_c )
+
+ ENDIF
+
+! dvrp_file = TRIM( mode_dvrp(m) ) // '.%05d.dvr' // CHAR( 0 )
+! dvrp_file = TRIM( mode_dvrp(m) ) // '/*****.dvr' // CHAR( 0 )
+! dvrp_file = '/dev/null' // CHAR( 0 )
+! CALL DVRP_OUTPUT_FTP( m-1, 0, dvrp_host, dvrp_username, dvrp_password, &
+! dvrp_directory, dvrp_file )
+! CALL DVRP_OUTPUT_RTSP( m-1, dvrp_host, dvrp_username, dvrp_password, &
+! dvrp_directory, dvrp_file )
+! CALL DVRP_OUTPUT_LOCAL( m-1, 0, dvrp_file )
+
+!
+!-- Determine local gridpoint coordinates
+ IF ( .NOT. allocated ) THEN
+ ALLOCATE( xcoor_dvrp(nxl:nxr+1), ycoor_dvrp(nys:nyn+1), &
+ zcoor_dvrp(nzb:nz_do3d) )
+ allocated = .TRUE.
+
+ DO i = nxl, nxr+1
+ xcoor_dvrp(i) = i * dx * superelevation_x
+ ENDDO
+ DO j = nys, nyn+1
+ ycoor_dvrp(j) = j * dy * superelevation_y
+ ENDDO
+ zcoor_dvrp = zu(nzb:nz_do3d) * superelevation
+ nx_dvrp = nxr+1 - nxl + 1
+ ny_dvrp = nyn+1 - nys + 1
+ nz_dvrp = nz_do3d - nzb + 1
+ ENDIF
+
+!
+!-- Define the grid used by dvrp
+ WRITE ( 9, * ) '*** #13'
+ CALL local_flush( 9 )
+
+ CALL DVRP_GRID( m-1, nx_dvrp, ny_dvrp, nz_dvrp, xcoor_dvrp, ycoor_dvrp, &
+ zcoor_dvrp )
+ WRITE ( 9, * ) '*** #14'
+ CALL local_flush( 9 )
+
+
+ m = m + 1
+
+ ENDDO
+
+#endif
+ END SUBROUTINE init_dvrp
+
+
+ SUBROUTINE init_dvrp_logging
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Initializes logging events for time measurement with dvrp software
+! and splits one PE from the global communicator in case that dvrp output
+! shall be done by one single PE.
+!------------------------------------------------------------------------------!
+#if defined( __dvrp_graphics )
+
+ USE dvrp_variables
+ USE pegrid
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=4) :: chr
+ INTEGER :: idummy
+
+!
+!-- Initialize logging of calls by DVRP graphic software
+ WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_LOG_INIT'
+ CALL local_flush( 9 )
+ CALL DVRP_LOG_INIT( 'DVRP_LOG' // CHAR( 0 ), 0 )
+ WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_LOG_INIT'
+ CALL local_flush( 9 )
+
+!
+!-- User-defined logging events: #1 (total time needed by PALM)
+ WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_LOG_SYMBOL'
+ CALL local_flush( 9 )
+ CALL DVRP_LOG_SYMBOL( 1, 'PALM_total' // CHAR( 0 ) )
+ WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_LOG_SYMBOL'
+ CALL local_flush( 9 )
+ CALL DVRP_LOG_SYMBOL( 2, 'PALM_timestep' // CHAR( 0 ) )
+ WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_LOG_EVENT'
+ CALL local_flush( 9 )
+ CALL DVRP_LOG_EVENT( 1, 1 )
+ WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_LOG_EVENT'
+ CALL local_flush( 9 )
+
+#if defined( __parallel )
+!
+!-- Find out, if dvrp output shall be done by a dedicated PE
+ CALL local_getenv( 'use_seperate_pe_for_dvrp_output', 31, chr, idummy )
+ IF ( chr == 'true' ) THEN
+ use_seperate_pe_for_dvrp_output = .TRUE.
+ WRITE ( 9, * ) '*** myid=', myid, ' vor DVRP_SPLIT'
+ CALL local_flush( 9 )
+ CALL DVRP_SPLIT( MPI_COMM_WORLD, comm_palm )
+ WRITE ( 9, * ) '*** myid=', myid, ' nach DVRP_SPLIT'
+ CALL local_flush( 9 )
+ CALL MPI_COMM_SIZE( comm_palm, numprocs, ierr )
+ ENDIF
+#endif
+
+#endif
+ END SUBROUTINE init_dvrp_logging
+
+
+ SUBROUTINE close_dvrp
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Exit of dvrp software and finish dvrp logging
+!------------------------------------------------------------------------------!
+#if defined( __dvrp_graphics )
+
+ USE control_parameters
+ USE dvrp
+ USE dvrp_variables
+
+ INTEGER :: m
+
+!
+!-- If required, close dvrp-software and logging of dvrp-calls
+ IF ( dt_dvrp /= 9999999.9 ) THEN
+ m = 1
+ DO WHILE ( mode_dvrp(m) /= ' ' )
+ CALL DVRP_EXIT( m-1 )
+ m = m + 1
+ ENDDO
+ CALL DVRP_LOG_EVENT( -1, 1 ) ! Logging of total cpu-time used by PALM
+ IF ( use_seperate_pe_for_dvrp_output ) THEN
+ CALL DVRP_SPLIT_EXIT( 1 ) ! Argument 0: reduced output
+ ELSE
+ CALL DVRP_LOG_EXIT( 1 ) ! Argument 0: reduced output
+ ENDIF
+ ENDIF
+
+#endif
+ END SUBROUTINE close_dvrp
Index: /palm/tags/release-3.4a/SOURCE/init_grid.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/init_grid.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/init_grid.f90 (revision 141)
@@ -0,0 +1,1033 @@
+ SUBROUTINE init_grid
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 134 2007-11-21 07:28:38Z letzel
+! Redefine initial nzb_local as the actual total size of topography (later the
+! extent of topography in nzb_local is reduced by 1dx at the E topography walls
+! and by 1dy at the N topography walls to form the basis for nzb_s_inner);
+! for consistency redefine 'single_building' case.
+! Calculation of wall flag arrays
+!
+! 94 2007-06-01 15:25:22Z raasch
+! Grid definition for ocean version
+!
+! 75 2007-03-22 09:54:05Z raasch
+! storage of topography height arrays zu_s_inner and zw_s_inner,
+! 2nd+3rd argument removed from exchange horiz
+!
+! 19 2007-02-23 04:53:48Z raasch
+! Setting of nzt_diff
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.17 2006/08/22 14:00:05 raasch
+! +dz_max to limit vertical stretching,
+! bugfix in index array initialization for line- or point-like topography
+! structures
+!
+! Revision 1.1 1997/08/11 06:17:45 raasch
+! Initial revision (Testversion)
+!
+!
+! Description:
+! ------------
+! Creating grid depending constants
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: bh, blx, bly, bxl, bxr, byn, bys, gls, i, inc, i_center, j, &
+ j_center, k, l, nxl_l, nxr_l, nyn_l, nys_l, nzb_si, nzt_l, vi
+
+ INTEGER, DIMENSION(:), ALLOCATABLE :: vertical_influence
+
+ INTEGER, DIMENSION(:,:), ALLOCATABLE :: corner_nl, corner_nr, corner_sl, &
+ corner_sr, wall_l, wall_n, wall_r,&
+ wall_s, nzb_local, nzb_tmp
+
+ REAL :: dx_l, dy_l, dz_stretched
+
+ REAL, DIMENSION(0:ny,0:nx) :: topo_height
+
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: distance
+
+!
+!-- Allocate grid arrays
+ ALLOCATE( ddzu(1:nzt+1), ddzw(1:nzt+1), dd2zu(1:nzt), dzu(1:nzt+1), &
+ dzw(1:nzt+1), l_grid(1:nzt), zu(0:nzt+1), zw(0:nzt+1) )
+
+!
+!-- Compute height of u-levels from constant grid length and dz stretch factors
+ IF ( dz == -1.0 ) THEN
+ IF ( myid == 0 ) PRINT*,'+++ init_grid: missing dz'
+ CALL local_stop
+ ELSEIF ( dz <= 0.0 ) THEN
+ IF ( myid == 0 ) PRINT*,'+++ init_grid: dz=',dz,' <= 0.0'
+ CALL local_stop
+ ENDIF
+
+!
+!-- Define the vertical grid levels
+ IF ( .NOT. ocean ) THEN
+!
+!-- Grid for atmosphere with surface at z=0 (k=0, w-grid).
+!-- Since the w-level lies on the surface, the first u-level (staggered!)
+!-- lies below the surface (used for "mirror" boundary condition).
+!-- The first u-level above the surface corresponds to the top of the
+!-- Prandtl-layer.
+ zu(0) = - dz * 0.5
+ zu(1) = dz * 0.5
+
+ dz_stretch_level_index = nzt+1
+ dz_stretched = dz
+ DO k = 2, nzt+1
+ IF ( dz_stretch_level <= zu(k-1) .AND. dz_stretched < dz_max ) THEN
+ dz_stretched = dz_stretched * dz_stretch_factor
+ dz_stretched = MIN( dz_stretched, dz_max )
+ IF ( dz_stretch_level_index == nzt+1 ) dz_stretch_level_index = k-1
+ ENDIF
+ zu(k) = zu(k-1) + dz_stretched
+ ENDDO
+
+!
+!-- Compute the w-levels. They are always staggered half-way between the
+!-- corresponding u-levels. The top w-level is extrapolated linearly.
+ zw(0) = 0.0
+ DO k = 1, nzt
+ zw(k) = ( zu(k) + zu(k+1) ) * 0.5
+ ENDDO
+ zw(nzt+1) = zw(nzt) + 2.0 * ( zu(nzt+1) - zw(nzt) )
+
+ ELSE
+!
+!-- Grid for ocean with solid surface at z=0 (k=0, w-grid). The free water
+!-- surface is at k=nzt (w-grid).
+!-- Since the w-level lies always on the surface, the first/last u-level
+!-- (staggered!) lies below the bottom surface / above the free surface.
+!-- It is used for "mirror" boundary condition.
+!-- The first u-level above the bottom surface corresponds to the top of the
+!-- Prandtl-layer.
+ zu(nzt+1) = dz * 0.5
+ zu(nzt) = - dz * 0.5
+
+ dz_stretch_level_index = 0
+ dz_stretched = dz
+ DO k = nzt-1, 0, -1
+ IF ( dz_stretch_level <= ABS( zu(k+1) ) .AND. &
+ dz_stretched < dz_max ) THEN
+ dz_stretched = dz_stretched * dz_stretch_factor
+ dz_stretched = MIN( dz_stretched, dz_max )
+ IF ( dz_stretch_level_index == 0 ) dz_stretch_level_index = k+1
+ ENDIF
+ zu(k) = zu(k+1) - dz_stretched
+ ENDDO
+
+!
+!-- Compute the w-levels. They are always staggered half-way between the
+!-- corresponding u-levels.
+!-- The top w-level (nzt+1) is not used but set for consistency, since
+!-- w and all scalar variables are defined up tp nzt+1.
+ zw(nzt+1) = dz
+ zw(nzt) = 0.0
+ DO k = 0, nzt
+ zw(k) = ( zu(k) + zu(k+1) ) * 0.5
+ ENDDO
+
+ ENDIF
+
+!
+!-- Compute grid lengths.
+ DO k = 1, nzt+1
+ dzu(k) = zu(k) - zu(k-1)
+ ddzu(k) = 1.0 / dzu(k)
+ dzw(k) = zw(k) - zw(k-1)
+ ddzw(k) = 1.0 / dzw(k)
+ ENDDO
+
+ DO k = 1, nzt
+ dd2zu(k) = 1.0 / ( dzu(k) + dzu(k+1) )
+ ENDDO
+
+!
+!-- In case of multigrid method, compute grid lengths and grid factors for the
+!-- grid levels
+ IF ( psolver == 'multigrid' ) THEN
+
+ ALLOCATE( ddx2_mg(maximum_grid_level), ddy2_mg(maximum_grid_level), &
+ dzu_mg(nzb+1:nzt+1,maximum_grid_level), &
+ dzw_mg(nzb+1:nzt+1,maximum_grid_level), &
+ f1_mg(nzb+1:nzt,maximum_grid_level), &
+ f2_mg(nzb+1:nzt,maximum_grid_level), &
+ f3_mg(nzb+1:nzt,maximum_grid_level) )
+
+ dzu_mg(:,maximum_grid_level) = dzu
+ dzw_mg(:,maximum_grid_level) = dzw
+ nzt_l = nzt
+ DO l = maximum_grid_level-1, 1, -1
+ dzu_mg(nzb+1,l) = 2.0 * dzu_mg(nzb+1,l+1)
+ dzw_mg(nzb+1,l) = 2.0 * dzw_mg(nzb+1,l+1)
+ nzt_l = nzt_l / 2
+ DO k = 2, nzt_l+1
+ dzu_mg(k,l) = dzu_mg(2*k-2,l+1) + dzu_mg(2*k-1,l+1)
+ dzw_mg(k,l) = dzw_mg(2*k-2,l+1) + dzw_mg(2*k-1,l+1)
+ ENDDO
+ ENDDO
+
+ nzt_l = nzt
+ dx_l = dx
+ dy_l = dy
+ DO l = maximum_grid_level, 1, -1
+ ddx2_mg(l) = 1.0 / dx_l**2
+ ddy2_mg(l) = 1.0 / dy_l**2
+ DO k = nzb+1, nzt_l
+ f2_mg(k,l) = 1.0 / ( dzu_mg(k+1,l) * dzw_mg(k,l) )
+ f3_mg(k,l) = 1.0 / ( dzu_mg(k,l) * dzw_mg(k,l) )
+ f1_mg(k,l) = 2.0 * ( ddx2_mg(l) + ddy2_mg(l) ) + &
+ f2_mg(k,l) + f3_mg(k,l)
+ ENDDO
+ nzt_l = nzt_l / 2
+ dx_l = dx_l * 2.0
+ dy_l = dy_l * 2.0
+ ENDDO
+
+ ENDIF
+
+!
+!-- Compute the reciprocal values of the horizontal grid lengths.
+ ddx = 1.0 / dx
+ ddy = 1.0 / dy
+ dx2 = dx * dx
+ dy2 = dy * dy
+ ddx2 = 1.0 / dx2
+ ddy2 = 1.0 / dy2
+
+!
+!-- Compute the grid-dependent mixing length.
+ DO k = 1, nzt
+ l_grid(k) = ( dx * dy * dzw(k) )**0.33333333333333
+ ENDDO
+
+!
+!-- Allocate outer and inner index arrays for topography and set
+!-- defaults.
+!-- nzb_local has to contain additional layers of ghost points for calculating
+!-- the flag arrays needed for the multigrid method
+ gls = 2**( maximum_grid_level )
+ ALLOCATE( corner_nl(nys:nyn,nxl:nxr), corner_nr(nys:nyn,nxl:nxr), &
+ corner_sl(nys:nyn,nxl:nxr), corner_sr(nys:nyn,nxl:nxr), &
+ nzb_local(-gls:ny+gls,-gls:nx+gls), nzb_tmp(-1:ny+1,-1:nx+1), &
+ wall_l(nys:nyn,nxl:nxr), wall_n(nys:nyn,nxl:nxr), &
+ wall_r(nys:nyn,nxl:nxr), wall_s(nys:nyn,nxl:nxr) )
+ ALLOCATE( fwxm(nys-1:nyn+1,nxl-1:nxr+1), fwxp(nys-1:nyn+1,nxl-1:nxr+1), &
+ fwym(nys-1:nyn+1,nxl-1:nxr+1), fwyp(nys-1:nyn+1,nxl-1:nxr+1), &
+ fxm(nys-1:nyn+1,nxl-1:nxr+1), fxp(nys-1:nyn+1,nxl-1:nxr+1), &
+ fym(nys-1:nyn+1,nxl-1:nxr+1), fyp(nys-1:nyn+1,nxl-1:nxr+1), &
+ nzb_s_inner(nys-1:nyn+1,nxl-1:nxr+1), &
+ nzb_s_outer(nys-1:nyn+1,nxl-1:nxr+1), &
+ nzb_u_inner(nys-1:nyn+1,nxl-1:nxr+1), &
+ nzb_u_outer(nys-1:nyn+1,nxl-1:nxr+1), &
+ nzb_v_inner(nys-1:nyn+1,nxl-1:nxr+1), &
+ nzb_v_outer(nys-1:nyn+1,nxl-1:nxr+1), &
+ nzb_w_inner(nys-1:nyn+1,nxl-1:nxr+1), &
+ nzb_w_outer(nys-1:nyn+1,nxl-1:nxr+1), &
+ nzb_diff_s_inner(nys-1:nyn+1,nxl-1:nxr+1), &
+ nzb_diff_s_outer(nys-1:nyn+1,nxl-1:nxr+1), &
+ nzb_diff_u(nys-1:nyn+1,nxl-1:nxr+1), &
+ nzb_diff_v(nys-1:nyn+1,nxl-1:nxr+1), &
+ nzb_2d(nys-1:nyn+1,nxl-1:nxr+1), &
+ wall_e_x(nys-1:nyn+1,nxl-1:nxr+1), &
+ wall_e_y(nys-1:nyn+1,nxl-1:nxr+1), &
+ wall_u(nys-1:nyn+1,nxl-1:nxr+1), &
+ wall_v(nys-1:nyn+1,nxl-1:nxr+1), &
+ wall_w_x(nys-1:nyn+1,nxl-1:nxr+1), &
+ wall_w_y(nys-1:nyn+1,nxl-1:nxr+1) )
+
+ ALLOCATE( l_wall(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+
+ nzb_s_inner = nzb; nzb_s_outer = nzb
+ nzb_u_inner = nzb; nzb_u_outer = nzb
+ nzb_v_inner = nzb; nzb_v_outer = nzb
+ nzb_w_inner = nzb; nzb_w_outer = nzb
+
+!
+!-- Define vertical gridpoint from (or to) which on the usual finite difference
+!-- form (which does not use surface fluxes) is applied
+ IF ( prandtl_layer .OR. use_surface_fluxes ) THEN
+ nzb_diff = nzb + 2
+ ELSE
+ nzb_diff = nzb + 1
+ ENDIF
+ IF ( use_top_fluxes ) THEN
+ nzt_diff = nzt - 1
+ ELSE
+ nzt_diff = nzt
+ ENDIF
+
+ nzb_diff_s_inner = nzb_diff; nzb_diff_s_outer = nzb_diff
+ nzb_diff_u = nzb_diff; nzb_diff_v = nzb_diff
+
+ wall_e_x = 0.0; wall_e_y = 0.0; wall_u = 0.0; wall_v = 0.0
+ wall_w_x = 0.0; wall_w_y = 0.0
+ fwxp = 1.0; fwxm = 1.0; fwyp = 1.0; fwym = 1.0
+ fxp = 1.0; fxm = 1.0; fyp = 1.0; fym = 1.0
+
+!
+!-- Initialize near-wall mixing length l_wall only in the vertical direction
+!-- for the moment,
+!-- multiplication with wall_adjustment_factor near the end of this routine
+ l_wall(nzb,:,:) = l_grid(1)
+ DO k = nzb+1, nzt
+ l_wall(k,:,:) = l_grid(k)
+ ENDDO
+ l_wall(nzt+1,:,:) = l_grid(nzt)
+
+ ALLOCATE ( vertical_influence(nzb:nzt) )
+ DO k = 1, nzt
+ vertical_influence(k) = MIN ( INT( l_grid(k) / &
+ ( wall_adjustment_factor * dzw(k) ) + 0.5 ), nzt - k )
+ ENDDO
+
+ DO k = 1, MAXVAL( nzb_s_inner )
+ IF ( l_grid(k) > 1.5 * dx * wall_adjustment_factor .OR. &
+ l_grid(k) > 1.5 * dy * wall_adjustment_factor ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ WARNING: grid anisotropy exceeds '// &
+ 'threshold given by only local'
+ PRINT*, ' horizontal reduction of near_wall '// &
+ 'mixing length l_wall'
+ PRINT*, ' starting from height level k = ', k, '.'
+ ENDIF
+ EXIT
+ ENDIF
+ ENDDO
+ vertical_influence(0) = vertical_influence(1)
+
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb_s_inner(j,i) + 1, &
+ nzb_s_inner(j,i) + vertical_influence(nzb_s_inner(j,i))
+ l_wall(k,j,i) = zu(k) - zw(nzb_s_inner(j,i))
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Set outer and inner index arrays for non-flat topography.
+!-- Here consistency checks concerning domain size and periodicity are
+!-- necessary.
+!-- Within this SELECT CASE structure only nzb_local is initialized
+!-- individually depending on the chosen topography type, all other index
+!-- arrays are initialized further below.
+ SELECT CASE ( TRIM( topography ) )
+
+ CASE ( 'flat' )
+!
+!-- No actions necessary
+
+ CASE ( 'single_building' )
+!
+!-- Single rectangular building, by default centered in the middle of the
+!-- total domain
+ blx = NINT( building_length_x / dx )
+ bly = NINT( building_length_y / dy )
+ bh = NINT( building_height / dz )
+
+ IF ( building_wall_left == 9999999.9 ) THEN
+ building_wall_left = ( nx + 1 - blx ) / 2 * dx
+ ENDIF
+ bxl = NINT( building_wall_left / dx )
+ bxr = bxl + blx
+
+ IF ( building_wall_south == 9999999.9 ) THEN
+ building_wall_south = ( ny + 1 - bly ) / 2 * dy
+ ENDIF
+ bys = NINT( building_wall_south / dy )
+ byn = bys + bly
+
+!
+!-- Building size has to meet some requirements
+ IF ( ( bxl < 1 ) .OR. ( bxr > nx-1 ) .OR. ( bxr < bxl+3 ) .OR. &
+ ( bys < 1 ) .OR. ( byn > ny-1 ) .OR. ( byn < bys+3 ) ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ init_grid: inconsistent building parameters:'
+ PRINT*, ' bxl=', bxl, 'bxr=', bxr, 'bys=', bys, &
+ 'byn=', byn, 'nx=', nx, 'ny=', ny
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Set the actual total size of the building. Due to the staggered grid,
+!-- the building will be displaced by -0.5dx in x-direction and by -0.5dy
+!-- in y-direction compared to the scalar grid.
+ nzb_local = 0
+ nzb_local(bys:byn,bxl:bxr) = bh
+
+ CASE ( 'read_from_file' )
+!
+!-- Arbitrary irregular topography data in PALM format (exactly matching
+!-- the grid size and total domain size)
+ OPEN( 90, FILE='TOPOGRAPHY_DATA', STATUS='OLD', FORM='FORMATTED', &
+ ERR=10 )
+ DO j = ny, 0, -1
+ READ( 90, *, ERR=11, END=11 ) ( topo_height(j,i), i = 0, nx )
+ ENDDO
+!
+!-- Calculate the index height of the topography
+ DO i = 0, nx
+ DO j = 0, ny
+ nzb_local(j,i) = NINT( topo_height(j,i) / dz )
+ ENDDO
+ ENDDO
+!
+!-- Add cyclic boundaries (additional layers are for calculating flag
+!-- arrays needed for the multigrid sover)
+ nzb_local(-gls:-1,0:nx) = nzb_local(ny-gls+1:ny,0:nx)
+ nzb_local(ny+1:ny+gls,0:nx) = nzb_local(0:gls-1,0:nx)
+ nzb_local(:,-gls:-1) = nzb_local(:,nx-gls+1:nx)
+ nzb_local(:,nx+1:nx+gls) = nzb_local(:,0:gls-1)
+
+ GOTO 12
+
+ 10 IF ( myid == 0 ) THEN
+ PRINT*, '+++ init_grid: file TOPOGRAPHY_DATA does not exist'
+ ENDIF
+ CALL local_stop
+
+ 11 IF ( myid == 0 ) THEN
+ PRINT*, '+++ init_grid: errors in file TOPOGRAPHY_DATA'
+ ENDIF
+ CALL local_stop
+
+ 12 CLOSE( 90 )
+
+ CASE DEFAULT
+!
+!-- The DEFAULT case is reached either if the parameter topography
+!-- contains a wrong character string or if the user has coded a special
+!-- case in the user interface. There, the subroutine user_init_grid
+!-- checks which of these two conditions applies.
+ CALL user_init_grid( gls, nzb_local )
+
+ END SELECT
+
+!
+!-- Test output of nzb_local -1:ny+1,-1:nx+1
+ WRITE (9,*) '*** nzb_local ***'
+ DO j = ny+1, -1, -1
+ WRITE (9,'(194(1X,I2))') ( nzb_local(j,i), i = -1, nx+1 )
+ ENDDO
+
+!
+!-- Consistency checks and index array initialization are only required for
+!-- non-flat topography, also the initialization of topography heigth arrays
+!-- zu_s_inner and zw_w_inner
+ IF ( TRIM( topography ) /= 'flat' ) THEN
+
+!
+!-- Consistency checks
+ IF ( MINVAL( nzb_local ) < 0 .OR. MAXVAL( nzb_local ) > nz + 1 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ init_grid: nzb_local values are outside the', &
+ 'model domain'
+ PRINT*, ' MINVAL( nzb_local ) = ', MINVAL(nzb_local)
+ PRINT*, ' MAXVAL( nzb_local ) = ', MAXVAL(nzb_local)
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ IF ( bc_lr == 'cyclic' ) THEN
+ IF ( ANY( nzb_local(:,-1) /= nzb_local(:,nx) ) .OR. &
+ ANY( nzb_local(:,0) /= nzb_local(:,nx+1) ) ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ init_grid: nzb_local does not fulfill cyclic', &
+ ' boundary condition in x-direction'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+ IF ( bc_ns == 'cyclic' ) THEN
+ IF ( ANY( nzb_local(-1,:) /= nzb_local(ny,:) ) .OR. &
+ ANY( nzb_local(0,:) /= nzb_local(ny+1,:) ) ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ init_grid: nzb_local does not fulfill cyclic', &
+ ' boundary condition in y-direction'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+
+!
+!-- The array nzb_local as defined above describes the actual total size of
+!-- topography which is defined by u=0 on the topography walls in x-direction
+!-- and by v=0 on the topography walls in y-direction. However, PALM uses
+!-- individual arrays nzb_u|v|w|s_inner|outer that are based on nzb_s_inner.
+!-- Therefore, the extent of topography in nzb_local is now reduced by 1dx
+!-- at the E topography walls and by 1dy at the N topography walls to form
+!-- the basis for nzb_s_inner.
+ DO j = -gls, ny + gls
+ DO i = -gls, nx
+ nzb_local(j,i) = MIN( nzb_local(j,i), nzb_local(j,i+1) )
+ ENDDO
+ ENDDO
+!-- apply cyclic boundary conditions in x-direction
+ nzb_local(:,nx+1:nx+gls) = nzb_local(:,0:gls-1)
+ DO i = -gls, nx + gls
+ DO j = -gls, ny
+ nzb_local(j,i) = MIN( nzb_local(j,i), nzb_local(j+1,i) )
+ ENDDO
+ ENDDO
+!-- apply cyclic boundary conditions in y-direction
+ nzb_local(ny+1:ny+gls,:) = nzb_local(0:gls-1,:)
+
+!
+!-- Initialize index arrays nzb_s_inner and nzb_w_inner
+ nzb_s_inner = nzb_local(nys-1:nyn+1,nxl-1:nxr+1)
+ nzb_w_inner = nzb_local(nys-1:nyn+1,nxl-1:nxr+1)
+
+!
+!-- Initialize remaining index arrays:
+!-- first pre-initialize them with nzb_s_inner...
+ nzb_u_inner = nzb_s_inner
+ nzb_u_outer = nzb_s_inner
+ nzb_v_inner = nzb_s_inner
+ nzb_v_outer = nzb_s_inner
+ nzb_w_outer = nzb_s_inner
+ nzb_s_outer = nzb_s_inner
+
+!
+!-- ...then extend pre-initialized arrays in their according directions
+!-- based on nzb_local using nzb_tmp as a temporary global index array
+
+!
+!-- nzb_s_outer:
+!-- extend nzb_local east-/westwards first, then north-/southwards
+ nzb_tmp = nzb_local(-1:ny+1,-1:nx+1)
+ DO j = -1, ny + 1
+ DO i = 0, nx
+ nzb_tmp(j,i) = MAX( nzb_local(j,i-1), nzb_local(j,i), &
+ nzb_local(j,i+1) )
+ ENDDO
+ ENDDO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ nzb_s_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i), &
+ nzb_tmp(j+1,i) )
+ ENDDO
+!
+!-- non-cyclic boundary conditions (overwritten by call of
+!-- exchange_horiz_2d_int below in case of cyclic boundary conditions)
+ IF ( nys == 0 ) THEN
+ j = -1
+ nzb_s_outer(j,i) = MAX( nzb_tmp(j+1,i), nzb_tmp(j,i) )
+ ENDIF
+ IF ( nys == ny ) THEN
+ j = ny + 1
+ nzb_s_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i) )
+ ENDIF
+ ENDDO
+!
+!-- nzb_w_outer:
+!-- identical to nzb_s_outer
+ nzb_w_outer = nzb_s_outer
+
+!
+!-- nzb_u_inner:
+!-- extend nzb_local rightwards only
+ nzb_tmp = nzb_local(-1:ny+1,-1:nx+1)
+ DO j = -1, ny + 1
+ DO i = 0, nx + 1
+ nzb_tmp(j,i) = MAX( nzb_local(j,i-1), nzb_local(j,i) )
+ ENDDO
+ ENDDO
+ nzb_u_inner = nzb_tmp(nys-1:nyn+1,nxl-1:nxr+1)
+
+!
+!-- nzb_u_outer:
+!-- extend current nzb_tmp (nzb_u_inner) north-/southwards
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ nzb_u_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i), &
+ nzb_tmp(j+1,i) )
+ ENDDO
+!
+!-- non-cyclic boundary conditions (overwritten by call of
+!-- exchange_horiz_2d_int below in case of cyclic boundary conditions)
+ IF ( nys == 0 ) THEN
+ j = -1
+ nzb_u_outer(j,i) = MAX( nzb_tmp(j+1,i), nzb_tmp(j,i) )
+ ENDIF
+ IF ( nys == ny ) THEN
+ j = ny + 1
+ nzb_u_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i) )
+ ENDIF
+ ENDDO
+
+!
+!-- nzb_v_inner:
+!-- extend nzb_local northwards only
+ nzb_tmp = nzb_local(-1:ny+1,-1:nx+1)
+ DO i = -1, nx + 1
+ DO j = 0, ny + 1
+ nzb_tmp(j,i) = MAX( nzb_local(j-1,i), nzb_local(j,i) )
+ ENDDO
+ ENDDO
+ nzb_v_inner = nzb_tmp(nys-1:nyn+1,nxl-1:nxr+1)
+
+!
+!-- nzb_v_outer:
+!-- extend current nzb_tmp (nzb_v_inner) right-/leftwards
+ DO j = nys, nyn
+ DO i = nxl, nxr
+ nzb_v_outer(j,i) = MAX( nzb_tmp(j,i-1), nzb_tmp(j,i), &
+ nzb_tmp(j,i+1) )
+ ENDDO
+!
+!-- non-cyclic boundary conditions (overwritten by call of
+!-- exchange_horiz_2d_int below in case of cyclic boundary conditions)
+ IF ( nxl == 0 ) THEN
+ i = -1
+ nzb_v_outer(j,i) = MAX( nzb_tmp(j,i+1), nzb_tmp(j,i) )
+ ENDIF
+ IF ( nxr == nx ) THEN
+ i = nx + 1
+ nzb_v_outer(j,i) = MAX( nzb_tmp(j,i-1), nzb_tmp(j,i) )
+ ENDIF
+ ENDDO
+
+!
+!-- Exchange of lateral boundary values (parallel computers) and cyclic
+!-- boundary conditions, if applicable.
+!-- Since nzb_s_inner and nzb_w_inner are derived directly from nzb_local
+!-- they do not require exchange and are not included here.
+ CALL exchange_horiz_2d_int( nzb_u_inner )
+ CALL exchange_horiz_2d_int( nzb_u_outer )
+ CALL exchange_horiz_2d_int( nzb_v_inner )
+ CALL exchange_horiz_2d_int( nzb_v_outer )
+ CALL exchange_horiz_2d_int( nzb_w_outer )
+ CALL exchange_horiz_2d_int( nzb_s_outer )
+
+!
+!-- Allocate and set the arrays containing the topography height
+ IF ( myid == 0 ) THEN
+
+ ALLOCATE( zu_s_inner(0:nx+1,0:ny+1), zw_w_inner(0:nx+1,0:ny+1) )
+
+ DO i = 0, nx + 1
+ DO j = 0, ny + 1
+ zu_s_inner(i,j) = zu(nzb_local(j,i))
+ zw_w_inner(i,j) = zw(nzb_local(j,i))
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+ ENDIF
+
+!
+!-- Preliminary: to be removed after completion of the topography code!
+!-- Set the former default k index arrays nzb_2d
+ nzb_2d = nzb
+
+!
+!-- Set the individual index arrays which define the k index from which on
+!-- the usual finite difference form (which does not use surface fluxes) is
+!-- applied
+ IF ( prandtl_layer .OR. use_surface_fluxes ) THEN
+ nzb_diff_u = nzb_u_inner + 2
+ nzb_diff_v = nzb_v_inner + 2
+ nzb_diff_s_inner = nzb_s_inner + 2
+ nzb_diff_s_outer = nzb_s_outer + 2
+ ELSE
+ nzb_diff_u = nzb_u_inner + 1
+ nzb_diff_v = nzb_v_inner + 1
+ nzb_diff_s_inner = nzb_s_inner + 1
+ nzb_diff_s_outer = nzb_s_outer + 1
+ ENDIF
+
+!
+!-- Calculation of wall switches and factors required by diffusion_u/v.f90 and
+!-- for limitation of near-wall mixing length l_wall further below
+ corner_nl = 0
+ corner_nr = 0
+ corner_sl = 0
+ corner_sr = 0
+ wall_l = 0
+ wall_n = 0
+ wall_r = 0
+ wall_s = 0
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+!
+!-- u-component
+ IF ( nzb_u_outer(j,i) > nzb_u_outer(j+1,i) ) THEN
+ wall_u(j,i) = 1.0 ! north wall (location of adjacent fluid)
+ fym(j,i) = 0.0
+ fyp(j,i) = 1.0
+ ELSEIF ( nzb_u_outer(j,i) > nzb_u_outer(j-1,i) ) THEN
+ wall_u(j,i) = 1.0 ! south wall (location of adjacent fluid)
+ fym(j,i) = 1.0
+ fyp(j,i) = 0.0
+ ENDIF
+!
+!-- v-component
+ IF ( nzb_v_outer(j,i) > nzb_v_outer(j,i+1) ) THEN
+ wall_v(j,i) = 1.0 ! rigth wall (location of adjacent fluid)
+ fxm(j,i) = 0.0
+ fxp(j,i) = 1.0
+ ELSEIF ( nzb_v_outer(j,i) > nzb_v_outer(j,i-1) ) THEN
+ wall_v(j,i) = 1.0 ! left wall (location of adjacent fluid)
+ fxm(j,i) = 1.0
+ fxp(j,i) = 0.0
+ ENDIF
+!
+!-- w-component, also used for scalars, separate arrays for shear
+!-- production of tke
+ IF ( nzb_w_outer(j,i) > nzb_w_outer(j+1,i) ) THEN
+ wall_e_y(j,i) = 1.0 ! north wall (location of adjacent fluid)
+ wall_w_y(j,i) = 1.0
+ fwym(j,i) = 0.0
+ fwyp(j,i) = 1.0
+ ELSEIF ( nzb_w_outer(j,i) > nzb_w_outer(j-1,i) ) THEN
+ wall_e_y(j,i) = -1.0 ! south wall (location of adjacent fluid)
+ wall_w_y(j,i) = 1.0
+ fwym(j,i) = 1.0
+ fwyp(j,i) = 0.0
+ ENDIF
+ IF ( nzb_w_outer(j,i) > nzb_w_outer(j,i+1) ) THEN
+ wall_e_x(j,i) = 1.0 ! right wall (location of adjacent fluid)
+ wall_w_x(j,i) = 1.0
+ fwxm(j,i) = 0.0
+ fwxp(j,i) = 1.0
+ ELSEIF ( nzb_w_outer(j,i) > nzb_w_outer(j,i-1) ) THEN
+ wall_e_x(j,i) = -1.0 ! left wall (location of adjacent fluid)
+ wall_w_x(j,i) = 1.0
+ fwxm(j,i) = 1.0
+ fwxp(j,i) = 0.0
+ ENDIF
+!
+!-- Wall and corner locations inside buildings for limitation of
+!-- near-wall mixing length l_wall
+ IF ( nzb_s_inner(j,i) > nzb_s_inner(j+1,i) ) THEN
+
+ wall_n(j,i) = nzb_s_inner(j+1,i) + 1 ! North wall
+
+ IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i-1) ) THEN
+ corner_nl(j,i) = MAX( nzb_s_inner(j+1,i), & ! Northleft corner
+ nzb_s_inner(j,i-1) ) + 1
+ ENDIF
+
+ IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i+1) ) THEN
+ corner_nr(j,i) = MAX( nzb_s_inner(j+1,i), & ! Northright corner
+ nzb_s_inner(j,i+1) ) + 1
+ ENDIF
+
+ ENDIF
+
+ IF ( nzb_s_inner(j,i) > nzb_s_inner(j-1,i) ) THEN
+
+ wall_s(j,i) = nzb_s_inner(j-1,i) + 1 ! South wall
+ IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i-1) ) THEN
+ corner_sl(j,i) = MAX( nzb_s_inner(j-1,i), & ! Southleft corner
+ nzb_s_inner(j,i-1) ) + 1
+ ENDIF
+
+ IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i+1) ) THEN
+ corner_sr(j,i) = MAX( nzb_s_inner(j-1,i), & ! Southright corner
+ nzb_s_inner(j,i+1) ) + 1
+ ENDIF
+
+ ENDIF
+
+ IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i-1) ) THEN
+ wall_l(j,i) = nzb_s_inner(j,i-1) + 1 ! Left wall
+ ENDIF
+
+ IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i+1) ) THEN
+ wall_r(j,i) = nzb_s_inner(j,i+1) + 1 ! Right wall
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+!
+!-- Calculate wall flag arrays for the multigrid method
+ IF ( psolver == 'multigrid' ) THEN
+!
+!-- Gridpoint increment of the current level
+ inc = 1
+
+ DO l = maximum_grid_level, 1 , -1
+
+ nxl_l = nxl_mg(l)
+ nxr_l = nxr_mg(l)
+ nys_l = nys_mg(l)
+ nyn_l = nyn_mg(l)
+ nzt_l = nzt_mg(l)
+
+!
+!-- Assign the flag level to be calculated
+ SELECT CASE ( l )
+ CASE ( 1 )
+ flags => wall_flags_1
+ CASE ( 2 )
+ flags => wall_flags_2
+ CASE ( 3 )
+ flags => wall_flags_3
+ CASE ( 4 )
+ flags => wall_flags_4
+ CASE ( 5 )
+ flags => wall_flags_5
+ CASE ( 6 )
+ flags => wall_flags_6
+ CASE ( 7 )
+ flags => wall_flags_7
+ CASE ( 8 )
+ flags => wall_flags_8
+ CASE ( 9 )
+ flags => wall_flags_9
+ CASE ( 10 )
+ flags => wall_flags_10
+ END SELECT
+
+!
+!-- Depending on the grid level, set the respective bits in case of
+!-- neighbouring walls
+!-- Bit 0: wall to the bottom
+!-- Bit 1: wall to the top (not realized in remaining PALM code so far)
+!-- Bit 2: wall to the south
+!-- Bit 3: wall to the north
+!-- Bit 4: wall to the left
+!-- Bit 5: wall to the right
+!-- Bit 6: inside building
+
+ flags = 0
+
+ DO i = nxl_l-1, nxr_l+1
+ DO j = nys_l-1, nyn_l+1
+ DO k = nzb, nzt_l+1
+
+!
+!-- Inside/outside building (inside building does not need
+!-- further tests for walls)
+ IF ( k*inc <= nzb_local(j*inc,i*inc) ) THEN
+
+ flags(k,j,i) = IBSET( flags(k,j,i), 6 )
+
+ ELSE
+!
+!-- Bottom wall
+ IF ( (k-1)*inc <= nzb_local(j*inc,i*inc) ) THEN
+ flags(k,j,i) = IBSET( flags(k,j,i), 0 )
+ ENDIF
+!
+!-- South wall
+ IF ( k*inc <= nzb_local((j-1)*inc,i*inc) ) THEN
+ flags(k,j,i) = IBSET( flags(k,j,i), 2 )
+ ENDIF
+!
+!-- North wall
+ IF ( k*inc <= nzb_local((j+1)*inc,i*inc) ) THEN
+ flags(k,j,i) = IBSET( flags(k,j,i), 3 )
+ ENDIF
+!
+!-- Left wall
+ IF ( k*inc <= nzb_local(j*inc,(i-1)*inc) ) THEN
+ flags(k,j,i) = IBSET( flags(k,j,i), 4 )
+ ENDIF
+!
+!-- Right wall
+ IF ( k*inc <= nzb_local(j*inc,(i+1)*inc) ) THEN
+ flags(k,j,i) = IBSET( flags(k,j,i), 5 )
+ ENDIF
+
+ ENDIF
+
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Test output of flag arrays
+ i = nxl_l
+ WRITE (9,*) ' '
+ WRITE (9,*) '*** mg level ', l, ' ***', mg_switch_to_pe0_level
+ WRITE (9,*) ' inc=', inc, ' i =', nxl_l
+ WRITE (9,*) ' nxl_l',nxl_l,' nxr_l=',nxr_l,' nys_l=',nys_l,' nyn_l=',nyn_l
+ DO k = nzt_l+1, nzb, -1
+ WRITE (9,'(194(1X,I2))') ( flags(k,j,i), j = nys_l-1, nyn_l+1 )
+ ENDDO
+
+ inc = inc * 2
+
+ ENDDO
+
+ ENDIF
+
+!
+!-- In case of topography: limit near-wall mixing length l_wall further:
+!-- Go through all points of the subdomain one by one and look for the closest
+!-- surface
+ IF ( TRIM(topography) /= 'flat' ) THEN
+ DO i = nxl, nxr
+ DO j = nys, nyn
+
+ nzb_si = nzb_s_inner(j,i)
+ vi = vertical_influence(nzb_si)
+
+ IF ( wall_n(j,i) > 0 ) THEN
+!
+!-- North wall (y distance)
+ DO k = wall_n(j,i), nzb_si
+ l_wall(k,j+1,i) = MIN( l_wall(k,j+1,i), 0.5 * dy )
+ ENDDO
+!
+!-- Above North wall (yz distance)
+ DO k = nzb_si + 1, nzb_si + vi
+ l_wall(k,j+1,i) = MIN( l_wall(k,j+1,i), &
+ SQRT( 0.25 * dy**2 + &
+ ( zu(k) - zw(nzb_si) )**2 ) )
+ ENDDO
+!
+!-- Northleft corner (xy distance)
+ IF ( corner_nl(j,i) > 0 ) THEN
+ DO k = corner_nl(j,i), nzb_si
+ l_wall(k,j+1,i-1) = MIN( l_wall(k,j+1,i-1), &
+ 0.5 * SQRT( dx**2 + dy**2 ) )
+ ENDDO
+!
+!-- Above Northleft corner (xyz distance)
+ DO k = nzb_si + 1, nzb_si + vi
+ l_wall(k,j+1,i-1) = MIN( l_wall(k,j+1,i-1), &
+ SQRT( 0.25 * (dx**2 + dy**2) + &
+ ( zu(k) - zw(nzb_si) )**2 ) )
+ ENDDO
+ ENDIF
+!
+!-- Northright corner (xy distance)
+ IF ( corner_nr(j,i) > 0 ) THEN
+ DO k = corner_nr(j,i), nzb_si
+ l_wall(k,j+1,i+1) = MIN( l_wall(k,j+1,i+1), &
+ 0.5 * SQRT( dx**2 + dy**2 ) )
+ ENDDO
+!
+!-- Above northright corner (xyz distance)
+ DO k = nzb_si + 1, nzb_si + vi
+ l_wall(k,j+1,i+1) = MIN( l_wall(k,j+1,i+1), &
+ SQRT( 0.25 * (dx**2 + dy**2) + &
+ ( zu(k) - zw(nzb_si) )**2 ) )
+ ENDDO
+ ENDIF
+ ENDIF
+
+ IF ( wall_s(j,i) > 0 ) THEN
+!
+!-- South wall (y distance)
+ DO k = wall_s(j,i), nzb_si
+ l_wall(k,j-1,i) = MIN( l_wall(k,j-1,i), 0.5 * dy )
+ ENDDO
+!
+!-- Above south wall (yz distance)
+ DO k = nzb_si + 1, &
+ nzb_si + vi
+ l_wall(k,j-1,i) = MIN( l_wall(k,j-1,i), &
+ SQRT( 0.25 * dy**2 + &
+ ( zu(k) - zw(nzb_si) )**2 ) )
+ ENDDO
+!
+!-- Southleft corner (xy distance)
+ IF ( corner_sl(j,i) > 0 ) THEN
+ DO k = corner_sl(j,i), nzb_si
+ l_wall(k,j-1,i-1) = MIN( l_wall(k,j-1,i-1), &
+ 0.5 * SQRT( dx**2 + dy**2 ) )
+ ENDDO
+!
+!-- Above southleft corner (xyz distance)
+ DO k = nzb_si + 1, nzb_si + vi
+ l_wall(k,j-1,i-1) = MIN( l_wall(k,j-1,i-1), &
+ SQRT( 0.25 * (dx**2 + dy**2) + &
+ ( zu(k) - zw(nzb_si) )**2 ) )
+ ENDDO
+ ENDIF
+!
+!-- Southright corner (xy distance)
+ IF ( corner_sr(j,i) > 0 ) THEN
+ DO k = corner_sr(j,i), nzb_si
+ l_wall(k,j-1,i+1) = MIN( l_wall(k,j-1,i+1), &
+ 0.5 * SQRT( dx**2 + dy**2 ) )
+ ENDDO
+!
+!-- Above southright corner (xyz distance)
+ DO k = nzb_si + 1, nzb_si + vi
+ l_wall(k,j-1,i+1) = MIN( l_wall(k,j-1,i+1), &
+ SQRT( 0.25 * (dx**2 + dy**2) + &
+ ( zu(k) - zw(nzb_si) )**2 ) )
+ ENDDO
+ ENDIF
+
+ ENDIF
+
+ IF ( wall_l(j,i) > 0 ) THEN
+!
+!-- Left wall (x distance)
+ DO k = wall_l(j,i), nzb_si
+ l_wall(k,j,i-1) = MIN( l_wall(k,j,i-1), 0.5 * dx )
+ ENDDO
+!
+!-- Above left wall (xz distance)
+ DO k = nzb_si + 1, nzb_si + vi
+ l_wall(k,j,i-1) = MIN( l_wall(k,j,i-1), &
+ SQRT( 0.25 * dx**2 + &
+ ( zu(k) - zw(nzb_si) )**2 ) )
+ ENDDO
+ ENDIF
+
+ IF ( wall_r(j,i) > 0 ) THEN
+!
+!-- Right wall (x distance)
+ DO k = wall_r(j,i), nzb_si
+ l_wall(k,j,i+1) = MIN( l_wall(k,j,i+1), 0.5 * dx )
+ ENDDO
+!
+!-- Above right wall (xz distance)
+ DO k = nzb_si + 1, nzb_si + vi
+ l_wall(k,j,i+1) = MIN( l_wall(k,j,i+1), &
+ SQRT( 0.25 * dx**2 + &
+ ( zu(k) - zw(nzb_si) )**2 ) )
+ ENDDO
+
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+!
+!-- Multiplication with wall_adjustment_factor
+ l_wall = wall_adjustment_factor * l_wall
+
+!
+!-- Need to set lateral boundary conditions for l_wall
+ CALL exchange_horiz( l_wall )
+
+ DEALLOCATE( corner_nl, corner_nr, corner_sl, corner_sr, nzb_local, &
+ nzb_tmp, vertical_influence, wall_l, wall_n, wall_r, wall_s )
+
+
+ END SUBROUTINE init_grid
Index: /palm/tags/release-3.4a/SOURCE/init_ocean.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/init_ocean.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/init_ocean.f90 (revision 141)
@@ -0,0 +1,84 @@
+ SUBROUTINE init_ocean
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! ------------------
+! $Id$
+!
+! 124 2007-10-19 15:47:46Z raasch
+! Bugfix: Initial density rho is calculated
+!
+! 97 2007-06-21 08:23:15Z raasch
+! Initial revision
+!
+! Description:
+! ------------
+! Initialization of quantities needed for the ocean version
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE eqn_state_seawater_mod
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: k
+
+ REAL :: sa_l, pt_l, rho_l
+
+ ALLOCATE( hyp(nzb:nzt+1) )
+
+!
+!-- Set water density near the ocean surface
+ rho_surface = 1027.62
+
+!
+!-- Calculate initial vertical profile of hydrostatic pressure (in Pa)
+!-- and the reference density (used later in buoyancy term)
+ hyp(nzt+1) = surface_pressure * 100.0
+
+ hyp(nzt) = hyp(nzt+1) + rho_surface * g * 0.5 * dzu(nzt+1)
+ rho_reference = rho_surface * 0.5 * dzu(nzt+1)
+
+ DO k = nzt-1, 0, -1
+
+ sa_l = 0.5 * ( sa_init(k) + sa_init(k+1) )
+ pt_l = 0.5 * ( pt_init(k) + pt_init(k+1) )
+
+ rho_l = eqn_state_seawater_func( hyp(k+1), pt_l, sa_l )
+
+ hyp(k) = hyp(k+1) + rho_l * g * dzu(k+1)
+ rho_reference = rho_reference + rho_l * dzu(k+1)
+
+ ENDDO
+
+ rho_reference = rho_reference / ( zw(nzt) - zu(nzb) )
+
+!
+!-- Calculate the reference potential density
+ prho_reference = 0.0
+ DO k = 0, nzt
+
+ sa_l = 0.5 * ( sa_init(k) + sa_init(k+1) )
+ pt_l = 0.5 * ( pt_init(k) + pt_init(k+1) )
+
+ prho_reference = prho_reference + dzu(k+1) * &
+ eqn_state_seawater_func( hyp(0), pt_l, sa_l )
+
+ ENDDO
+
+ prho_reference = prho_reference / ( zu(nzt) - zu(nzb) )
+
+!
+!-- Calculate the initial potential density, based on the initial
+!-- temperature and salinity profile
+ CALL eqn_state_seawater
+
+
+ END SUBROUTINE init_ocean
Index: /palm/tags/release-3.4a/SOURCE/init_particles.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/init_particles.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/init_particles.f90 (revision 141)
@@ -0,0 +1,567 @@
+ SUBROUTINE init_particles
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 117 2007-10-11 03:27:59Z raasch
+! Sorting of particles only in case of cloud droplets
+!
+! 106 2007-08-16 14:30:26Z raasch
+! variable iran replaced by iran_part
+!
+! 82 2007-04-16 15:40:52Z raasch
+! Preprocessor directives for old systems removed
+!
+! 70 2007-03-18 23:46:30Z raasch
+! displacements for mpi_particle_type changed, age_m initialized,
+! particles-package is now part of the default code
+!
+! 16 2007-02-15 13:16:47Z raasch
+! Bugfix: MPI_REAL in MPI_ALLREDUCE replaced by MPI_INTEGER
+!
+! r4 | raasch | 2007-02-13 12:33:16 +0100 (Tue, 13 Feb 2007)
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.24 2007/02/11 13:00:17 raasch
+! Bugfix: allocation of tail_mask and new_tail_id in case of restart-runs
+! Bugfix: __ was missing in a cpp-directive
+!
+! Revision 1.1 1999/11/25 16:22:38 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! This routine initializes a set of particles and their attributes (position,
+! radius, ..). Advection of these particles is carried out by advec_particles,
+! plotting is done in data_output_dvrp.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE particle_attributes
+ USE pegrid
+ USE random_function_mod
+
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=10) :: particle_binary_version, version_on_file
+
+ INTEGER :: i, j, n, nn
+#if defined( __parallel )
+ INTEGER, DIMENSION(3) :: blocklengths, displacements, types
+#endif
+ LOGICAL :: uniform_particles_l
+ REAL :: factor, pos_x, pos_y, pos_z, value
+
+
+#if defined( __parallel )
+!
+!-- Define MPI derived datatype for FORTRAN datatype particle_type (see module
+!-- particle_attributes). Integer length is 4 byte, Real is 8 byte
+ blocklengths(1) = 19; blocklengths(2) = 4; blocklengths(3) = 1
+ displacements(1) = 0; displacements(2) = 152; displacements(3) = 168
+
+ types(1) = MPI_REAL
+ types(2) = MPI_INTEGER
+ types(3) = MPI_UB
+ CALL MPI_TYPE_STRUCT( 3, blocklengths, displacements, types, &
+ mpi_particle_type, ierr )
+ CALL MPI_TYPE_COMMIT( mpi_particle_type, ierr )
+#endif
+
+!
+!-- Check the number of particle groups.
+ IF ( number_of_particle_groups > max_number_of_particle_groups ) THEN
+ PRINT*, '+++ WARNING: init_particles: ', &
+ 'max_number_of_particle_groups =', &
+ max_number_of_particle_groups
+ PRINT*, '+++ number_of_particle_groups reset to ', &
+ max_number_of_particle_groups
+ number_of_particle_groups = max_number_of_particle_groups
+ ENDIF
+
+!
+!-- Set default start positions, if necessary
+ IF ( psl(1) == 9999999.9 ) psl(1) = -0.5 * dx
+ IF ( psr(1) == 9999999.9 ) psr(1) = ( nx + 0.5 ) * dx
+ IF ( pss(1) == 9999999.9 ) pss(1) = -0.5 * dy
+ IF ( psn(1) == 9999999.9 ) psn(1) = ( ny + 0.5 ) * dy
+ IF ( psb(1) == 9999999.9 ) psb(1) = zu(nz/2)
+ IF ( pst(1) == 9999999.9 ) pst(1) = psb(1)
+
+ IF ( pdx(1) == 9999999.9 .OR. pdx(1) == 0.0 ) pdx(1) = dx
+ IF ( pdy(1) == 9999999.9 .OR. pdy(1) == 0.0 ) pdy(1) = dy
+ IF ( pdz(1) == 9999999.9 .OR. pdz(1) == 0.0 ) pdz(1) = zu(2) - zu(1)
+
+ DO j = 2, number_of_particle_groups
+ IF ( psl(j) == 9999999.9 ) psl(j) = psl(j-1)
+ IF ( psr(j) == 9999999.9 ) psr(j) = psr(j-1)
+ IF ( pss(j) == 9999999.9 ) pss(j) = pss(j-1)
+ IF ( psn(j) == 9999999.9 ) psn(j) = psn(j-1)
+ IF ( psb(j) == 9999999.9 ) psb(j) = psb(j-1)
+ IF ( pst(j) == 9999999.9 ) pst(j) = pst(j-1)
+ IF ( pdx(j) == 9999999.9 .OR. pdx(j) == 0.0 ) pdx(j) = pdx(j-1)
+ IF ( pdy(j) == 9999999.9 .OR. pdy(j) == 0.0 ) pdy(j) = pdy(j-1)
+ IF ( pdz(j) == 9999999.9 .OR. pdz(j) == 0.0 ) pdz(j) = pdz(j-1)
+ ENDDO
+
+!
+!-- For the first model run of a possible job chain initialize the
+!-- particles, otherwise read the particle data from file.
+ IF ( TRIM( initializing_actions ) == 'read_restart_data' &
+ .AND. read_particles_from_restartfile ) THEN
+
+!
+!-- Read particle data from previous model run.
+!-- First open the input unit.
+ IF ( myid_char == '' ) THEN
+ OPEN ( 90, FILE='PARTICLE_RESTART_DATA_IN'//myid_char, &
+ FORM='UNFORMATTED' )
+ ELSE
+ OPEN ( 90, FILE='PARTICLE_RESTART_DATA_IN/'//myid_char, &
+ FORM='UNFORMATTED' )
+ ENDIF
+
+!
+!-- First compare the version numbers
+ READ ( 90 ) version_on_file
+ particle_binary_version = '3.0'
+ IF ( TRIM( version_on_file ) /= TRIM( particle_binary_version ) ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ init_particles: version mismatch concerning data ', &
+ 'from prior run'
+ PRINT*, ' version on file = "', TRIM( version_on_file ),&
+ '"'
+ PRINT*, ' version in program = "', &
+ TRIM( particle_binary_version ), '"'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Read some particle parameters and the size of the particle arrays,
+!-- allocate them and read their contents.
+ READ ( 90 ) bc_par_b, bc_par_lr, bc_par_ns, bc_par_t, &
+ maximum_number_of_particles, maximum_number_of_tailpoints, &
+ maximum_number_of_tails, number_of_initial_particles, &
+ number_of_particles, number_of_particle_groups, &
+ number_of_tails, particle_groups, time_prel, &
+ time_write_particle_data, uniform_particles
+
+ IF ( number_of_initial_particles /= 0 ) THEN
+ ALLOCATE( initial_particles(1:number_of_initial_particles) )
+ READ ( 90 ) initial_particles
+ ENDIF
+
+ ALLOCATE( prt_count(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ prt_start_index(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ particle_mask(maximum_number_of_particles), &
+ particles(maximum_number_of_particles) )
+
+ READ ( 90 ) prt_count, prt_start_index
+ READ ( 90 ) particles
+
+ IF ( use_particle_tails ) THEN
+ ALLOCATE( particle_tail_coordinates(maximum_number_of_tailpoints,5, &
+ maximum_number_of_tails), &
+ new_tail_id(maximum_number_of_tails), &
+ tail_mask(maximum_number_of_tails) )
+ READ ( 90 ) particle_tail_coordinates
+ ENDIF
+
+ CLOSE ( 90 )
+
+ ELSE
+
+!
+!-- Allocate particle arrays and set attributes of the initial set of
+!-- particles, which can be also periodically released at later times.
+!-- Also allocate array for particle tail coordinates, if needed.
+ ALLOCATE( prt_count(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ prt_start_index(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1), &
+ particle_mask(maximum_number_of_particles), &
+ particles(maximum_number_of_particles) )
+
+!
+!-- Initialize all particles with dummy values (otherwise errors may
+!-- occur within restart runs). The reason for this is still not clear
+!-- and may be presumably caused by errors in the respective user-interface.
+ particles = particle_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+ 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
+ 0.0, 0, 0, 0, 0 )
+ particle_groups = particle_groups_type( 0.0, 0.0, 0.0, 0.0 )
+
+!
+!-- Set the default particle size used for dvrp plots
+ IF ( dvrp_psize == 9999999.9 ) dvrp_psize = 0.2 * dx
+
+!
+!-- Set values for the density ratio and radius for all particle
+!-- groups, if necessary
+ IF ( density_ratio(1) == 9999999.9 ) density_ratio(1) = 0.0
+ IF ( radius(1) == 9999999.9 ) radius(1) = 0.0
+ DO i = 2, number_of_particle_groups
+ IF ( density_ratio(i) == 9999999.9 ) THEN
+ density_ratio(i) = density_ratio(i-1)
+ ENDIF
+ IF ( radius(i) == 9999999.9 ) radius(i) = radius(i-1)
+ ENDDO
+
+ DO i = 1, number_of_particle_groups
+ IF ( density_ratio(i) /= 0.0 .AND. radius(i) == 0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ init_particles: particle group #', i, 'has a', &
+ 'density ratio /= 0 but radius = 0'
+ ENDIF
+ CALL local_stop
+ ENDIF
+ particle_groups(i)%density_ratio = density_ratio(i)
+ particle_groups(i)%radius = radius(i)
+ ENDDO
+
+!
+!-- Calculate particle positions and store particle attributes, if
+!-- particle is situated on this PE
+ n = 0
+
+ DO i = 1, number_of_particle_groups
+
+ pos_z = psb(i)
+
+ DO WHILE ( pos_z <= pst(i) )
+
+ pos_y = pss(i)
+
+ DO WHILE ( pos_y <= psn(i) )
+
+ IF ( pos_y >= ( nys - 0.5 ) * dy .AND. &
+ pos_y < ( nyn + 0.5 ) * dy ) THEN
+
+ pos_x = psl(i)
+
+ DO WHILE ( pos_x <= psr(i) )
+
+ IF ( pos_x >= ( nxl - 0.5 ) * dx .AND. &
+ pos_x < ( nxr + 0.5 ) * dx ) THEN
+
+ DO j = 1, particles_per_point
+
+ n = n + 1
+ IF ( n > maximum_number_of_particles ) THEN
+ PRINT*,'+++ init_particles: number of initial', &
+ ' particles (', n, ') exceeds'
+ PRINT*,' maximum_number_of_particles (', &
+ maximum_number_of_particles, ') on PE ', &
+ myid
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ CALL local_stop
+#endif
+ ENDIF
+ particles(n)%x = pos_x
+ particles(n)%y = pos_y
+ particles(n)%z = pos_z
+ particles(n)%age = 0.0
+ particles(n)%age_m = 0.0
+ particles(n)%dt_sum = 0.0
+ particles(n)%dvrp_psize = dvrp_psize
+ particles(n)%e_m = 0.0
+ particles(n)%speed_x = 0.0
+ particles(n)%speed_x_sgs = 0.0
+ particles(n)%speed_y = 0.0
+ particles(n)%speed_y_sgs = 0.0
+ particles(n)%speed_z = 0.0
+ particles(n)%speed_z_sgs = 0.0
+ particles(n)%origin_x = pos_x
+ particles(n)%origin_y = pos_y
+ particles(n)%origin_z = pos_z
+ particles(n)%radius = particle_groups(i)%radius
+ particles(n)%weight_factor =initial_weighting_factor
+ particles(n)%color = 1
+ particles(n)%group = i
+ particles(n)%tailpoints = 0
+ IF ( use_particle_tails .AND. &
+ MOD( n, skip_particles_for_tail ) == 0 ) THEN
+ number_of_tails = number_of_tails + 1
+!
+!-- This is a temporary provisional setting (see
+!-- further below!)
+ particles(n)%tail_id = number_of_tails
+ ELSE
+ particles(n)%tail_id = 0
+ ENDIF
+
+ ENDDO
+
+ ENDIF
+
+ pos_x = pos_x + pdx(i)
+
+ ENDDO
+
+ ENDIF
+
+ pos_y = pos_y + pdy(i)
+
+ ENDDO
+
+ pos_z = pos_z + pdz(i)
+
+ ENDDO
+
+ ENDDO
+
+ number_of_initial_particles = n
+ number_of_particles = n
+
+!
+!-- Calculate the number of particles and tails of the total domain
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( number_of_particles, total_number_of_particles, 1, &
+ MPI_INTEGER, MPI_SUM, comm2d, ierr )
+ CALL MPI_ALLREDUCE( number_of_tails, total_number_of_tails, 1, &
+ MPI_INTEGER, MPI_SUM, comm2d, ierr )
+#else
+ total_number_of_particles = number_of_particles
+ total_number_of_tails = number_of_tails
+#endif
+
+!
+!-- Set a seed value for the random number generator to be exclusively
+!-- used for the particle code. The generated random numbers should be
+!-- different on the different PEs.
+ iran_part = iran_part + myid
+
+!
+!-- User modification of initial particles
+ CALL user_init_particles
+
+!
+!-- Store the initial set of particles for release at later times
+ IF ( number_of_initial_particles /= 0 ) THEN
+ ALLOCATE( initial_particles(1:number_of_initial_particles) )
+ initial_particles(1:number_of_initial_particles) = &
+ particles(1:number_of_initial_particles)
+ ENDIF
+
+!
+!-- Add random fluctuation to particle positions
+ IF ( random_start_position ) THEN
+
+ DO n = 1, number_of_initial_particles
+ IF ( psl(particles(n)%group) /= psr(particles(n)%group) ) THEN
+ particles(n)%x = particles(n)%x + &
+ ( random_function( iran_part ) - 0.5 ) * &
+ pdx(particles(n)%group)
+ IF ( particles(n)%x <= ( nxl - 0.5 ) * dx ) THEN
+ particles(n)%x = ( nxl - 0.4999999999 ) * dx
+ ELSEIF ( particles(n)%x >= ( nxr + 0.5 ) * dx ) THEN
+ particles(n)%x = ( nxr + 0.4999999999 ) * dx
+ ENDIF
+ ENDIF
+ IF ( pss(particles(n)%group) /= psn(particles(n)%group) ) THEN
+ particles(n)%y = particles(n)%y + &
+ ( random_function( iran_part ) - 0.5 ) * &
+ pdy(particles(n)%group)
+ IF ( particles(n)%y <= ( nys - 0.5 ) * dy ) THEN
+ particles(n)%y = ( nys - 0.4999999999 ) * dy
+ ELSEIF ( particles(n)%y >= ( nyn + 0.5 ) * dy ) THEN
+ particles(n)%y = ( nyn + 0.4999999999 ) * dy
+ ENDIF
+ ENDIF
+ IF ( psb(particles(n)%group) /= pst(particles(n)%group) ) THEN
+ particles(n)%z = particles(n)%z + &
+ ( random_function( iran_part ) - 0.5 ) * &
+ pdz(particles(n)%group)
+ ENDIF
+ ENDDO
+ ENDIF
+
+!
+!-- Sort particles in the sequence the gridboxes are stored in the memory.
+!-- Only required if cloud droplets are used.
+ IF ( cloud_droplets ) CALL sort_particles
+
+!
+!-- Open file for statistical informations about particle conditions
+ IF ( write_particle_statistics ) THEN
+ CALL check_open( 80 )
+ WRITE ( 80, 8000 ) current_timestep_number, simulated_time, &
+ number_of_initial_particles, &
+ maximum_number_of_particles
+ CALL close_file( 80 )
+ ENDIF
+
+!
+!-- Check if particles are really uniform in color and radius (dvrp_size)
+!-- (uniform_particles is preset TRUE)
+ IF ( uniform_particles ) THEN
+ IF ( number_of_initial_particles == 0 ) THEN
+ uniform_particles_l = .TRUE.
+ ELSE
+ n = number_of_initial_particles
+ IF ( MINVAL( particles(1:n)%dvrp_psize ) == &
+ MAXVAL( particles(1:n)%dvrp_psize ) .AND. &
+ MINVAL( particles(1:n)%color ) == &
+ MAXVAL( particles(1:n)%color ) ) THEN
+ uniform_particles_l = .TRUE.
+ ELSE
+ uniform_particles_l = .FALSE.
+ ENDIF
+ ENDIF
+
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( uniform_particles_l, uniform_particles, 1, &
+ MPI_LOGICAL, MPI_LAND, comm2d, ierr )
+#else
+ uniform_particles = uniform_particles_l
+#endif
+
+ ENDIF
+
+!
+!-- Set the beginning of the particle tails and their age
+ IF ( use_particle_tails ) THEN
+!
+!-- Choose the maximum number of tails significantly larger than the
+!-- one initially required
+ factor = 10.0
+ value = number_of_tails
+ DO WHILE ( value / 10.0 >= 1.0 )
+ factor = factor * 10.0
+ value = value / 10.0
+ ENDDO
+ maximum_number_of_tails = factor * INT( value )
+
+ ALLOCATE( particle_tail_coordinates(maximum_number_of_tailpoints,5, &
+ maximum_number_of_tails), &
+ new_tail_id(maximum_number_of_tails), &
+ tail_mask(maximum_number_of_tails) )
+
+ particle_tail_coordinates = 0.0
+ minimum_tailpoint_distance = minimum_tailpoint_distance**2
+ number_of_initial_tails = number_of_tails
+
+ nn = 0
+ DO n = 1, number_of_particles
+!
+!-- Only for those particles marked above with a provisional tail_id
+!-- tails will be created. Particles now get their final tail_id.
+ IF ( particles(n)%tail_id /= 0 ) THEN
+
+ nn = nn + 1
+ particles(n)%tail_id = nn
+
+ particle_tail_coordinates(1,1,nn) = particles(n)%x
+ particle_tail_coordinates(1,2,nn) = particles(n)%y
+ particle_tail_coordinates(1,3,nn) = particles(n)%z
+ particle_tail_coordinates(1,4,nn) = particles(n)%color
+ particles(n)%tailpoints = 1
+ IF ( minimum_tailpoint_distance /= 0.0 ) THEN
+ particle_tail_coordinates(2,1,nn) = particles(n)%x
+ particle_tail_coordinates(2,2,nn) = particles(n)%y
+ particle_tail_coordinates(2,3,nn) = particles(n)%z
+ particle_tail_coordinates(2,4,nn) = particles(n)%color
+ particle_tail_coordinates(1:2,5,nn) = 0.0
+ particles(n)%tailpoints = 2
+ ENDIF
+
+ ENDIF
+ ENDDO
+ ENDIF
+
+!
+!-- Plot initial positions of particles (only if particle advection is
+!-- switched on from the beginning of the simulation (t=0))
+ IF ( particle_advection_start == 0.0 ) CALL data_output_dvrp
+
+ ENDIF
+
+!
+!-- Check boundary condition and set internal variables
+ SELECT CASE ( bc_par_b )
+
+ CASE ( 'absorb' )
+ ibc_par_b = 1
+
+ CASE ( 'reflect' )
+ ibc_par_b = 2
+
+ CASE DEFAULT
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ init_particles: unknown boundary condition ', &
+ 'bc_par_b = "', TRIM( bc_par_b ), '"'
+ ENDIF
+ CALL local_stop
+
+ END SELECT
+ SELECT CASE ( bc_par_t )
+
+ CASE ( 'absorb' )
+ ibc_par_t = 1
+
+ CASE ( 'reflect' )
+ ibc_par_t = 2
+
+ CASE DEFAULT
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ init_particles: unknown boundary condition ', &
+ 'bc_par_t = "', TRIM( bc_par_t ), '"'
+ ENDIF
+ CALL local_stop
+
+ END SELECT
+ SELECT CASE ( bc_par_lr )
+
+ CASE ( 'cyclic' )
+ ibc_par_lr = 0
+
+ CASE ( 'absorb' )
+ ibc_par_lr = 1
+
+ CASE ( 'reflect' )
+ ibc_par_lr = 2
+
+ CASE DEFAULT
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ init_particles: unknown boundary condition ', &
+ 'bc_par_lr = "', TRIM( bc_par_lr ), '"'
+ ENDIF
+ CALL local_stop
+
+ END SELECT
+ SELECT CASE ( bc_par_ns )
+
+ CASE ( 'cyclic' )
+ ibc_par_ns = 0
+
+ CASE ( 'absorb' )
+ ibc_par_ns = 1
+
+ CASE ( 'reflect' )
+ ibc_par_ns = 2
+
+ CASE DEFAULT
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ init_particles: unknown boundary condition ', &
+ 'bc_par_ns = "', TRIM( bc_par_ns ), '"'
+ ENDIF
+ CALL local_stop
+
+ END SELECT
+!
+!-- Formats
+8000 FORMAT (I6,1X,F7.2,4X,I6,71X,I6)
+
+ END SUBROUTINE init_particles
Index: /palm/tags/release-3.4a/SOURCE/init_pegrid.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/init_pegrid.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/init_pegrid.f90 (revision 141)
@@ -0,0 +1,990 @@
+ SUBROUTINE init_pegrid
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+! TEST OUTPUT (TO BE REMOVED) logging mpi2 ierr values
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 114 2007-10-10 00:03:15Z raasch
+! Allocation of wall flag arrays for multigrid solver
+!
+! 108 2007-08-24 15:10:38Z letzel
+! Intercommunicator (comm_inter) and derived data type (type_xy) for
+! coupled model runs created, assign coupling_mode_remote,
+! indices nxlu and nysv are calculated (needed for non-cyclic boundary
+! conditions)
+!
+! 82 2007-04-16 15:40:52Z raasch
+! Cpp-directive lcmuk changed to intel_openmp_bug, setting of host on lcmuk by
+! cpp-directive removed
+!
+! 75 2007-03-22 09:54:05Z raasch
+! uxrp, vynp eliminated,
+! dirichlet/neumann changed to dirichlet/radiation, etc.,
+! poisfft_init is only called if fft-solver is switched on
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.28 2006/04/26 13:23:32 raasch
+! lcmuk does not understand the !$ comment so a cpp-directive is required
+!
+! Revision 1.1 1997/07/24 11:15:09 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Determination of the virtual processor topology (if not prescribed by the
+! user)and computation of the grid point number and array bounds of the local
+! domains.
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE fft_xy
+ USE indices
+ USE pegrid
+ USE poisfft_mod
+ USE poisfft_hybrid_mod
+ USE statistics
+ USE transpose_indices
+
+
+ IMPLICIT NONE
+
+ INTEGER :: gathered_size, i, ind(5), j, k, maximum_grid_level_l, &
+ mg_switch_to_pe0_level_l, mg_levels_x, mg_levels_y, &
+ mg_levels_z, nnx_y, nnx_z, nny_x, nny_z, nnz_x, nnz_y, &
+ numproc_sqr, nx_total, nxl_l, nxr_l, nyn_l, nys_l, nzb_l, &
+ nzt_l, omp_get_num_threads, subdomain_size
+
+ INTEGER, DIMENSION(:), ALLOCATABLE :: ind_all, nxlf, nxrf, nynf, nysf
+
+ LOGICAL :: found
+
+!
+!-- Get the number of OpenMP threads
+ !$OMP PARALLEL
+#if defined( __intel_openmp_bug )
+ threads_per_task = omp_get_num_threads()
+#else
+!$ threads_per_task = omp_get_num_threads()
+#endif
+ !$OMP END PARALLEL
+
+
+#if defined( __parallel )
+!
+!-- Determine the processor topology or check it, if prescribed by the user
+ IF ( npex == -1 .AND. npey == -1 ) THEN
+
+!
+!-- Automatic determination of the topology
+!-- The default on SMP- and cluster-hosts is a 1d-decomposition along x
+ IF ( host(1:3) == 'ibm' .OR. host(1:3) == 'nec' .OR. &
+ host(1:2) == 'lc' .OR. host(1:3) == 'dec' ) THEN
+
+ pdims(1) = numprocs
+ pdims(2) = 1
+
+ ELSE
+
+ numproc_sqr = SQRT( REAL( numprocs ) )
+ pdims(1) = MAX( numproc_sqr , 1 )
+ DO WHILE ( MOD( numprocs , pdims(1) ) /= 0 )
+ pdims(1) = pdims(1) - 1
+ ENDDO
+ pdims(2) = numprocs / pdims(1)
+
+ ENDIF
+
+ ELSEIF ( npex /= -1 .AND. npey /= -1 ) THEN
+
+!
+!-- Prescribed by user. Number of processors on the prescribed topology
+!-- must be equal to the number of PEs available to the job
+ IF ( ( npex * npey ) /= numprocs ) THEN
+ PRINT*, '+++ init_pegrid:'
+ PRINT*, ' number of PEs of the prescribed topology (', npex*npey, &
+ ') does not match the number of PEs available to the ', &
+ 'job (', numprocs, ')'
+ CALL local_stop
+ ENDIF
+ pdims(1) = npex
+ pdims(2) = npey
+
+ ELSE
+!
+!-- If the processor topology is prescribed by the user, the number of
+!-- PEs must be given in both directions
+ PRINT*, '+++ init_pegrid:'
+ PRINT*, ' if the processor topology is prescribed by the user, ', &
+ 'both values of "npex" and "npey" must be given in the ', &
+ 'NAMELIST-parameter file'
+ CALL local_stop
+
+ ENDIF
+
+!
+!-- The hybrid solver can only be used in case of a 1d-decomposition along x
+ IF ( pdims(2) /= 1 .AND. psolver == 'poisfft_hybrid' ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '*** init_pegrid: psolver = "poisfft_hybrid" can only be'
+ PRINT*, ' used in case of a 1d-decomposition along x'
+ ENDIF
+ ENDIF
+
+!
+!-- If necessary, set horizontal boundary conditions to non-cyclic
+ IF ( bc_lr /= 'cyclic' ) cyclic(1) = .FALSE.
+ IF ( bc_ns /= 'cyclic' ) cyclic(2) = .FALSE.
+
+!
+!-- Create the virtual processor grid
+ CALL MPI_CART_CREATE( comm_palm, ndim, pdims, cyclic, reorder, &
+ comm2d, ierr )
+ CALL MPI_COMM_RANK( comm2d, myid, ierr )
+ WRITE (myid_char,'(''_'',I4.4)') myid
+
+ CALL MPI_CART_COORDS( comm2d, myid, ndim, pcoord, ierr )
+ CALL MPI_CART_SHIFT( comm2d, 0, 1, pleft, pright, ierr )
+ CALL MPI_CART_SHIFT( comm2d, 1, 1, psouth, pnorth, ierr )
+
+!
+!-- Determine sub-topologies for transpositions
+!-- Transposition from z to x:
+ remain_dims(1) = .TRUE.
+ remain_dims(2) = .FALSE.
+ CALL MPI_CART_SUB( comm2d, remain_dims, comm1dx, ierr )
+ CALL MPI_COMM_RANK( comm1dx, myidx, ierr )
+!
+!-- Transposition from x to y
+ remain_dims(1) = .FALSE.
+ remain_dims(2) = .TRUE.
+ CALL MPI_CART_SUB( comm2d, remain_dims, comm1dy, ierr )
+ CALL MPI_COMM_RANK( comm1dy, myidy, ierr )
+
+
+!
+!-- Find a grid (used for array d) which will match the transposition demands
+ IF ( grid_matching == 'strict' ) THEN
+
+ nxa = nx; nya = ny; nza = nz
+
+ ELSE
+
+ found = .FALSE.
+ xn: DO nxa = nx, 2*nx
+!
+!-- Meet conditions for nx
+ IF ( MOD( nxa+1, pdims(1) ) /= 0 .OR. &
+ MOD( nxa+1, pdims(2) ) /= 0 ) CYCLE xn
+
+ yn: DO nya = ny, 2*ny
+!
+!-- Meet conditions for ny
+ IF ( MOD( nya+1, pdims(2) ) /= 0 .OR. &
+ MOD( nya+1, pdims(1) ) /= 0 ) CYCLE yn
+
+
+ zn: DO nza = nz, 2*nz
+!
+!-- Meet conditions for nz
+ IF ( ( MOD( nza, pdims(1) ) /= 0 .AND. pdims(1) /= 1 .AND. &
+ pdims(2) /= 1 ) .OR. &
+ ( MOD( nza, pdims(2) ) /= 0 .AND. dt_dosp /= 9999999.9 &
+ ) ) THEN
+ CYCLE zn
+ ELSE
+ found = .TRUE.
+ EXIT xn
+ ENDIF
+
+ ENDDO zn
+
+ ENDDO yn
+
+ ENDDO xn
+
+ IF ( .NOT. found ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ init_pegrid: no matching grid for transpositions found'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ ENDIF
+
+!
+!-- Calculate array bounds in x-direction for every PE.
+!-- The last PE along x may get less grid points than the others
+ ALLOCATE( nxlf(0:pdims(1)-1), nxrf(0:pdims(1)-1), nynf(0:pdims(2)-1), &
+ nysf(0:pdims(2)-1), nnx_pe(0:pdims(1)-1), nny_pe(0:pdims(2)-1) )
+
+ IF ( MOD( nxa+1 , pdims(1) ) /= 0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ x-direction: gridpoint number (',nx+1,') is not an'
+ PRINT*,' integral divisor of the number of proces', &
+ &'sors (', pdims(1),')'
+ ENDIF
+ CALL local_stop
+ ELSE
+ nnx = ( nxa + 1 ) / pdims(1)
+ IF ( nnx*pdims(1) - ( nx + 1) > nnx ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ x-direction: nx does not match the requirements ', &
+ 'given by the number of PEs'
+ PRINT*,' used'
+ PRINT*,' please use nx = ', nx - ( pdims(1) - ( nnx*pdims(1) &
+ - ( nx + 1 ) ) ), ' instead of nx =', nx
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+
+!
+!-- Left and right array bounds, number of gridpoints
+ DO i = 0, pdims(1)-1
+ nxlf(i) = i * nnx
+ nxrf(i) = ( i + 1 ) * nnx - 1
+ nnx_pe(i) = MIN( nx, nxrf(i) ) - nxlf(i) + 1
+ ENDDO
+
+!
+!-- Calculate array bounds in y-direction for every PE.
+ IF ( MOD( nya+1 , pdims(2) ) /= 0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ y-direction: gridpoint number (',ny+1,') is not an'
+ PRINT*,' integral divisor of the number of proces', &
+ &'sors (', pdims(2),')'
+ ENDIF
+ CALL local_stop
+ ELSE
+ nny = ( nya + 1 ) / pdims(2)
+ IF ( nny*pdims(2) - ( ny + 1) > nny ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ x-direction: nx does not match the requirements ', &
+ 'given by the number of PEs'
+ PRINT*,' used'
+ PRINT*,' please use nx = ', nx - ( pdims(1) - ( nnx*pdims(1) &
+ - ( nx + 1 ) ) ), ' instead of nx =', nx
+ ENDIF
+ CALL local_stop
+ ENDIF
+ ENDIF
+
+!
+!-- South and north array bounds
+ DO j = 0, pdims(2)-1
+ nysf(j) = j * nny
+ nynf(j) = ( j + 1 ) * nny - 1
+ nny_pe(j) = MIN( ny, nynf(j) ) - nysf(j) + 1
+ ENDDO
+
+!
+!-- Local array bounds of the respective PEs
+ nxl = nxlf(pcoord(1))
+ nxra = nxrf(pcoord(1))
+ nxr = MIN( nx, nxra )
+ nys = nysf(pcoord(2))
+ nyna = nynf(pcoord(2))
+ nyn = MIN( ny, nyna )
+ nzb = 0
+ nzta = nza
+ nzt = MIN( nz, nzta )
+ nnz = nza
+
+!
+!-- Calculate array bounds and gridpoint numbers for the transposed arrays
+!-- (needed in the pressure solver)
+!-- For the transposed arrays, cyclic boundaries as well as top and bottom
+!-- boundaries are omitted, because they are obstructive to the transposition
+
+!
+!-- 1. transposition z --> x
+!-- This transposition is not neccessary in case of a 1d-decomposition along x,
+!-- except that the uptream-spline method is switched on
+ IF ( pdims(2) /= 1 .OR. momentum_advec == 'ups-scheme' .OR. &
+ scalar_advec == 'ups-scheme' ) THEN
+
+ IF ( pdims(2) == 1 .AND. ( momentum_advec == 'ups-scheme' .OR. &
+ scalar_advec == 'ups-scheme' ) ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ WARNING: init_pegrid: 1d-decomposition along x ', &
+ &'chosen but nz restrictions may occur'
+ PRINT*,' since ups-scheme is activated'
+ ENDIF
+ ENDIF
+ nys_x = nys
+ nyn_xa = nyna
+ nyn_x = nyn
+ nny_x = nny
+ IF ( MOD( nza , pdims(1) ) /= 0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ transposition z --> x:'
+ PRINT*,' nz=',nz,' is not an integral divisior of pdims(1)=', &
+ &pdims(1)
+ ENDIF
+ CALL local_stop
+ ENDIF
+ nnz_x = nza / pdims(1)
+ nzb_x = 1 + myidx * nnz_x
+ nzt_xa = ( myidx + 1 ) * nnz_x
+ nzt_x = MIN( nzt, nzt_xa )
+
+ sendrecvcount_zx = nnx * nny * nnz_x
+
+ ENDIF
+
+!
+!-- 2. transposition x --> y
+ nnz_y = nnz_x
+ nzb_y = nzb_x
+ nzt_ya = nzt_xa
+ nzt_y = nzt_x
+ IF ( MOD( nxa+1 , pdims(2) ) /= 0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ transposition x --> y:'
+ PRINT*,' nx+1=',nx+1,' is not an integral divisor of ',&
+ &'pdims(2)=',pdims(2)
+ ENDIF
+ CALL local_stop
+ ENDIF
+ nnx_y = (nxa+1) / pdims(2)
+ nxl_y = myidy * nnx_y
+ nxr_ya = ( myidy + 1 ) * nnx_y - 1
+ nxr_y = MIN( nx, nxr_ya )
+
+ sendrecvcount_xy = nnx_y * nny_x * nnz_y
+
+!
+!-- 3. transposition y --> z (ELSE: x --> y in case of 1D-decomposition
+!-- along x)
+ IF ( pdims(2) /= 1 .OR. momentum_advec == 'ups-scheme' .OR. &
+ scalar_advec == 'ups-scheme' ) THEN
+!
+!-- y --> z
+!-- This transposition is not neccessary in case of a 1d-decomposition
+!-- along x, except that the uptream-spline method is switched on
+ nnx_z = nnx_y
+ nxl_z = nxl_y
+ nxr_za = nxr_ya
+ nxr_z = nxr_y
+ IF ( MOD( nya+1 , pdims(1) ) /= 0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ Transposition y --> z:'
+ PRINT*,' ny+1=',ny+1,' is not an integral divisor of ',&
+ &'pdims(1)=',pdims(1)
+ ENDIF
+ CALL local_stop
+ ENDIF
+ nny_z = (nya+1) / pdims(1)
+ nys_z = myidx * nny_z
+ nyn_za = ( myidx + 1 ) * nny_z - 1
+ nyn_z = MIN( ny, nyn_za )
+
+ sendrecvcount_yz = nnx_y * nny_z * nnz_y
+
+ ELSE
+!
+!-- x --> y. This condition must be fulfilled for a 1D-decomposition along x
+ IF ( MOD( nya+1 , pdims(1) ) /= 0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ Transposition x --> y:'
+ PRINT*,' ny+1=',ny+1,' is not an integral divisor of ',&
+ &'pdims(1)=',pdims(1)
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ ENDIF
+
+!
+!-- Indices for direct transpositions z --> y (used for calculating spectra)
+ IF ( dt_dosp /= 9999999.9 ) THEN
+ IF ( MOD( nza, pdims(2) ) /= 0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ Direct transposition z --> y (needed for spectra):'
+ PRINT*,' nz=',nz,' is not an integral divisor of ',&
+ &'pdims(2)=',pdims(2)
+ ENDIF
+ CALL local_stop
+ ELSE
+ nxl_yd = nxl
+ nxr_yda = nxra
+ nxr_yd = nxr
+ nzb_yd = 1 + myidy * ( nza / pdims(2) )
+ nzt_yda = ( myidy + 1 ) * ( nza / pdims(2) )
+ nzt_yd = MIN( nzt, nzt_yda )
+
+ sendrecvcount_zyd = nnx * nny * ( nza / pdims(2) )
+ ENDIF
+ ENDIF
+
+!
+!-- Indices for direct transpositions y --> x (they are only possible in case
+!-- of a 1d-decomposition along x)
+ IF ( pdims(2) == 1 ) THEN
+ nny_x = nny / pdims(1)
+ nys_x = myid * nny_x
+ nyn_xa = ( myid + 1 ) * nny_x - 1
+ nyn_x = MIN( ny, nyn_xa )
+ nzb_x = 1
+ nzt_xa = nza
+ nzt_x = nz
+ sendrecvcount_xy = nnx * nny_x * nza
+ ENDIF
+
+!
+!-- Indices for direct transpositions x --> y (they are only possible in case
+!-- of a 1d-decomposition along y)
+ IF ( pdims(1) == 1 ) THEN
+ nnx_y = nnx / pdims(2)
+ nxl_y = myid * nnx_y
+ nxr_ya = ( myid + 1 ) * nnx_y - 1
+ nxr_y = MIN( nx, nxr_ya )
+ nzb_y = 1
+ nzt_ya = nza
+ nzt_y = nz
+ sendrecvcount_xy = nnx_y * nny * nza
+ ENDIF
+
+!
+!-- Arrays for storing the array bounds are needed any more
+ DEALLOCATE( nxlf , nxrf , nynf , nysf )
+
+#if defined( __print )
+!
+!-- Control output
+ IF ( myid == 0 ) THEN
+ PRINT*, '*** processor topology ***'
+ PRINT*, ' '
+ PRINT*, 'myid pcoord left right south north idx idy nxl: nxr',&
+ &' nys: nyn'
+ PRINT*, '------------------------------------------------------------',&
+ &'-----------'
+ WRITE (*,1000) 0, pcoord(1), pcoord(2), pleft, pright, psouth, pnorth, &
+ myidx, myidy, nxl, nxr, nys, nyn
+1000 FORMAT (I4,2X,'(',I3,',',I3,')',3X,I4,2X,I4,3X,I4,2X,I4,2X,I3,1X,I3, &
+ 2(2X,I4,':',I4))
+
+!
+!-- Receive data from the other PEs
+ DO i = 1,numprocs-1
+ CALL MPI_RECV( ibuf, 12, MPI_INTEGER, i, MPI_ANY_TAG, comm2d, status, &
+ ierr )
+ WRITE (*,1000) i, ( ibuf(j) , j = 1,12 )
+ ENDDO
+ ELSE
+
+!
+!-- Send data to PE0
+ ibuf(1) = pcoord(1); ibuf(2) = pcoord(2); ibuf(3) = pleft
+ ibuf(4) = pright; ibuf(5) = psouth; ibuf(6) = pnorth; ibuf(7) = myidx
+ ibuf(8) = myidy; ibuf(9) = nxl; ibuf(10) = nxr; ibuf(11) = nys
+ ibuf(12) = nyn
+ CALL MPI_SEND( ibuf, 12, MPI_INTEGER, 0, myid, comm2d, ierr )
+ ENDIF
+#endif
+
+#if defined( __mpi2 )
+!
+!-- In case of coupled runs, get the port name on PE0 of the atmosphere model
+!-- and pass it to PE0 of the ocean model
+ IF ( myid == 0 ) THEN
+
+ IF ( coupling_mode == 'atmosphere_to_ocean' ) THEN
+
+ CALL MPI_OPEN_PORT( MPI_INFO_NULL, port_name, ierr )
+!
+!-- TEST OUTPUT (TO BE REMOVED)
+ WRITE(9,*) TRIM( coupling_mode ), &
+ ', ierr after MPI_OPEN_PORT: ', ierr
+ CALL LOCAL_FLUSH( 9 )
+
+ CALL MPI_PUBLISH_NAME( 'palm_coupler', MPI_INFO_NULL, port_name, &
+ ierr )
+!
+!-- TEST OUTPUT (TO BE REMOVED)
+ WRITE(9,*) TRIM( coupling_mode ), &
+ ', ierr after MPI_PUBLISH_NAME: ', ierr
+ CALL LOCAL_FLUSH( 9 )
+
+!
+!-- Write a flag file for the ocean model and the other atmosphere
+!-- processes.
+!-- There seems to be a bug in MPICH2 which causes hanging processes
+!-- in case that execution of LOOKUP_NAME is continued too early
+!-- (i.e. before the port has been created)
+ OPEN( 90, FILE='COUPLING_PORT_OPENED', FORM='FORMATTED' )
+ WRITE ( 90, '(''TRUE'')' )
+ CLOSE ( 90 )
+
+ ELSEIF ( coupling_mode == 'ocean_to_atmosphere' ) THEN
+
+!
+!-- Continue only if the atmosphere model has created the port.
+!-- There seems to be a bug in MPICH2 which causes hanging processes
+!-- in case that execution of LOOKUP_NAME is continued too early
+!-- (i.e. before the port has been created)
+ INQUIRE( FILE='COUPLING_PORT_OPENED', EXIST=found )
+ DO WHILE ( .NOT. found )
+ INQUIRE( FILE='COUPLING_PORT_OPENED', EXIST=found )
+ ENDDO
+
+ CALL MPI_LOOKUP_NAME( 'palm_coupler', MPI_INFO_NULL, port_name, ierr )
+!
+!-- TEST OUTPUT (TO BE REMOVED)
+ WRITE(9,*) TRIM( coupling_mode ), &
+ ', ierr after MPI_LOOKUP_NAME: ', ierr
+ CALL LOCAL_FLUSH( 9 )
+
+
+ ENDIF
+
+ ENDIF
+
+!
+!-- In case of coupled runs, establish the connection between the atmosphere
+!-- and the ocean model and define the intercommunicator (comm_inter)
+ CALL MPI_BARRIER( comm2d, ierr )
+ IF ( coupling_mode == 'atmosphere_to_ocean' ) THEN
+
+ print*, '... before COMM_ACCEPT'
+ CALL MPI_COMM_ACCEPT( port_name, MPI_INFO_NULL, 0, MPI_COMM_WORLD, &
+ comm_inter, ierr )
+ print*, '--- ierr = ', ierr
+ print*, '--- comm_inter atmosphere = ', comm_inter
+
+ coupling_mode_remote = 'ocean_to_atmosphere'
+
+ ELSEIF ( coupling_mode == 'ocean_to_atmosphere' ) THEN
+
+ IF ( myid == 0 ) PRINT*, '*** read: ', port_name, ' ierr = ', ierr
+ print*, '... before COMM_CONNECT'
+ CALL MPI_COMM_CONNECT( port_name, MPI_INFO_NULL, 0, MPI_COMM_WORLD, &
+ comm_inter, ierr )
+ print*, '--- ierr = ', ierr
+ print*, '--- comm_inter ocean = ', comm_inter
+
+ coupling_mode_remote = 'atmosphere_to_ocean'
+
+ ENDIF
+
+!
+!-- In case of coupled runs, create a new MPI derived datatype for the
+!-- exchange of surface (xy) data .
+!-- Gridpoint number for the exchange of ghost points (xy-plane)
+ ngp_xy = ( nxr - nxl + 3 ) * ( nyn - nys + 3 )
+
+!
+!-- Define a new MPI derived datatype for the exchange of ghost points in
+!-- y-direction for 2D-arrays (line)
+ CALL MPI_TYPE_VECTOR( ngp_xy, 1, nzt-nzb+2, MPI_REAL, type_xy, ierr )
+ CALL MPI_TYPE_COMMIT( type_xy, ierr )
+#endif
+
+#else
+
+!
+!-- Array bounds when running on a single PE (respectively a non-parallel
+!-- machine)
+ nxl = 0
+ nxr = nx
+ nxra = nx
+ nnx = nxr - nxl + 1
+ nys = 0
+ nyn = ny
+ nyna = ny
+ nny = nyn - nys + 1
+ nzb = 0
+ nzt = nz
+ nzta = nz
+ nnz = nz
+
+!
+!-- Array bounds for the pressure solver (in the parallel code, these bounds
+!-- are the ones for the transposed arrays)
+ nys_x = nys
+ nyn_x = nyn
+ nyn_xa = nyn
+ nzb_x = nzb + 1
+ nzt_x = nzt
+ nzt_xa = nzt
+
+ nxl_y = nxl
+ nxr_y = nxr
+ nxr_ya = nxr
+ nzb_y = nzb + 1
+ nzt_y = nzt
+ nzt_ya = nzt
+
+ nxl_z = nxl
+ nxr_z = nxr
+ nxr_za = nxr
+ nys_z = nys
+ nyn_z = nyn
+ nyn_za = nyn
+
+#endif
+
+!
+!-- Calculate number of grid levels necessary for the multigrid poisson solver
+!-- as well as the gridpoint indices on each level
+ IF ( psolver == 'multigrid' ) THEN
+
+!
+!-- First calculate number of possible grid levels for the subdomains
+ mg_levels_x = 1
+ mg_levels_y = 1
+ mg_levels_z = 1
+
+ i = nnx
+ DO WHILE ( MOD( i, 2 ) == 0 .AND. i /= 2 )
+ i = i / 2
+ mg_levels_x = mg_levels_x + 1
+ ENDDO
+
+ j = nny
+ DO WHILE ( MOD( j, 2 ) == 0 .AND. j /= 2 )
+ j = j / 2
+ mg_levels_y = mg_levels_y + 1
+ ENDDO
+
+ k = nnz
+ DO WHILE ( MOD( k, 2 ) == 0 .AND. k /= 2 )
+ k = k / 2
+ mg_levels_z = mg_levels_z + 1
+ ENDDO
+
+ maximum_grid_level = MIN( mg_levels_x, mg_levels_y, mg_levels_z )
+
+!
+!-- Find out, if the total domain allows more levels. These additional
+!-- levels are processed on PE0 only.
+ IF ( numprocs > 1 ) THEN
+ IF ( mg_levels_z > MIN( mg_levels_x, mg_levels_y ) ) THEN
+ mg_switch_to_pe0_level_l = maximum_grid_level
+
+ mg_levels_x = 1
+ mg_levels_y = 1
+
+ i = nx+1
+ DO WHILE ( MOD( i, 2 ) == 0 .AND. i /= 2 )
+ i = i / 2
+ mg_levels_x = mg_levels_x + 1
+ ENDDO
+
+ j = ny+1
+ DO WHILE ( MOD( j, 2 ) == 0 .AND. j /= 2 )
+ j = j / 2
+ mg_levels_y = mg_levels_y + 1
+ ENDDO
+
+ maximum_grid_level_l = MIN( mg_levels_x, mg_levels_y, mg_levels_z )
+
+ IF ( maximum_grid_level_l > mg_switch_to_pe0_level_l ) THEN
+ mg_switch_to_pe0_level_l = maximum_grid_level_l - &
+ mg_switch_to_pe0_level_l + 1
+ ELSE
+ mg_switch_to_pe0_level_l = 0
+ ENDIF
+ ELSE
+ mg_switch_to_pe0_level_l = 0
+ maximum_grid_level_l = maximum_grid_level
+ ENDIF
+
+!
+!-- Use switch level calculated above only if it is not pre-defined
+!-- by user
+ IF ( mg_switch_to_pe0_level == 0 ) THEN
+
+ IF ( mg_switch_to_pe0_level_l /= 0 ) THEN
+ mg_switch_to_pe0_level = mg_switch_to_pe0_level_l
+ maximum_grid_level = maximum_grid_level_l
+ ENDIF
+
+ ELSE
+!
+!-- Check pre-defined value and reset to default, if neccessary
+ IF ( mg_switch_to_pe0_level < mg_switch_to_pe0_level_l .OR. &
+ mg_switch_to_pe0_level >= maximum_grid_level_l ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ WARNING init_pegrid: mg_switch_to_pe0_level ', &
+ 'out of range and reset to default (=0)'
+ ENDIF
+ mg_switch_to_pe0_level = 0
+ ELSE
+!
+!-- Use the largest number of possible levels anyway and recalculate
+!-- the switch level to this largest number of possible values
+ maximum_grid_level = maximum_grid_level_l
+
+ ENDIF
+ ENDIF
+
+ ENDIF
+
+ ALLOCATE( grid_level_count(maximum_grid_level), &
+ nxl_mg(maximum_grid_level), nxr_mg(maximum_grid_level), &
+ nyn_mg(maximum_grid_level), nys_mg(maximum_grid_level), &
+ nzt_mg(maximum_grid_level) )
+
+ grid_level_count = 0
+ nxl_l = nxl; nxr_l = nxr; nys_l = nys; nyn_l = nyn; nzt_l = nzt
+
+ DO i = maximum_grid_level, 1 , -1
+
+ IF ( i == mg_switch_to_pe0_level ) THEN
+#if defined( __parallel )
+!
+!-- Save the grid size of the subdomain at the switch level, because
+!-- it is needed in poismg.
+!-- Array bounds of the local subdomain grids are gathered on PE0
+ ind(1) = nxl_l; ind(2) = nxr_l
+ ind(3) = nys_l; ind(4) = nyn_l
+ ind(5) = nzt_l
+ ALLOCATE( ind_all(5*numprocs), mg_loc_ind(5,0:numprocs-1) )
+ CALL MPI_ALLGATHER( ind, 5, MPI_INTEGER, ind_all, 5, &
+ MPI_INTEGER, comm2d, ierr )
+ DO j = 0, numprocs-1
+ DO k = 1, 5
+ mg_loc_ind(k,j) = ind_all(k+j*5)
+ ENDDO
+ ENDDO
+ DEALLOCATE( ind_all )
+!
+!-- Calculate the grid size of the total domain gathered on PE0
+ nxr_l = ( nxr_l-nxl_l+1 ) * pdims(1) - 1
+ nxl_l = 0
+ nyn_l = ( nyn_l-nys_l+1 ) * pdims(2) - 1
+ nys_l = 0
+!
+!-- The size of this gathered array must not be larger than the
+!-- array tend, which is used in the multigrid scheme as a temporary
+!-- array
+ subdomain_size = ( nxr - nxl + 3 ) * ( nyn - nys + 3 ) * &
+ ( nzt - nzb + 2 )
+ gathered_size = ( nxr_l - nxl_l + 3 ) * ( nyn_l - nys_l + 3 ) * &
+ ( nzt_l - nzb + 2 )
+
+ IF ( gathered_size > subdomain_size ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ init_pegrid: not enough memory for storing ', &
+ 'gathered multigrid data on PE0'
+ ENDIF
+ CALL local_stop
+ ENDIF
+#else
+ PRINT*, '+++ init_pegrid: multigrid gather/scatter impossible ', &
+ 'in non parallel mode'
+ CALL local_stop
+#endif
+ ENDIF
+
+ nxl_mg(i) = nxl_l
+ nxr_mg(i) = nxr_l
+ nys_mg(i) = nys_l
+ nyn_mg(i) = nyn_l
+ nzt_mg(i) = nzt_l
+
+ nxl_l = nxl_l / 2
+ nxr_l = nxr_l / 2
+ nys_l = nys_l / 2
+ nyn_l = nyn_l / 2
+ nzt_l = nzt_l / 2
+ ENDDO
+
+ ELSE
+
+ maximum_grid_level = 1
+
+ ENDIF
+
+ grid_level = maximum_grid_level
+
+#if defined( __parallel )
+!
+!-- Gridpoint number for the exchange of ghost points (y-line for 2D-arrays)
+ ngp_y = nyn - nys + 1
+
+!
+!-- Define a new MPI derived datatype for the exchange of ghost points in
+!-- y-direction for 2D-arrays (line)
+ CALL MPI_TYPE_VECTOR( nxr-nxl+3, 1, ngp_y+2, MPI_REAL, type_x, ierr )
+ CALL MPI_TYPE_COMMIT( type_x, ierr )
+ CALL MPI_TYPE_VECTOR( nxr-nxl+3, 1, ngp_y+2, MPI_INTEGER, type_x_int, ierr )
+ CALL MPI_TYPE_COMMIT( type_x_int, ierr )
+
+!
+!-- Calculate gridpoint numbers for the exchange of ghost points along x
+!-- (yz-plane for 3D-arrays) and define MPI derived data type(s) for the
+!-- exchange of ghost points in y-direction (xz-plane).
+!-- Do these calculations for the model grid and (if necessary) also
+!-- for the coarser grid levels used in the multigrid method
+ ALLOCATE ( ngp_yz(maximum_grid_level), type_xz(maximum_grid_level) )
+
+ nxl_l = nxl; nxr_l = nxr; nys_l = nys; nyn_l = nyn; nzb_l = nzb; nzt_l = nzt
+
+ DO i = maximum_grid_level, 1 , -1
+ ngp_yz(i) = (nzt_l - nzb_l + 2) * (nyn_l - nys_l + 3)
+
+ CALL MPI_TYPE_VECTOR( nxr_l-nxl_l+3, nzt_l-nzb_l+2, ngp_yz(i), &
+ MPI_REAL, type_xz(i), ierr )
+ CALL MPI_TYPE_COMMIT( type_xz(i), ierr )
+
+ nxl_l = nxl_l / 2
+ nxr_l = nxr_l / 2
+ nys_l = nys_l / 2
+ nyn_l = nyn_l / 2
+ nzt_l = nzt_l / 2
+ ENDDO
+#endif
+
+#if defined( __parallel )
+!
+!-- Setting of flags for inflow/outflow conditions in case of non-cyclic
+!-- horizontal boundary conditions.
+ IF ( pleft == MPI_PROC_NULL ) THEN
+ IF ( bc_lr == 'dirichlet/radiation' ) THEN
+ inflow_l = .TRUE.
+ ELSEIF ( bc_lr == 'radiation/dirichlet' ) THEN
+ outflow_l = .TRUE.
+ ENDIF
+ ENDIF
+
+ IF ( pright == MPI_PROC_NULL ) THEN
+ IF ( bc_lr == 'dirichlet/radiation' ) THEN
+ outflow_r = .TRUE.
+ ELSEIF ( bc_lr == 'radiation/dirichlet' ) THEN
+ inflow_r = .TRUE.
+ ENDIF
+ ENDIF
+
+ IF ( psouth == MPI_PROC_NULL ) THEN
+ IF ( bc_ns == 'dirichlet/radiation' ) THEN
+ outflow_s = .TRUE.
+ ELSEIF ( bc_ns == 'radiation/dirichlet' ) THEN
+ inflow_s = .TRUE.
+ ENDIF
+ ENDIF
+
+ IF ( pnorth == MPI_PROC_NULL ) THEN
+ IF ( bc_ns == 'dirichlet/radiation' ) THEN
+ inflow_n = .TRUE.
+ ELSEIF ( bc_ns == 'radiation/dirichlet' ) THEN
+ outflow_n = .TRUE.
+ ENDIF
+ ENDIF
+
+#else
+ IF ( bc_lr == 'dirichlet/radiation' ) THEN
+ inflow_l = .TRUE.
+ outflow_r = .TRUE.
+ ELSEIF ( bc_lr == 'radiation/dirichlet' ) THEN
+ outflow_l = .TRUE.
+ inflow_r = .TRUE.
+ ENDIF
+
+ IF ( bc_ns == 'dirichlet/radiation' ) THEN
+ inflow_n = .TRUE.
+ outflow_s = .TRUE.
+ ELSEIF ( bc_ns == 'radiation/dirichlet' ) THEN
+ outflow_n = .TRUE.
+ inflow_s = .TRUE.
+ ENDIF
+#endif
+!
+!-- At the outflow, u or v, respectively, have to be calculated for one more
+!-- grid point.
+ IF ( outflow_l ) THEN
+ nxlu = nxl + 1
+ ELSE
+ nxlu = nxl
+ ENDIF
+ IF ( outflow_s ) THEN
+ nysv = nys + 1
+ ELSE
+ nysv = nys
+ ENDIF
+
+ IF ( psolver == 'poisfft_hybrid' ) THEN
+ CALL poisfft_hybrid_ini
+ ELSEIF ( psolver == 'poisfft' ) THEN
+ CALL poisfft_init
+ ENDIF
+
+!
+!-- Allocate wall flag arrays used in the multigrid solver
+ IF ( psolver == 'multigrid' ) THEN
+
+ DO i = maximum_grid_level, 1, -1
+
+ SELECT CASE ( i )
+
+ CASE ( 1 )
+ ALLOCATE( wall_flags_1(nzb:nzt_mg(i)+1, &
+ nys_mg(i)-1:nyn_mg(i)+1, &
+ nxl_mg(i)-1:nxr_mg(i)+1) )
+
+ CASE ( 2 )
+ ALLOCATE( wall_flags_2(nzb:nzt_mg(i)+1, &
+ nys_mg(i)-1:nyn_mg(i)+1, &
+ nxl_mg(i)-1:nxr_mg(i)+1) )
+
+ CASE ( 3 )
+ ALLOCATE( wall_flags_3(nzb:nzt_mg(i)+1, &
+ nys_mg(i)-1:nyn_mg(i)+1, &
+ nxl_mg(i)-1:nxr_mg(i)+1) )
+
+ CASE ( 4 )
+ ALLOCATE( wall_flags_4(nzb:nzt_mg(i)+1, &
+ nys_mg(i)-1:nyn_mg(i)+1, &
+ nxl_mg(i)-1:nxr_mg(i)+1) )
+
+ CASE ( 5 )
+ ALLOCATE( wall_flags_5(nzb:nzt_mg(i)+1, &
+ nys_mg(i)-1:nyn_mg(i)+1, &
+ nxl_mg(i)-1:nxr_mg(i)+1) )
+
+ CASE ( 6 )
+ ALLOCATE( wall_flags_6(nzb:nzt_mg(i)+1, &
+ nys_mg(i)-1:nyn_mg(i)+1, &
+ nxl_mg(i)-1:nxr_mg(i)+1) )
+
+ CASE ( 7 )
+ ALLOCATE( wall_flags_7(nzb:nzt_mg(i)+1, &
+ nys_mg(i)-1:nyn_mg(i)+1, &
+ nxl_mg(i)-1:nxr_mg(i)+1) )
+
+ CASE ( 8 )
+ ALLOCATE( wall_flags_8(nzb:nzt_mg(i)+1, &
+ nys_mg(i)-1:nyn_mg(i)+1, &
+ nxl_mg(i)-1:nxr_mg(i)+1) )
+
+ CASE ( 9 )
+ ALLOCATE( wall_flags_9(nzb:nzt_mg(i)+1, &
+ nys_mg(i)-1:nyn_mg(i)+1, &
+ nxl_mg(i)-1:nxr_mg(i)+1) )
+
+ CASE ( 10 )
+ ALLOCATE( wall_flags_10(nzb:nzt_mg(i)+1, &
+ nys_mg(i)-1:nyn_mg(i)+1, &
+ nxl_mg(i)-1:nxr_mg(i)+1) )
+
+ CASE DEFAULT
+ IF ( myid == 0 ) PRINT*, '+++ init_pegrid: more than 10 ', &
+ ' multigrid levels'
+ CALL local_stop
+
+ END SELECT
+
+ ENDDO
+
+ ENDIF
+
+ END SUBROUTINE init_pegrid
Index: /palm/tags/release-3.4a/SOURCE/init_pt_anomaly.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/init_pt_anomaly.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/init_pt_anomaly.f90 (revision 141)
@@ -0,0 +1,78 @@
+ SUBROUTINE init_pt_anomaly
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 75 2007-03-22 09:54:05Z raasch
+! 2nd+3rd argument removed from exchange horiz
+!
+! 19 2007-02-23 04:53:48Z raasch
+! Calculation extended for gridpoint nzt
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.7 2005/03/26 20:36:55 raasch
+! Arguments for non-cyclic boundary conditions added to argument list of
+! routine exchange_horiz
+!
+! Revision 1.1 1997/08/29 08:58:56 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Impose a temperature perturbation for an advection test.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE constants
+ USE grid_variables
+ USE indices
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ INTEGER :: i, ic, j, jc, k, kc
+ REAL :: betrag, radius, rc, x, y, z
+
+!
+!-- Defaults: radius rc, strength z,
+!-- position of centre: ic, jc, kc
+ rc = 10.0 * dx
+ ic = ( nx+1 ) / 2
+ jc = ic
+ kc = nzt / 2
+
+!
+!-- Compute the perturbation.
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ x = ( i - ic ) * dx
+ y = ( j - jc ) * dy
+ z = ABS( zu(k) - zu(kc) )
+ radius = SQRT( x**2 + y**2 + z**2 )
+ IF ( radius <= rc ) THEN
+ betrag = 5.0 * EXP( -( radius / 2.0 )**2 )
+ ELSE
+ betrag = 0.0
+ ENDIF
+
+ pt(k,j,i) = pt(k,j,i) + betrag
+
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Exchange of boundary values for temperature
+ CALL exchange_horiz( pt )
+
+
+ END SUBROUTINE init_pt_anomaly
Index: /palm/tags/release-3.4a/SOURCE/init_rankine.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/init_rankine.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/init_rankine.f90 (revision 141)
@@ -0,0 +1,158 @@
+ SUBROUTINE init_rankine
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 107 2007-08-17 13:54:45Z raasch
+! Initial profiles are reset to constant profiles
+!
+! 75 2007-03-22 09:54:05Z raasch
+! uxrp, vynp eliminated, 2nd+3rd argument removed from exchange horiz
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.11 2005/03/26 20:38:49 raasch
+! Arguments for non-cyclic boundary conditions added to argument list of
+! routine exchange_horiz
+!
+! Revision 1.1 1997/08/11 06:18:43 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Initialize a (nondivergent) Rankine eddy with a vertical axis in order to test
+! the advection terms and the pressure solver.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE constants
+ USE grid_variables
+ USE indices
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ INTEGER :: i, ic, j, jc, k, kc1, kc2
+ REAL :: alpha, betrag, radius, rc, uw, vw, x, y
+
+!
+!-- Default: eddy radius rc, eddy strength z,
+!-- position of eddy centre: ic, jc, kc1, kc2
+ rc = 4.0 * dx
+ ic = ( nx+1 ) / 2
+ jc = ic
+ kc1 = nzb
+ kc2 = nzt+1
+
+!
+!-- Reset initial profiles to constant profiles
+ IF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ pt(:,j,i) = pt_init
+ u(:,j,i) = u_init
+ v(:,j,i) = v_init
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Compute the u-component.
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ x = ( i - ic - 0.5 ) * dx
+ y = ( j - jc ) * dy
+ radius = SQRT( x**2 + y**2 )
+ IF ( radius <= 2.0 * rc ) THEN
+ betrag = radius / ( 2.0 * rc ) * 0.08
+ ELSEIF ( radius > 2.0 * rc .AND. radius < 8.0 * rc ) THEN
+ betrag = 0.08 * EXP( -( radius - 2.0 * rc ) / 2.0 )
+ ELSE
+ betrag = 0.0
+ ENDIF
+
+ IF ( x == 0.0 ) THEN
+ IF ( y > 0.0 ) THEN
+ alpha = pi / 2.0
+ ELSEIF ( y < 0.0 ) THEN
+ alpha = 3.0 * pi / 2.0
+ ENDIF
+ ELSE
+ IF ( x < 0.0 ) THEN
+ alpha = ATAN( y / x ) + pi
+ ELSE
+ IF ( y < 0.0 ) THEN
+ alpha = ATAN( y / x ) + 2.0 * pi
+ ELSE
+ alpha = ATAN( y / x )
+ ENDIF
+ ENDIF
+ ENDIF
+
+ uw = -SIN( alpha ) * betrag
+
+ DO k = kc1, kc2
+ u(k,j,i) = u(k,j,i) + uw
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Compute the v-component.
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ x = ( i - ic ) * dx
+ y = ( j - jc - 0.5) * dy
+ radius = SQRT( x**2 + y**2 )
+ IF ( radius <= 2.0 * rc ) THEN
+ betrag = radius / ( 2.0 * rc ) * 0.08
+ ELSEIF ( radius > 2.0 * rc .AND. radius < 8.0 * rc ) THEN
+ betrag = 0.08 * EXP( -( radius - 2.0 * rc ) / 2.0 )
+ ELSE
+ betrag = 0.0
+ ENDIF
+
+ IF ( x == 0.0 ) THEN
+ IF ( y > 0.0 ) THEN
+ alpha = pi / 2.0
+ ELSEIF ( y < 0.0 ) THEN
+ alpha = 3.0 * pi / 2.0
+ ENDIF
+ ELSE
+ IF ( x < 0.0 ) THEN
+ alpha = ATAN( y / x ) + pi
+ ELSE
+ IF ( y < 0.0 ) THEN
+ alpha = ATAN( y / x ) + 2.0 * pi
+ ELSE
+ alpha = ATAN( y / x )
+ ENDIF
+ ENDIF
+ ENDIF
+
+ vw = COS( alpha ) * betrag
+
+ DO k = kc1, kc2
+ v(k,j,i) = v(k,j,i) + vw
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Exchange of boundary values for the velocities.
+ CALL exchange_horiz( u )
+ CALL exchange_horiz( v )
+!
+!-- Make velocity field nondivergent.
+ n_sor = nsor_ini
+ CALL pres
+ n_sor = nsor
+
+ END SUBROUTINE init_rankine
Index: /palm/tags/release-3.4a/SOURCE/init_slope.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/init_slope.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/init_slope.f90 (revision 141)
@@ -0,0 +1,116 @@
+ SUBROUTINE init_slope
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.5 2006/02/23 12:35:34 raasch
+! nanz_2dh renamed ngp_2dh
+!
+! Revision 1.1 2000/04/27 07:06:24 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Initialization of the temperature field and other variables used in case
+! of a sloping surface.
+! Remember: when a sloping surface is used, only one constant temperature
+! gradient is allowed!
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE constants
+ USE grid_variables
+ USE indices
+ USE pegrid
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: alpha, height, pt_value, radius
+ REAL, DIMENSION(:), ALLOCATABLE :: pt_init_local
+
+!
+!-- Calculate reference temperature field needed for computing buoyancy
+ ALLOCATE( pt_slope_ref(nzb:nzt+1,nxl-1:nxr+1) )
+
+ DO i = nxl-1, nxr+1
+ DO k = nzb, nzt+1
+
+!
+!-- Compute height of grid-point relative to lower left corner of
+!-- the total domain.
+!-- First compute the distance between the actual grid point and the
+!-- lower left corner as well as the angle between the line connecting
+!-- these points and the bottom of the model.
+ IF ( k /= nzb ) THEN
+ radius = SQRT( ( i * dx )**2 + zu(k)**2 )
+ height = zu(k)
+ ELSE
+ radius = SQRT( ( i * dx )**2 )
+ height = 0.0
+ ENDIF
+ IF ( radius /= 0.0 ) THEN
+ alpha = ASIN( height / radius )
+ ELSE
+ alpha = 0.0
+ ENDIF
+!
+!-- Compute temperatures in the rotated coordinate system
+ alpha = alpha + alpha_surface / 180.0 * pi
+ pt_value = pt_surface + radius * SIN( alpha ) * &
+ pt_vertical_gradient(1) / 100.0
+ pt_slope_ref(k,i) = pt_value
+ ENDDO
+ ENDDO
+
+!
+!-- Temperature difference between left and right boundary of the total domain,
+!-- used for the cyclic boundary in x-direction
+ pt_slope_offset = (nx+1) * dx * sin_alpha_surface * &
+ pt_vertical_gradient(1) / 100.0
+
+
+!
+!-- Following action must only be executed for initial runs
+ IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
+!
+!-- Set initial temperature equal to the reference temperature field
+ DO j = nys-1, nyn+1
+ pt(:,j,:) = pt_slope_ref
+ ENDDO
+
+!
+!-- Recompute the mean initial temperature profile (mean along x-direction of
+!-- the rotated coordinate system)
+ ALLOCATE( pt_init_local(nzb:nzt+1) )
+ pt_init_local = 0.0
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb, nzt+1
+ pt_init_local(k) = pt_init_local(k) + pt(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( pt_init_local, pt_init, nzt+2-nzb, MPI_REAL, &
+ MPI_SUM, comm2d, ierr )
+#else
+ pt_init = pt_init_local
+#endif
+
+ pt_init = pt_init / ngp_2dh(0)
+ DEALLOCATE( pt_init_local )
+
+ ENDIF
+
+ END SUBROUTINE init_slope
Index: /palm/tags/release-3.4a/SOURCE/interaction_droplets_ptq.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/interaction_droplets_ptq.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/interaction_droplets_ptq.f90 (revision 141)
@@ -0,0 +1,87 @@
+ MODULE interaction_droplets_ptq_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.1 2005/06/26 19:57:47 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Release of latent heat and change of specific humidity due to condensation /
+! evaporation of droplets.
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC interaction_droplets_ptq
+
+ INTERFACE interaction_droplets_ptq
+ MODULE PROCEDURE interaction_droplets_ptq
+ MODULE PROCEDURE interaction_droplets_ptq_ij
+ END INTERFACE interaction_droplets_ptq
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE interaction_droplets_ptq
+
+ USE arrays_3d
+ USE cloud_parameters
+ USE control_parameters
+ USE indices
+
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_2d(j,i)+1, nzt
+ q_p(k,j,i) = q_p(k,j,i) - ql_c(k,j,i)
+ pt_p(k,j,i) = pt_p(k,j,i) + l_d_cp * ql_c(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE interaction_droplets_ptq
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE interaction_droplets_ptq_ij( i, j )
+
+ USE arrays_3d
+ USE cloud_parameters
+ USE control_parameters
+ USE indices
+
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+
+ DO k = nzb_2d(j,i)+1, nzt
+ q_p(k,j,i) = q_p(k,j,i) - ql_c(k,j,i)
+ pt_p(k,j,i) = pt_p(k,j,i) + l_d_cp * ql_c(k,j,i)
+ ENDDO
+
+ END SUBROUTINE interaction_droplets_ptq_ij
+
+ END MODULE interaction_droplets_ptq_mod
Index: /palm/tags/release-3.4a/SOURCE/local_flush.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/local_flush.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/local_flush.f90 (revision 141)
@@ -0,0 +1,27 @@
+ SUBROUTINE local_flush( file_id )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! Initial revision (raasch 12/04/07)
+!
+!
+! Description:
+! ------------
+! Flush calls for different operating systems
+!------------------------------------------------------------------------------!
+
+ INTEGER :: file_id
+
+#if defined( __ibm )
+ CALL FLUSH_( file_id )
+#elif defined( __lc ) || defined( __nec )
+ CALL FLUSH( file_id )
+#endif
+
+ END SUBROUTINE local_flush
Index: /palm/tags/release-3.4a/SOURCE/local_getenv.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/local_getenv.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/local_getenv.f90 (revision 141)
@@ -0,0 +1,55 @@
+ SUBROUTINE local_getenv( var, ivar, value, ivalue )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 82 2007-04-16 15:40:52Z raasch
+! Preprocessor directives for old systems removed
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.5 2003/05/09 14:37:07 raasch
+! On the MUK cluster, only PE0 is able to read environment variables.
+! Therefore, they have to be communicated via broadcast to the other PEs.
+!
+! Revision 1.1 1997/08/11 06:21:01 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Getting the values of environment-variabls (for different operating-systems)
+!------------------------------------------------------------------------------!
+
+#if defined( __lcmuk )
+ USE pegrid
+#endif
+ CHARACTER (LEN=*) :: var, value
+ INTEGER :: ivalue, ivar
+#if defined( __lcmuk )
+ INTEGER :: i, ia(20)
+#endif
+
+ CALL GETENV( var(1:ivar), value )
+ ivalue = LEN_TRIM( value )
+
+#if defined( __lcmuk ) && defined( __parallel )
+ ia = IACHAR( ' ' )
+ IF ( myid == 0 ) THEN
+ DO i = 1, ivalue
+ ia(i) = IACHAR( value(i:i) )
+ ENDDO
+ ENDIF
+ CALL MPI_BCAST( ia(1), 20, MPI_INTEGER, 0, comm2d, ierr )
+ DO i = 1, 20
+ IF ( ACHAR( ia(i) ) /= ' ' ) value(i:i) = ACHAR( ia(i) )
+ ENDDO
+ ivalue = LEN_TRIM( value )
+#endif
+ END SUBROUTINE local_getenv
Index: /palm/tags/release-3.4a/SOURCE/local_stop.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/local_stop.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/local_stop.f90 (revision 141)
@@ -0,0 +1,115 @@
+ SUBROUTINE local_stop
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 108 2007-08-24 15:10:38Z letzel
+! modifications to terminate coupled runs
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.2 2003/03/16 09:40:28 raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.1 2002/12/19 15:46:23 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Stop program execution
+!------------------------------------------------------------------------------!
+
+ USE pegrid
+ USE control_parameters
+
+#if defined( __parallel )
+ IF ( coupling_mode == 'uncoupled' ) THEN
+ CALL MPI_FINALIZE( ierr )
+ ELSE
+
+ SELECT CASE ( terminate_coupled_remote )
+
+ CASE ( 0 )
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ local_stop:'
+ PRINT*, ' local model "', TRIM( coupling_mode ), &
+ '" stops now'
+ ENDIF
+!
+!-- Inform the remote model of the termination and its reason, provided
+!-- the remote model has not already been informed of another
+!-- termination reason (terminate_coupled > 0) before.
+ IF ( terminate_coupled == 0 ) THEN
+ terminate_coupled = 1
+ CALL MPI_SENDRECV( &
+ terminate_coupled, 1, MPI_INTEGER, myid, 0, &
+ terminate_coupled_remote, 1, MPI_INTEGER, myid, 0, &
+ comm_inter, status, ierr )
+ ENDIF
+ CALL MPI_FINALIZE( ierr )
+
+ CASE ( 1 )
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ local_stop:'
+ PRINT*, ' remote model "', TRIM( coupling_mode_remote ), &
+ '" stopped'
+ ENDIF
+ CALL MPI_FINALIZE( ierr )
+
+ CASE ( 2 )
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ local_stop:'
+ PRINT*, ' remote model "', TRIM( coupling_mode_remote ), &
+ '" terminated'
+ PRINT*, ' with stop_dt = .T.'
+ ENDIF
+ stop_dt = .TRUE.
+
+ CASE ( 3 )
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ local_stop:'
+ PRINT*, ' remote model "', TRIM( coupling_mode_remote ), &
+ '" terminated'
+ PRINT*, ' with terminate_run = .T. (CPU-time limit)'
+ ENDIF
+ terminate_run = .TRUE.
+
+ CASE ( 4 )
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ local_stop:'
+ PRINT*, ' remote model "', TRIM( coupling_mode_remote ), &
+ '" terminated'
+ PRINT*, ' with terminate_run = .T. (restart)'
+ ENDIF
+ terminate_run = .TRUE.
+ time_restart = time_restart + dt_restart
+
+ CASE ( 5 )
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ local_stop:'
+ PRINT*, ' remote model "', TRIM( coupling_mode_remote ), &
+ '" terminated'
+ PRINT*, ' with terminate_run = .T. (single restart)'
+ ENDIF
+ terminate_run = .TRUE.
+ time_restart = 9999999.9
+
+ END SELECT
+
+ ENDIF
+
+#else
+
+ STOP
+
+#endif
+
+ END SUBROUTINE local_stop
Index: /palm/tags/release-3.4a/SOURCE/local_system.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/local_system.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/local_system.f90 (revision 141)
@@ -0,0 +1,33 @@
+ SUBROUTINE local_system( command )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 82 2007-04-16 15:40:52Z raasch
+! Preprocessor directives for old systems removed
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.4 2003/03/16 09:40:33 raasch
+! Two underscores (_) are placed in front of all define-strings
+!
+! Revision 1.1 1997/09/03 06:27:27 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! System calls for different operating systems
+!------------------------------------------------------------------------------!
+
+ CHARACTER (LEN=*) :: command
+
+ CALL SYSTEM( command )
+
+ END SUBROUTINE local_system
Index: /palm/tags/release-3.4a/SOURCE/local_tremain.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/local_tremain.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/local_tremain.f90 (revision 141)
@@ -0,0 +1,71 @@
+ SUBROUTINE local_tremain( remaining_time )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 82 2007-04-16 15:40:52Z raasch
+! Preprocessor strings for different linux clusters changed to "lc",
+! preprocessor directives for old systems removed
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.14 2006/06/02 15:20:33 raasch
+! Extended to TIT Sun Fire X4600 System (lctit)
+!
+! Revision 1.1 1998/03/18 20:14:47 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! For different operating systems get the remaining cpu-time of the job
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+ USE pegrid
+
+ IMPLICIT NONE
+
+ REAL :: remaining_time
+#if defined( __ibm )
+ INTEGER(8) :: IRTC
+ REAL :: actual_wallclock_time
+#elif defined( __lc )
+ INTEGER :: count, count_rate
+ REAL :: actual_wallclock_time
+#endif
+
+#if defined( __ibm )
+
+ actual_wallclock_time = IRTC( ) * 1E-9
+ remaining_time = maximum_cpu_time_allowed - &
+ ( actual_wallclock_time - initial_wallclock_time )
+
+#elif defined( __lc )
+
+ CALL SYSTEM_CLOCK( count, count_rate )
+ actual_wallclock_time = REAL( count ) / REAL( count_rate )
+ remaining_time = maximum_cpu_time_allowed - &
+ ( actual_wallclock_time - initial_wallclock_time )
+
+#elif defined( __nec )
+
+ CALL TREMAIN( remaining_time )
+ remaining_time = remaining_time / tasks_per_node
+
+#else
+
+!
+!-- No stop due to running out of cpu-time on other machines
+ remaining_time = 9999999.9
+
+#endif
+
+ END SUBROUTINE local_tremain
Index: /palm/tags/release-3.4a/SOURCE/local_tremain_ini.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/local_tremain_ini.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/local_tremain_ini.f90 (revision 141)
@@ -0,0 +1,63 @@
+ SUBROUTINE local_tremain_ini
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 82 2007-04-16 15:40:52Z raasch
+! Cpp-directive lctit renamed lc
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.13 2007/02/11 13:07:03 raasch
+! Allowed cpu limit is now read from file instead of reading the value from
+! environment variable (see routine parin)
+!
+! Revision 1.1 1998/03/18 20:15:05 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Initialization of CPU-time measurements for different operating systems
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+
+ IMPLICIT NONE
+
+#if defined( __ibm )
+ CHARACTER (LEN=10) :: value_chr
+ INTEGER :: idum
+ INTEGER(8) :: IRTC
+#elif defined( __lc )
+ CHARACTER (LEN=10) :: value_chr
+ INTEGER :: idum
+ INTEGER :: count, count_rate
+#endif
+
+
+!
+!-- Get initial wall clock time
+#if defined( __ibm )
+
+ initial_wallclock_time = IRTC( ) * 1E-9
+
+#elif defined( __lc )
+
+ CALL SYSTEM_CLOCK( count, count_rate )
+ initial_wallclock_time = REAL( count ) / REAL( count_rate )
+
+#else
+!
+!-- So far, nothing is done on these machines
+#endif
+
+
+ END SUBROUTINE local_tremain_ini
Index: /palm/tags/release-3.4a/SOURCE/modules.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/modules.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/modules.f90 (revision 141)
@@ -0,0 +1,1157 @@
+ MODULE advection
+
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 138 2007-11-28 10:03:58Z letzel
+! +drag_coefficient, pch_index, lad_surface, lad_vertical_gradient,
+! lad_vertical_gradient_level, plant_canopy, lad, lad_s, lad_u, lad_v,
+! lad_w, cdc, lad_vertical_gradient_level_ind, canopy_mode
+! +dt_sort_particles, ngp_2dh_s_inner, time_sort_particles, flags,
+! wall_flags_1..10, wall_humidityflux(0:4), wall_qflux(0:4),
+! wall_salinityflux(0:4), wall_scalarflux(0:4)
+!
+! 108 2007-08-24 15:10:38Z letzel
+! +comm_inter, constant_top_momentumflux, coupling_char, coupling_mode,
+! coupling_mode_remote, c_u, c_v, c_w, dt_coupling, e_init, humidity_remote,
+! ngp_xy, nxlu, nysv, port_name, qswst_remote, terminate_coupled,
+! terminate_coupled_remote, time_coupling, top_momentumflux_u|v, type_xy,
+! uswst*, vswst*
+!
+! 97 2007-06-21 08:23:15Z raasch
+! +atmos_ocean_sign, ocean, r, + salinity variables
+! defaults of .._vertical_gradient_levels changed from -1.0 to -9999999.9
+! hydro_press renamed hyp, use_pt_reference renamed use_reference
+!
+! 89 2007-05-25 12:08:31Z raasch
+! +data_output_pr_user, max_pr_user, size of data_output_pr, dopr_index,
+! dopr_initial_index and dopr_unit enlarged,
+! var_hom and var_sum renamed pr_palm
+!
+! 82 2007-04-16 15:40:52Z raasch
+! +return_addres, return_username
+! Cpp-directive lcmuk renamed lc
+!
+! 75 2007-03-22 09:54:05Z raasch
+! +arrays precipitation_amount, precipitation_rate, precipitation_rate_av,
+! rif_wall, z0_av, +arrays u_m_l, u_m_r, etc. for radiation boundary conditions,
+! +loop_optimization, netcdf_64bit_3d, zu_s_inner, zw_w_inner, id_var_zusi_*,
+! id_var_zwwi_*, ts_value, u_nzb_p1_for_vfc, v_nzb_p1_for_vfc, pt_reference,
+! use_pt_reference, precipitation_amount_interval, revision
+! +age_m in particle_type, moisture renamed humidity,
+! -data_output_ts, dots_n, uvmean_outflow, uxrp, vynp,
+! arrays dots_label and dots_unit now dimensioned with dots_max,
+! setting of palm version moved to main program
+!
+! 37 2007-03-01 08:33:54Z raasch
+! +constant_top_heatflux, top_heatflux, use_top_fluxes, +arrays for top fluxes,
+! +nzt_diff, default of bc_pt_t renamed "initial_gradient"
+! Bugfix: p is not a pointer
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.95 2007/02/11 13:18:30 raasch
+! version 3.1b (last under RCS control)
+!
+! Revision 1.1 1997/07/24 11:21:26 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Definition of variables for special advection schemes
+!------------------------------------------------------------------------------!
+
+ REAL :: spl_gamma_x, spl_gamma_y
+
+ REAL, DIMENSION(:), ALLOCATABLE :: aex, bex, dex, eex, spl_z_x, spl_z_y
+ REAL, DIMENSION(:,:), ALLOCATABLE :: spl_tri_x, spl_tri_y, spl_tri_zu, &
+ spl_tri_zw
+
+ SAVE
+
+ END MODULE advection
+
+
+
+
+ MODULE array_kind
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of type parameters (used for the definition of single or double
+! precision variables)
+!------------------------------------------------------------------------------!
+
+ INTEGER, PARAMETER :: dpk = SELECTED_REAL_KIND( 12 ), &
+ spk = SELECTED_REAL_KIND( 6 )
+
+ SAVE
+
+ END MODULE array_kind
+
+
+
+
+ MODULE arrays_3d
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of all arrays defined on the computational grid
+!------------------------------------------------------------------------------!
+
+ USE array_kind
+
+ REAL, DIMENSION(:), ALLOCATABLE :: &
+ ddzu, dd2zu, dzu, ddzw, dzw, hyp, km_damp_x, km_damp_y, lad, l_grid, &
+ pt_init, q_init, rdf, sa_init, ug, u_init, u_nzb_p1_for_vfc, vg, &
+ v_init, v_nzb_p1_for_vfc, zu, zw
+
+ REAL, DIMENSION(:,:), ALLOCATABLE :: &
+ c_u, c_v, c_w, dzu_mg, dzw_mg, f1_mg, f2_mg, f3_mg, pt_slope_ref, &
+ qs, qswst_remote, ts, us, z0
+
+ REAL, DIMENSION(:,:), ALLOCATABLE, TARGET :: &
+ qsws_1, qsws_2, qswst_1, qswst_2, rif_1, rif_2, saswsb_1, saswst_1, &
+ shf_1, shf_2, tswst_1, tswst_2, usws_1, usws_2, uswst_1, uswst_2, &
+ vsws_1, vsws_2, vswst_1, vswst_2
+
+ REAL, DIMENSION(:,:), POINTER :: &
+ qsws, qsws_m, qswst, qswst_m, rif, rif_m, saswsb, saswst, shf, &
+ shf_m, tswst, tswst_m, usws, uswst, usws_m, uswst_m, vsws, vswst, &
+ vsws_m, vswst_m
+
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: &
+ cdc, d, diss, lad_s, lad_u, lad_v, lad_w, l_wall, tend, &
+ u_m_l, u_m_n, u_m_r, u_m_s, v_m_l, v_m_n, v_m_r, v_m_s, w_m_l, &
+ w_m_n, w_m_r, w_m_s
+
+ REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: &
+ ql_v, ql_vp
+
+ REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: &
+ e_1, e_2, e_3, kh_1, kh_2, km_1, km_2, p, pt_1, pt_2, pt_3, q_1, &
+ q_2, q_3, ql_1, ql_2, rho_1, sa_1, sa_2, sa_3, u_1, u_2, u_3, v_1, &
+ v_2, v_3, vpt_1, vpt_2, w_1, w_2, w_3
+
+ REAL, DIMENSION(:,:,:), POINTER :: &
+ e, e_m, e_p, kh, kh_m, km, km_m, pt, pt_m, pt_p, q, q_m, q_p, ql, &
+ ql_c, rho, sa, sa_p, te_m, tpt_m, tq_m, tsa_m, tu_m, tv_m, tw_m, u, &
+ u_m, u_p, v, v_m, v_p, vpt, vpt_m, w, w_m, w_p
+
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: rif_wall
+
+ SAVE
+
+ END MODULE arrays_3d
+
+
+
+
+ MODULE averaging
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables needed for time-averaging of 2d/3d data
+!------------------------------------------------------------------------------!
+
+ REAL, DIMENSION(:,:), ALLOCATABLE :: lwp_av, precipitation_rate_av, &
+ ts_av, us_av, z0_av
+
+ REAL, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: &
+ e_av, p_av, pc_av, pr_av, pt_av, q_av, ql_av, ql_c_av, ql_v_av, &
+ ql_vp_av, qv_av, rho_av, s_av, sa_av, u_av, v_av, vpt_av, w_av
+
+ END MODULE averaging
+
+
+
+
+ MODULE cloud_parameters
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables and constants for cloud physics
+!------------------------------------------------------------------------------!
+
+ REAL :: b_cond, cp = 1005.0, diff_coeff_l = 0.23E-4, &
+ effective_coll_efficiency, l_d_cp, l_d_r, l_d_rv, l_v = 2.5E+06, &
+ mass_of_solute, molecular_weight_of_solute, &
+ prec_time_const = 0.001, ql_crit = 0.0005, rho_l = 1.0E3, &
+ r_d = 287.0, r_v = 461.51, thermal_conductivity_l = 2.43E-2
+
+ REAL, DIMENSION(:), ALLOCATABLE :: pt_d_t, t_d_pt
+
+ REAL, DIMENSION(:,:), ALLOCATABLE :: precipitation_amount, &
+ precipitation_rate
+
+ SAVE
+
+ END MODULE cloud_parameters
+
+
+
+
+ MODULE constants
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of general constants
+!------------------------------------------------------------------------------!
+
+ REAL :: pi = 3.141592654
+
+ SAVE
+
+ END MODULE constants
+
+
+
+
+ MODULE control_parameters
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of parameters for program control
+!------------------------------------------------------------------------------!
+
+ TYPE plot_precision
+ CHARACTER (LEN=6) :: variable
+ INTEGER :: precision
+ END TYPE plot_precision
+
+ TYPE(plot_precision), DIMENSION(100) :: plot_3d_precision = &
+ (/ plot_precision( 'u', 2 ), plot_precision( 'v', 2 ), &
+ plot_precision( 'w', 2 ), plot_precision( 'p', 5 ), &
+ plot_precision( 'pt', 2 ), &
+ ( plot_precision( ' ', 1 ), i9 = 1,95 ) /)
+
+ TYPE file_status
+ LOGICAL :: opened, opened_before
+ END TYPE file_status
+
+ TYPE(file_status), DIMENSION(200) :: openfile = file_status(.FALSE.,.FALSE.)
+
+
+ CHARACTER (LEN=1) :: cycle_mg = 'w', timestep_reason = ' '
+ CHARACTER (LEN=2) :: coupling_char = ''
+ CHARACTER (LEN=5) :: write_binary = 'false'
+ CHARACTER (LEN=6) :: grid_matching = 'match'
+ CHARACTER (LEN=8) :: run_date, run_time
+ CHARACTER (LEN=9) :: simulated_time_chr
+ CHARACTER (LEN=12) :: version = ' ', revision = ' '
+ CHARACTER (LEN=16) :: loop_optimization = 'default', &
+ momentum_advec = 'pw-scheme', &
+ psolver = 'poisfft', &
+ scalar_advec = 'pw-scheme'
+ CHARACTER (LEN=20) :: bc_e_b = 'neumann', bc_lr = 'cyclic', &
+ bc_ns = 'cyclic', bc_p_b = 'neumann', &
+ bc_p_t = 'dirichlet', bc_pt_b = 'dirichlet', &
+ bc_pt_t = 'initial_gradient', &
+ bc_q_b = 'dirichlet', bc_q_t = 'neumann', &
+ bc_s_b = 'dirichlet', bc_s_t = 'neumann', &
+ bc_sa_t = 'neumann', &
+ bc_uv_b = 'dirichlet', bc_uv_t = 'dirichlet', &
+ canopy_mode = 'block', &
+ coupling_mode = 'uncoupled', &
+ coupling_mode_remote = 'uncoupled', &
+ dissipation_1d = 'as_in_3d_model', &
+ fft_method = 'system-specific', &
+ mixing_length_1d = 'as_in_3d_model', &
+ random_generator = 'numerical-recipes', &
+ return_addres, return_username, &
+ timestep_scheme = 'runge-kutta-3'
+ CHARACTER (LEN=40) :: avs_data_file, topography = 'flat'
+ CHARACTER (LEN=64) :: host
+ CHARACTER (LEN=80) :: log_message, run_identifier
+ CHARACTER (LEN=100) :: initializing_actions = ' ', run_description_header
+
+ CHARACTER (LEN=7), DIMENSION(100) :: do3d_comp_prec = ' '
+ CHARACTER (LEN=10), DIMENSION(10) :: data_output_format = ' '
+ CHARACTER (LEN=10), DIMENSION(100) :: data_output = ' ', &
+ data_output_user = ' ', doav = ' '
+ CHARACTER (LEN=10), DIMENSION(300) :: data_output_pr = ' '
+ CHARACTER (LEN=10), DIMENSION(200) :: data_output_pr_user = ' '
+ CHARACTER (LEN=20), DIMENSION(10) :: netcdf_precision = ' '
+
+ CHARACTER (LEN=10), DIMENSION(0:1,100) :: do2d = ' ', do3d = ' '
+
+ INTEGER :: average_count_pr = 0, average_count_sp = 0, &
+ average_count_3d = 0, current_timestep_number = 0, &
+ dist_range = 0, disturbance_level_ind_b, &
+ disturbance_level_ind_t, doav_n = 0, dopr_n = 0, &
+ dopr_time_count = 0, dopts_time_count = 0, &
+ dosp_time_count = 0, dots_time_count = 0, &
+ do2d_xy_n = 0, do2d_xz_n = 0, do2d_yz_n = 0, do3d_avs_n = 0, &
+ dvrp_filecount = 0, dz_stretch_level_index, gamma_mg, &
+ grid_level, ibc_e_b, ibc_p_b, ibc_p_t, ibc_pt_b, ibc_pt_t, &
+ ibc_q_b, ibc_q_t, ibc_sa_t, ibc_uv_b, ibc_uv_t, &
+ inflow_disturbance_begin = -1, inflow_disturbance_end = -1, &
+ intermediate_timestep_count, intermediate_timestep_count_max, &
+ iran = -1234567, last_dt_change = 0, maximum_grid_level, &
+ max_pr_user = 0, mgcycles = 0, mg_cycles = -1, &
+ mg_switch_to_pe0_level = 0, ngsrb = 2, nsor = 20, &
+ nsor_ini = 100, n_sor, normalizing_region = 0, &
+ nz_do1d, nz_do3d = -9999, outflow_damping_width = -1, &
+ prt_time_count = 0, runnr = 0, skip_do_avs = 0, &
+ terminate_coupled = 0, terminate_coupled_remote = 0, &
+ timestep_count = 0
+
+ INTEGER :: dist_nxl(0:1), dist_nxr(0:1), dist_nyn(0:1), dist_nys(0:1), &
+ do2d_no(0:1) = 0, do2d_xy_time_count(0:1), &
+ do2d_xz_time_count(0:1), do2d_yz_time_count(0:1), &
+ do3d_no(0:1) = 0, do3d_time_count(0:1), &
+ lad_vertical_gradient_level_ind(10) = -9999, &
+ pch_index = 0, &
+ pt_vertical_gradient_level_ind(10) = -9999, &
+ q_vertical_gradient_level_ind(10) = -9999, &
+ sa_vertical_gradient_level_ind(10) = -9999, &
+ section(100,3), section_xy(100) = -9999, &
+ section_xz(100) = -9999, section_yz(100) = -9999, &
+ ug_vertical_gradient_level_ind(10) = -9999, &
+ vg_vertical_gradient_level_ind(10) = -9999
+
+ INTEGER, DIMENSION(:), ALLOCATABLE :: grid_level_count
+
+ LOGICAL :: adjust_mixing_length = .FALSE., avs_output = .FALSE., &
+ call_psolver_at_all_substeps = .TRUE., &
+ cloud_droplets = .FALSE., cloud_physics = .FALSE., &
+ conserve_volume_flow = .FALSE., constant_diffusion = .FALSE., &
+ constant_heatflux = .TRUE., constant_top_heatflux = .TRUE., &
+ constant_top_momentumflux = .FALSE., &
+ constant_top_salinityflux = .TRUE., &
+ constant_waterflux = .TRUE., create_disturbances = .TRUE., &
+ cut_spline_overshoot = .TRUE., &
+ data_output_2d_on_each_pe = .TRUE., do2d_at_begin = .FALSE., &
+ do3d_at_begin = .FALSE., do3d_compress = .FALSE., &
+ do_sum = .FALSE., dt_changed = .FALSE., dt_fixed = .FALSE., &
+ disturbance_created = .FALSE., &
+ first_call_advec_particles = .TRUE., &
+ force_print_header = .FALSE., galilei_transformation = .FALSE.,&
+ humidity = .FALSE., humidity_remote = .FALSE., &
+ inflow_l = .FALSE., inflow_n = .FALSE., &
+ inflow_r = .FALSE., inflow_s = .FALSE., iso2d_output = .FALSE.,&
+ mg_switch_to_pe0 = .FALSE., &
+ netcdf_output = .FALSE., netcdf_64bit = .FALSE., &
+ netcdf_64bit_3d = .TRUE., ocean = .FALSE., &
+ outflow_l = .FALSE., outflow_n = .FALSE., outflow_r = .FALSE., &
+ outflow_s = .FALSE., passive_scalar = .FALSE., &
+ plant_canopy = .FALSE., &
+ prandtl_layer = .TRUE., precipitation = .FALSE., &
+ profil_output = .FALSE., radiation = .FALSE., &
+ random_heatflux = .FALSE., run_control_header = .FALSE., &
+ sloping_surface = .FALSE., stop_dt = .FALSE., &
+ terminate_run = .FALSE., use_prior_plot1d_parameters = .FALSE.,&
+ use_reference = .FALSE., use_surface_fluxes = .FALSE., &
+ use_top_fluxes = .FALSE., use_ug_for_galilei_tr = .TRUE., &
+ use_upstream_for_tke = .FALSE., wall_adjustment = .TRUE.
+
+ LOGICAL :: data_output_xy(0:1) = .FALSE., data_output_xz(0:1) = .FALSE., &
+ data_output_yz(0:1) = .FALSE.
+
+ REAL :: advected_distance_x = 0.0, advected_distance_y = 0.0, &
+ alpha_surface = 0.0, asselin_filter_factor = 0.1, &
+ atmos_ocean_sign = 1.0, &
+ averaging_interval = 0.0, averaging_interval_pr = 9999999.9, &
+ averaging_interval_sp = 9999999.9, bc_pt_t_val, bc_q_t_val, &
+ bottom_salinityflux = 0.0, &
+ building_height = 50.0, building_length_x = 50.0, &
+ building_length_y = 50.0, building_wall_left = 9999999.9, &
+ building_wall_south = 9999999.9, cfl_factor = -1.0, &
+ cos_alpha_surface, disturbance_amplitude = 0.25, &
+ disturbance_energy_limit = 0.01, &
+ disturbance_level_b = -9999999.9, &
+ disturbance_level_t = -9999999.9, &
+ drag_coefficient = 0.0, &
+ dt = -1.0, dt_averaging_input = 0.0, &
+ dt_averaging_input_pr = 9999999.9, dt_coupling = 9999999.9, &
+ dt_data_output = 9999999.9, &
+ dt_data_output_av = 9999999.9, dt_disturb = 9999999.9, &
+ dt_dopr = 9999999.9, dt_dopr_listing = 9999999.9, &
+ dt_dopts = 9999999.9, dt_dosp = 9999999.9, dt_dots = 9999999.9, &
+ dt_do2d_xy = 9999999.9, dt_do2d_xz = 9999999.9, &
+ dt_do2d_yz = 9999999.9, dt_do3d = 9999999.9, dt_dvrp = 9999999.9, &
+ dt_max = 20.0, dt_prel = 9999999.9, dt_restart = 9999999.9, &
+ dt_run_control = 60.0, dt_3d = -1.0, dz = -1.0, &
+ dz_max = 9999999.9, dz_stretch_factor = 1.08, &
+ dz_stretch_level = 100000.0, e_init = 0.0, e_min = 0.0, &
+ end_time = 0.0, &
+ f = 0.0, fs = 0.0, g = 9.81, kappa = 0.4, km_constant = -1.0, &
+ km_damp_max = -1.0, lad_surface = 0.0, long_filter_factor = 0.0, &
+ maximum_cpu_time_allowed = 0.0, molecular_viscosity = 1.461E-5, &
+ old_dt = 1.0E-10, omega = 7.29212E-5, omega_sor = 1.8, &
+ overshoot_limit_e = 0.0, overshoot_limit_pt = 0.0, &
+ overshoot_limit_u = 0.0, overshoot_limit_v = 0.0, &
+ overshoot_limit_w = 0.0, particle_maximum_age = 9999999.9, &
+ phi = 55.0, prandtl_number = 1.0, &
+ precipitation_amount_interval = 9999999.9, prho_reference, &
+ pt_reference = 9999999.9, pt_slope_offset = 0.0, &
+ pt_surface = 300.0, pt_surface_initial_change = 0.0, &
+ q_surface = 0.0, q_surface_initial_change = 0.0, &
+ rayleigh_damping_factor = -1.0, rayleigh_damping_height = -1.0, &
+ residual_limit = 1.0E-4, restart_time = 9999999.9, rho_reference, &
+ rho_surface, rif_max = 1.0, &
+ rif_min = -5.0, roughness_length = 0.1, sa_surface = 35.0, &
+ simulated_time = 0.0, simulated_time_at_begin, sin_alpha_surface, &
+ skip_time_data_output = 0.0, skip_time_data_output_av = 9999999.9,&
+ skip_time_dopr = 9999999.9, skip_time_dosp = 9999999.9, &
+ skip_time_do2d_xy = 9999999.9, skip_time_do2d_xz = 9999999.9, &
+ skip_time_do2d_yz = 9999999.9, skip_time_do3d = 9999999.9, &
+ surface_heatflux = 9999999.9, surface_pressure = 1013.25, &
+ surface_scalarflux = 0.0, surface_waterflux = 0.0, &
+ s_surface = 0.0, s_surface_initial_change = 0.0, &
+ termination_time_needed = -1.0, time_coupling = 0.0, &
+ time_disturb = 0.0, &
+ time_dopr = 0.0, time_dopr_av = 0.0, time_dopr_listing = 0.0, &
+ time_dopts = 0.0, time_dosp = 0.0, time_dosp_av = 0.0, &
+ time_dots = 0.0, time_do2d_xy = 0.0, time_do2d_xz = 0.0, &
+ time_do2d_yz = 0.0, time_do3d = 0.0, time_do_av = 0.0, &
+ time_do_sla = 0.0, time_dvrp = 0.0, time_prel = 0.0, &
+ time_restart = 9999999.9, time_run_control = 0.0, &
+ top_heatflux = 9999999.9, top_momentumflux_u = 9999999.9, &
+ top_momentumflux_v = 9999999.9, top_salinityflux = 9999999.9, &
+ ug_surface = 0.0, u_gtrans = 0.0, &
+ ups_limit_e = 0.0, ups_limit_pt = 0.0, ups_limit_u = 0.0, &
+ ups_limit_v = 0.0, ups_limit_w = 0.0, vg_surface = 0.0, &
+ v_gtrans = 0.0, wall_adjustment_factor = 1.8, z_max_do1d = -1.0, &
+ z_max_do1d_normalized = -1.0, z_max_do2d = -1.0
+
+ REAL :: do2d_xy_last_time(0:1) = -1.0, do2d_xz_last_time(0:1) = -1.0, &
+ do2d_yz_last_time(0:1) = -1.0, &
+ lad_vertical_gradient(10) = 0.0, &
+ lad_vertical_gradient_level(10) = -9999999.9, &
+ pt_vertical_gradient(10) = 0.0, &
+ pt_vertical_gradient_level(10) = -9999999.9, &
+ q_vertical_gradient(10) = 0.0, &
+ q_vertical_gradient_level(10) = -1.0, &
+ s_vertical_gradient(10) = 0.0, &
+ s_vertical_gradient_level(10) = -1.0, &
+ sa_vertical_gradient(10) = 0.0, &
+ sa_vertical_gradient_level(10) = -9999999.9, threshold(20) = 0.0, &
+ tsc(10) = (/ 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 /), &
+ ug_vertical_gradient(10) = 0.0, &
+ ug_vertical_gradient_level(10) = -9999999.9, &
+ vg_vertical_gradient(10) = 0.0, &
+ vg_vertical_gradient_level(10) = -9999999.9, &
+ volume_flow(1:2) = 0.0, volume_flow_area(1:2) = 0.0, &
+ volume_flow_initial(1:2) = 0.0, wall_heatflux(0:4) = 0.0, &
+ wall_humidityflux(0:4) = 0.0, wall_qflux(0:4) = 0.0, &
+ wall_salinityflux(0:4) = 0.0, wall_scalarflux(0:4) = 0.0
+
+
+ SAVE
+
+ END MODULE control_parameters
+
+
+
+
+ MODULE cpulog
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables for cpu-time measurements
+!------------------------------------------------------------------------------!
+
+ REAL :: initial_wallclock_time
+
+ TYPE logpoint
+ REAL :: isum, ivect, mean, mtime, mtimevec, sum, vector
+ INTEGER :: counts
+ CHARACTER (LEN=20) :: place
+ END TYPE logpoint
+
+ TYPE(logpoint), DIMENSION(100) :: log_point = logpoint( 0.0, 0.0, 0.0, &
+ 0.0, 0.0, 0.0, 0.0, 0, ' ' ), &
+ log_point_s = logpoint( 0.0, 0.0, 0.0, &
+ 0.0, 0.0, 0.0, 0.0, 0, ' ' )
+
+ SAVE
+
+ END MODULE cpulog
+
+
+
+
+ MODULE dvrp_variables
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables used with dvrp-software
+!------------------------------------------------------------------------------!
+
+ CHARACTER (LEN=10) :: dvrp_output = 'rtsp'
+
+ CHARACTER (LEN=20), DIMENSION(10) :: mode_dvrp = &
+ (/ ( ' ', i9 = 1,10 ) /)
+
+ CHARACTER (LEN=80) :: dvrp_directory = 'default', &
+ dvrp_file = 'default', &
+ dvrp_host = 'origin.rvs.uni-hannover.de', &
+ dvrp_password = '********', &
+ dvrp_username = ' '
+
+ INTEGER :: dvrp_colourtable_entries = 4, islice_dvrp, nx_dvrp, ny_dvrp, &
+ nz_dvrp
+
+ INTEGER, DIMENSION(10) :: slicer_position_dvrp
+
+ LOGICAL :: cyclic_dvrp = .FALSE., lock_steering_update = .FALSE., &
+ use_seperate_pe_for_dvrp_output = .FALSE.
+
+ REAL :: superelevation = 1.0, superelevation_x = 1.0, &
+ superelevation_y = 1.0
+
+#if defined( __decalpha )
+ REAL, DIMENSION(2,10) :: slicer_range_limits_dvrp = (/ &
+ -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
+ -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
+ -1.0, 1.0, -1.0, 1.0 /)
+
+ REAL, DIMENSION(2,100) :: interval_values_dvrp, interval_h_dvrp = &
+ (/ 270.0, 225.0, 225.0, 180.0, 70.0, 25.0, &
+ 25.0, -25.0, ( 0.0, i9 = 1, 192 ) /), &
+ interval_l_dvrp = 0.5, interval_s_dvrp = 1.0, &
+ interval_a_dvrp = 0.0
+#else
+ REAL, DIMENSION(2,10) :: slicer_range_limits_dvrp
+
+ REAL, DIMENSION(2,100) :: interval_values_dvrp, interval_h_dvrp, &
+ interval_l_dvrp = 0.5, interval_s_dvrp = 1.0, &
+ interval_a_dvrp = 0.0
+
+ DATA slicer_range_limits_dvrp / -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
+ -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
+ -1.0, 1.0, -1.0, 1.0, -1.0, 1.0, &
+ -1.0, 1.0 /
+
+ DATA interval_h_dvrp / 270.0, 225.0, 225.0, 180.0, 70.0, 25.0, &
+ 25.0, -25.0, 192 * 0.0 /
+#endif
+
+ REAL, DIMENSION(:), ALLOCATABLE :: xcoor_dvrp, ycoor_dvrp, zcoor_dvrp
+
+ TYPE steering
+ CHARACTER (LEN=20) :: name
+ REAL :: min, max
+ INTEGER :: imin, imax
+ END TYPE steering
+
+ TYPE(steering), DIMENSION(:), ALLOCATABLE :: steering_dvrp
+
+ SAVE
+
+ END MODULE dvrp_variables
+
+
+
+
+ MODULE grid_variables
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of grid spacings
+!------------------------------------------------------------------------------!
+
+ REAL :: ddx, ddx2, dx = 1.0, dx2, ddy, ddy2, dy = 1.0, dy2
+
+ REAL, DIMENSION(:), ALLOCATABLE :: ddx2_mg, ddy2_mg
+
+ REAL, DIMENSION(:,:), ALLOCATABLE :: fwxm, fwxp, fwym, fwyp, fxm, fxp, &
+ fym, fyp, wall_e_x, wall_e_y, &
+ wall_u, wall_v, wall_w_x, wall_w_y, &
+ zu_s_inner, zw_w_inner
+
+ SAVE
+
+ END MODULE grid_variables
+
+
+
+
+ MODULE indices
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of array bounds and number of gridpoints
+!------------------------------------------------------------------------------!
+
+ INTEGER :: ngp_sums, nnx, nx = 0, nxa, nxl, nxlu, nxr, nxra, nny, ny = 0, &
+ nya, nyn, nyna, nys, nysv, nnz, nz = 0, nza, nzb, nzb_diff, &
+ nzt, nzta, nzt_diff
+
+ INTEGER, DIMENSION(:), ALLOCATABLE :: &
+ ngp_2dh, ngp_3d, ngp_3d_inner, &
+ nnx_pe, nny_pe, nxl_mg, nxr_mg, nyn_mg, nys_mg, nzt_mg
+
+ INTEGER, DIMENSION(:,:), ALLOCATABLE :: &
+ ngp_2dh_outer, ngp_2dh_s_inner, mg_loc_ind, nzb_diff_s_inner, &
+ nzb_diff_s_outer, nzb_diff_u, nzb_diff_v, nzb_inner, nzb_outer,&
+ nzb_s_inner, nzb_s_outer, nzb_u_inner, nzb_u_outer, &
+ nzb_v_inner, nzb_v_outer, nzb_w_inner, nzb_w_outer, nzb_2d
+
+ INTEGER, DIMENSION(:,:,:), POINTER :: flags
+
+ INTEGER, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wall_flags_1, &
+ wall_flags_2, wall_flags_3, wall_flags_4, wall_flags_5, &
+ wall_flags_6, wall_flags_7, wall_flags_8, wall_flags_9, &
+ wall_flags_10
+
+ SAVE
+
+ END MODULE indices
+
+
+
+
+ MODULE interfaces
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Interfaces for special subroutines which use optional parameters
+!------------------------------------------------------------------------------!
+
+ INTERFACE
+
+ SUBROUTINE cpu_log( log_event, place, modus, barrierwait )
+
+ USE cpulog
+
+ CHARACTER (LEN=*) :: modus, place
+ CHARACTER (LEN=*), OPTIONAL :: barrierwait
+ TYPE(logpoint) :: log_event
+
+ END SUBROUTINE cpu_log
+
+ END INTERFACE
+
+
+
+ INTERFACE
+
+ SUBROUTINE global_min_max ( i1, i2, j1, j2, k1, k2, feld, mode, wert, &
+ wert_ijk, wert1, wert1_ijk )
+ CHARACTER (LEN=*), INTENT(IN) :: mode
+ INTEGER, INTENT(IN) :: i1, i2, j1, j2, k1, k2
+ INTEGER :: wert_ijk(3)
+ INTEGER, OPTIONAL :: wert1_ijk(3)
+ REAL :: wert
+ REAL, OPTIONAL :: wert1
+ REAL, INTENT(IN) :: feld(i1:i2,j1:j2,k1:k2)
+
+ END SUBROUTINE global_min_max
+
+ END INTERFACE
+
+ SAVE
+
+ END MODULE interfaces
+
+
+
+ MODULE pointer_interfaces
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Interfaces for subroutines with pointer arguments called in
+! prognostic_equations
+!------------------------------------------------------------------------------!
+
+ INTERFACE
+
+ SUBROUTINE advec_s_bc( sk, sk_char )
+
+ CHARACTER (LEN=*), INTENT(IN) :: sk_char
+ REAL, DIMENSION(:,:,:), POINTER :: sk
+
+ END SUBROUTINE advec_s_bc
+
+ END INTERFACE
+
+
+ SAVE
+
+ END MODULE pointer_interfaces
+
+
+
+
+ MODULE model_1d
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables for the 1D-model
+!------------------------------------------------------------------------------!
+
+ INTEGER :: current_timestep_number_1d = 0, damp_level_ind_1d, &
+ last_dt_change_1d = 0
+
+ LOGICAL :: run_control_header_1d = .FALSE., stop_dt_1d = .FALSE.
+
+ REAL :: damp_level_1d = -1.0, dt_1d = 60.0, dt_max_1d = 300.0, &
+ dt_pr_1d = 9999999.9, dt_run_control_1d = 60.0, &
+ end_time_1d = 864000.0, old_dt_1d = 1.0E-10, &
+ qs1d, simulated_time_1d = 0.0, time_pr_1d = 0.0, &
+ time_run_control_1d = 0.0, ts1d, us1d, usws1d, usws1d_m, &
+ vsws1d, vsws1d_m, z01d
+
+
+ REAL, DIMENSION(:), ALLOCATABLE :: e1d, e1d_m, e1d_p, kh1d, kh1d_m, km1d, &
+ km1d_m, l_black, l1d, l1d_m, rif1d, &
+ te_e, te_em, te_u, te_um, te_v, te_vm, &
+ u1d, u1d_m, u1d_p, v1d, v1d_m, v1d_p
+
+ SAVE
+
+ END MODULE model_1d
+
+
+
+
+ MODULE netcdf_control
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of parameters and variables for netcdf control.
+!------------------------------------------------------------------------------!
+
+#if defined( __netcdf )
+ USE netcdf
+#endif
+
+ INTEGER, PARAMETER :: dopr_norm_num = 7, dopts_num = 26, dots_max = 100, &
+ replace_num = 6
+
+ INTEGER :: dots_num = 22
+
+ CHARACTER, DIMENSION( replace_num ) :: &
+ replace_char = (/ '''', '"', '*', '/', '(', ')' /), &
+ replace_by = (/ 'p' , 'p', 's', 'o', '_', '_' /)
+
+ CHARACTER (LEN=6), DIMENSION(dopr_norm_num) :: dopr_norm_names = &
+ (/ 'wpt0 ', 'ws2 ', 'tsw2 ', 'ws3 ', 'ws2tsw', 'wstsw2', &
+ 'z_i ' /)
+
+ CHARACTER (LEN=6), DIMENSION(dopr_norm_num) :: dopr_norm_longnames = &
+ (/ 'wpt0 ', 'w*2 ', 't*w2 ', 'w*3 ', 'w*2t*w', 'w*t*w2', &
+ 'z_i ' /)
+
+ CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_label = &
+ (/ 'tnpt ', 'x_ ', 'y_ ', 'z_ ', 'z_abs ', 'u ', &
+ 'v ', 'w ', 'u" ', 'v" ', 'w" ', 'npt_up ', &
+ 'w_up ', 'w_down ', 'npt_max', 'npt_min', 'x*2 ', 'y*2 ', &
+ 'z*2 ', 'u*2 ', 'v*2 ', 'w*2 ', 'u"2 ', 'v"2 ', &
+ 'w"2 ', 'npt*2 ' /)
+
+ CHARACTER (LEN=7), DIMENSION(dopts_num) :: dopts_unit = &
+ (/ 'number ', 'm ', 'm ', 'm ', 'm ', 'm/s ', &
+ 'm/s ', 'm/s ', 'm/s ', 'm/s ', 'm/s ', 'number ', &
+ 'm/s ', 'm/s ', 'number ', 'number ', 'm2 ', 'm2 ', &
+ 'm2 ', 'm2/s2 ', 'm2/s2 ', 'm2/s2 ', 'm2/s2 ', 'm2/s2 ', &
+ 'm2/s2 ', 'number2' /)
+
+ CHARACTER (LEN=7), DIMENSION(dots_max) :: dots_label = &
+ (/ 'E ', 'E* ', 'dt ', 'u* ', 'th* ', 'umax ', &
+ 'vmax ', 'wmax ', 'div_new', 'div_old', 'z_i_wpt', 'z_i_pt ', &
+ 'w* ', 'w"pt"0 ', 'w"pt" ', 'wpt ', 'pt(0) ', 'pt(zp) ', &
+ 'splptx ', 'splpty ', 'splptz ', 'mo_L ', &
+ ( 'unknown', i9 = 1, 78) /)
+
+ CHARACTER (LEN=7), DIMENSION(dots_max) :: dots_unit = &
+ (/ 'm2/s2 ', 'm2/s2 ', 's ', 'm/s ', 'K ', 'm/s ', &
+ 'm/s ', 'm/s ', 's-1 ', 's-1 ', 'm ', 'm ', &
+ 'm/s ', 'K m/s ', 'K m/s ', 'k m/s ', 'K ', 'K ', &
+ '% ', '% ', '% ', 'm ', &
+ ( 'unknown', i9 = 1, 78 ) /)
+
+ CHARACTER (LEN=7), DIMENSION(300) :: dopr_unit = 'unknown'
+
+ CHARACTER (LEN=7), DIMENSION(0:1,100) :: do2d_unit, do3d_unit
+
+ CHARACTER (LEN=16), DIMENSION(25) :: prt_var_names = &
+ (/ 'pt_age ', 'pt_dvrp_size ', 'pt_origin_x ', &
+ 'pt_origin_y ', 'pt_origin_z ', 'pt_radius ', &
+ 'pt_speed_x ', 'pt_speed_y ', 'pt_speed_z ', &
+ 'pt_weight_factor', 'pt_x ', 'pt_y ', &
+ 'pt_z ', 'pt_color ', 'pt_group ', &
+ 'pt_tailpoints ', 'pt_tail_id ', 'pt_density_ratio', &
+ 'pt_exp_arg ', 'pt_exp_term ', 'not_used ', &
+ 'not_used ', 'not_used ', 'not_used ', &
+ 'not_used ' /)
+
+ CHARACTER (LEN=16), DIMENSION(25) :: prt_var_units = &
+ (/ 'seconds ', 'meters ', 'meters ', &
+ 'meters ', 'meters ', 'meters ', &
+ 'm/s ', 'm/s ', 'm/s ', &
+ 'factor ', 'meters ', 'meters ', &
+ 'meters ', 'none ', 'none ', &
+ 'none ', 'none ', 'ratio ', &
+ 'none ', 'none ', 'not_used ', &
+ 'not_used ', 'not_used ', 'not_used ', &
+ 'not_used ' /)
+
+ INTEGER :: id_dim_prtnum, id_dim_time_pr, id_dim_time_prt, &
+ id_dim_time_pts, id_dim_time_sp, id_dim_time_ts, id_dim_x_sp, &
+ id_dim_y_sp, id_dim_zu_sp, id_dim_zw_sp, id_set_pr, &
+ id_set_prt, id_set_pts, id_set_sp, id_set_ts, id_var_prtnum, &
+ id_var_rnop_prt, id_var_time_pr, id_var_time_prt, &
+ id_var_time_pts, id_var_time_sp, id_var_time_ts, id_var_x_sp, &
+ id_var_y_sp, id_var_zu_sp, id_var_zw_sp, nc_stat
+
+ INTEGER, DIMENSION(0:1) :: id_dim_time_xy, id_dim_time_xz, &
+ id_dim_time_yz, id_dim_time_3d, id_dim_x_xy, id_dim_xu_xy, &
+ id_dim_x_xz, id_dim_xu_xz, id_dim_x_yz, id_dim_xu_yz, &
+ id_dim_x_3d, id_dim_xu_3d, id_dim_y_xy, id_dim_yv_xy, &
+ id_dim_y_xz, id_dim_yv_xz, id_dim_y_yz, id_dim_yv_yz, &
+ id_dim_y_3d, id_dim_yv_3d, id_dim_zu_xy, id_dim_zu1_xy, &
+ id_dim_zu_xz, id_dim_zu_yz, id_dim_zu_3d, id_dim_zw_xy, &
+ id_dim_zw_xz, id_dim_zw_yz, id_dim_zw_3d, id_set_xy, &
+ id_set_xz, id_set_yz, id_set_3d, id_var_ind_x_yz, &
+ id_var_ind_y_xz, id_var_ind_z_xy, id_var_time_xy, &
+ id_var_time_xz, id_var_time_yz, id_var_time_3d, id_var_x_xy, &
+ id_var_xu_xy, id_var_x_xz, id_var_xu_xz, id_var_x_yz, &
+ id_var_xu_yz, id_var_x_3d, id_var_xu_3d, id_var_y_xy, &
+ id_var_yv_xy, id_var_y_xz, id_var_yv_xz, id_var_y_yz, &
+ id_var_yv_yz, id_var_y_3d, id_var_yv_3d, id_var_zusi_xy, &
+ id_var_zusi_3d, id_var_zu_xy, id_var_zu1_xy, id_var_zu_xz, &
+ id_var_zu_yz, id_var_zu_3d, id_var_zwwi_xy, id_var_zwwi_3d, &
+ id_var_zw_xy, id_var_zw_xz, id_var_zw_yz, id_var_zw_3d
+
+ INTEGER, DIMENSION(10) :: id_var_dospx, id_var_dospy, nc_precision
+ INTEGER, DIMENSION(20) :: id_var_prt
+ INTEGER, DIMENSION(dopr_norm_num) :: id_var_norm_dopr
+
+ INTEGER, DIMENSION(dopts_num,0:10) :: id_var_dopts
+ INTEGER, DIMENSION(0:1,100) :: id_var_do2d, id_var_do3d
+ INTEGER, DIMENSION(100,0:9) :: id_dim_z_pr, id_var_dopr, &
+ id_var_z_pr
+ INTEGER, DIMENSION(dots_max,0:9) :: id_var_dots
+
+
+ SAVE
+
+ END MODULE netcdf_control
+
+
+
+ MODULE particle_attributes
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables used to compute particle transport
+!------------------------------------------------------------------------------!
+
+ USE array_kind
+
+ CHARACTER (LEN=15) :: bc_par_lr = 'cyclic', bc_par_ns = 'cyclic', &
+ bc_par_b = 'reflect', bc_par_t = 'absorb'
+
+#if defined( __parallel )
+ INTEGER :: mpi_particle_type
+#endif
+ INTEGER :: ibc_par_lr, ibc_par_ns, ibc_par_b, ibc_par_t, &
+ iran_part = -1234567, maximum_number_of_particles = 1000, &
+ maximum_number_of_tailpoints = 100, &
+ maximum_number_of_tails = 0, &
+ number_of_initial_particles = 0, number_of_particles = 0, &
+ number_of_particle_groups = 1, number_of_tails = 0, &
+ number_of_initial_tails = 0, particles_per_point = 1, &
+ particle_file_count = 0, skip_particles_for_tail = 100, &
+ total_number_of_particles, total_number_of_tails = 0
+
+ INTEGER, PARAMETER :: max_number_of_particle_groups = 10
+
+ INTEGER, DIMENSION(:), ALLOCATABLE :: new_tail_id
+ INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: prt_count, prt_start_index
+
+ LOGICAL :: particle_advection = .FALSE., random_start_position = .FALSE., &
+ read_particles_from_restartfile = .TRUE., &
+ uniform_particles = .TRUE., use_particle_tails = .FALSE., &
+ use_sgs_for_particles = .FALSE., &
+ vertical_particle_advection = .TRUE., &
+ write_particle_statistics = .FALSE.
+ LOGICAL, DIMENSION(:), ALLOCATABLE :: particle_mask, tail_mask
+
+ REAL :: c_0 = 3.0, dt_min_part = 0.0002, dt_sort_particles = 0.0, &
+ dt_write_particle_data = 9999999.9, dvrp_psize = 9999999.9, &
+ end_time_prel = 9999999.9, initial_weighting_factor = 1.0, &
+ maximum_tailpoint_age = 100000.0, &
+ minimum_tailpoint_distance = 0.0, &
+ particle_advection_start = 0.0, sgs_wfu_part = 0.3333333, &
+ sgs_wfv_part = 0.3333333, sgs_wfw_part = 0.3333333, &
+ time_sort_particles = 0.0, time_write_particle_data = 0.0
+
+ REAL, DIMENSION(max_number_of_particle_groups) :: &
+ density_ratio = 9999999.9, pdx = 9999999.9, pdy = 9999999.9, &
+ pdz = 9999999.9, psb = 9999999.9, psl = 9999999.9, &
+ psn = 9999999.9, psr = 9999999.9, pss = 9999999.9, &
+ pst = 9999999.9, radius = 9999999.9
+
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: particle_tail_coordinates
+
+
+ TYPE particle_type
+ SEQUENCE
+ REAL :: age, age_m, dt_sum, dvrp_psize, e_m, origin_x, origin_y, &
+ origin_z, radius, speed_x, speed_x_sgs, speed_y, &
+ speed_y_sgs, speed_z, speed_z_sgs, weight_factor, x, y, z
+ INTEGER :: color, group, tailpoints, tail_id
+ END TYPE particle_type
+
+ TYPE(particle_type), DIMENSION(:), ALLOCATABLE :: initial_particles, &
+ particles
+
+ TYPE particle_groups_type
+ SEQUENCE
+ REAL :: density_ratio, radius, exp_arg, exp_term
+ END TYPE particle_groups_type
+
+ TYPE(particle_groups_type), DIMENSION(max_number_of_particle_groups) ::&
+ particle_groups
+
+ SAVE
+
+ END MODULE particle_attributes
+
+
+
+
+
+ MODULE pegrid
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables which define processor topology and the exchange of
+! ghost point layers. This modules must be placed in all routines which contain
+! MPI-calls.
+!------------------------------------------------------------------------------!
+
+#if defined( __parallel )
+#if defined( __lc )
+ USE MPI
+#else
+ INCLUDE "mpif.h"
+#endif
+#endif
+ CHARACTER(LEN=5) :: myid_char = '', myid_char_14 = ''
+ INTEGER :: myid=0, npex = -1, npey = -1, numprocs = 1, &
+ tasks_per_node = -9999, threads_per_task = 1
+
+#if defined( __parallel )
+#if defined( __mpi2 )
+ CHARACTER (LEN=MPI_MAX_PORT_NAME) :: port_name
+#endif
+
+ INTEGER :: comm1dx, comm1dy, comm2d, comm_inter, comm_palm, ierr, myidx, &
+ myidy, ndim = 2, ngp_xy, ngp_y, pleft, pnorth, pright, psouth, &
+ sendrecvcount_xy, sendrecvcount_yz, sendrecvcount_zx, &
+ sendrecvcount_zyd, sendrecvcount_yxd, &
+ type_x, type_x_int, type_xy
+
+ INTEGER :: ibuf(12), pcoord(2), pdims(2), status(MPI_STATUS_SIZE)
+
+ INTEGER, DIMENSION(:), ALLOCATABLE :: ngp_yz, type_xz
+
+ LOGICAL :: reorder = .TRUE.
+ LOGICAL, DIMENSION(2) :: cyclic = (/ .TRUE. , .TRUE. /), &
+ remain_dims
+#endif
+
+ SAVE
+
+ END MODULE pegrid
+
+
+
+
+ MODULE profil_parameter
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of variables which control PROFIL-output
+!------------------------------------------------------------------------------!
+
+ INTEGER, PARAMETER :: crmax = 100
+
+ CHARACTER (LEN=10), DIMENSION(100) :: dopr_label = ' '
+
+ CHARACTER (LEN=10), DIMENSION(crmax) :: cross_normalized_x = ' ', &
+ cross_normalized_y = ' '
+
+ CHARACTER (LEN=20), DIMENSION(20) :: cross_ts_profiles = &
+ (/ ' E E* ', ' dt ', &
+ ' u* w* ', ' th* ', &
+ ' umax vmax wmax ', ' div_old div_new ', &
+ ' z_i_wpt z_i_pt ', ' w"pt"0 w"pt" wpt ', &
+ ' pt(0) pt(zp) ', ' splux spluy spluz ', &
+ ' L ', &
+ ( ' ', i9 = 1, 9 ) /)
+
+ CHARACTER (LEN=40), DIMENSION(crmax) :: cross_xtext = &
+ (/ 'windspeed in ms>->1 ', &
+ 'pot. temperature in K ', &
+ 'heat flux in K ms>->1 ', &
+ 'momentum flux in m>2s>2 ', &
+ 'eddy diffusivity in m>2s>->1', &
+ 'mixing length in m ', &
+ ( ' ', i9 = 1, 94 ) /)
+
+ CHARACTER (LEN=100), DIMENSION(crmax) :: cross_profiles = &
+ (/ ' u v ', &
+ ' pt ', &
+ ' w"pt" w*pt* w*pt*BC wpt wptBC ', &
+ ' w"u" w*u* wu w"v" w*v* wv ', &
+ ' km kh ', &
+ ' l ', &
+ ( ' ', i9 = 1, 94 ) /)
+
+ INTEGER :: profile_columns = 3, profile_rows = 2, profile_number = 0
+
+ INTEGER :: cross_linecolors(100,crmax) = 1, &
+ cross_linestyles(100,crmax) = 0, &
+ cross_profile_numbers(100,crmax) = 0, &
+ cross_pnc_local(crmax), cross_profile_number_count(crmax) = 0, &
+ cross_ts_numbers(crmax,crmax) = 0, &
+ cross_ts_number_count(crmax) = 0, dopr_crossindex(100) = 0, &
+ dopr_index(300) = 0, dopr_initial_index(300) = 0, &
+ dots_crossindex(100) = 0, dots_index(100) = 0, &
+ linecolors(10) = (/ 2, 3, 4, 5, 7, 8, 12, 15, 16, 23 /), &
+ linestyles(11) = (/ 0, 7, 3, 10, 4, 1, 9, 2, 5, 8, 6 /)
+
+
+ REAL :: cross_normx_factor(100,crmax) = 1.0, &
+ cross_normy_factor(100,crmax) = 1.0, &
+ cross_ts_uymax(20) = &
+ (/ 999.999, 999.999, 999.999, 999.999, 999.999, &
+ 999.999, 999.999, 999.999, 999.999, 999.999, &
+ 999.999, 999.999, 999.999, 999.999, 999.999, &
+ 999.999, 999.999, 999.999, 999.999, 999.999 /),&
+ cross_ts_uymax_computed(20) = 999.999, &
+ cross_ts_uymin(20) = &
+ (/ 999.999, 999.999, 999.999, -5.000, 999.999, &
+ 999.999, 0.000, 999.999, 999.999, 999.999, &
+ 999.999, 999.999, 999.999, 999.999, 999.999, &
+ 999.999, 999.999, 999.999, 999.999, 999.999 /),&
+ cross_ts_uymin_computed(20) = 999.999, &
+ cross_uxmax(crmax) = 0.0, cross_uxmax_computed(crmax) = -1.0, &
+ cross_uxmax_normalized(crmax) = 0.0, &
+ cross_uxmax_normalized_computed(crmax) = -1.0, &
+ cross_uxmin(crmax) = 0.0, cross_uxmin_computed(crmax) = 1.0, &
+ cross_uxmin_normalized(crmax) = 0.0, &
+ cross_uxmin_normalized_computed(crmax) = 1.0, &
+ cross_uymax(crmax), cross_uymin(crmax)
+
+ SAVE
+
+ END MODULE profil_parameter
+
+
+
+
+ MODULE spectrum
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of quantities used for computing spectra
+!------------------------------------------------------------------------------!
+
+ CHARACTER (LEN=6), DIMENSION(1:5) :: header_char = (/ 'PS(u) ', 'PS(v) ',&
+ 'PS(w) ', 'PS(pt)', 'PS(q) ' /)
+ CHARACTER (LEN=2), DIMENSION(10) :: spectra_direction = 'x'
+ CHARACTER (LEN=10), DIMENSION(10) :: data_output_sp = ' '
+ CHARACTER (LEN=25), DIMENSION(1:5) :: utext_char = &
+ (/ '-power spectrum of u ', &
+ '-power spectrum of v ', &
+ '-power spectrum of w ', &
+ '-power spectrum of ^1185 ', &
+ '-power spectrum of q ' /)
+ CHARACTER (LEN=39), DIMENSION(1:5) :: ytext_char = &
+ (/ 'k ^2236 ^2566^25692s>->2 ', &
+ 'k ^2236 ^2566^25692s>->2 ', &
+ 'k ^2236 ^2566^25692s>->2 ', &
+ 'k ^2236 ^2566^2569<^1185(k) in m>2s>->2', &
+ 'k ^2236 ^2566^25692s>->2 ' /)
+
+ INTEGER :: klist_x = 0, klist_y = 0, n_sp_x = 0, n_sp_y = 0
+
+ INTEGER :: comp_spectra_level(10) = 999999, &
+ lstyles(10) = (/ 0, 7, 3, 10, 1, 4, 9, 2, 6, 8 /), &
+ plot_spectra_level(10) = 999999
+
+ REAL :: time_to_start_sp = 0.0
+
+ SAVE
+
+ END MODULE spectrum
+
+
+
+
+ MODULE statistics
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of statistical quantities, e.g. global sums
+!------------------------------------------------------------------------------!
+
+ CHARACTER (LEN=40) :: region(0:9)
+ INTEGER :: pr_palm = 80, statistic_regions = 0, var_ts = 100
+ INTEGER :: u_max_ijk(3), v_max_ijk(3), w_max_ijk(3)
+ LOGICAL :: flow_statistics_called = .FALSE.
+ REAL :: u_max, v_max, w_max
+ REAL, DIMENSION(:), ALLOCATABLE :: sums_divnew_l, sums_divold_l
+ REAL, DIMENSION(:,:), ALLOCATABLE :: sums, sums_wsts_bc_l, ts_value
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: hom_sum, rmask, spectrum_x, &
+ spectrum_y, sums_l, sums_l_l, &
+ sums_up_fraction_l
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: hom
+
+ SAVE
+
+ END MODULE statistics
+
+
+
+
+ MODULE transpose_indices
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Definition of indices for transposed arrays
+!------------------------------------------------------------------------------!
+
+ INTEGER :: nxl_y, nxl_yd, nxl_z, nxr_y, nxr_ya, nxr_yd, nxr_yda, nxr_z, &
+ nxr_za, nyn_x, nyn_xa, nyn_z, nyn_za, nys_x, nys_z, nzb_x, &
+ nzb_y, nzb_yd, nzt_x, nzt_xa, nzt_y, nzt_ya, nzt_yd, nzt_yda
+
+
+ SAVE
+
+ END MODULE transpose_indices
Index: /palm/tags/release-3.4a/SOURCE/netcdf.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/netcdf.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/netcdf.f90 (revision 141)
@@ -0,0 +1,3578 @@
+#if defined( __ibmy_special )
+@PROCESS NOOPTimize
+#endif
+ SUBROUTINE define_netcdf_header( callmode, extend, av )
+
+!------------------------------------------------------------------------------!
+! Current revisions:
+! ------------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 97 2007-06-21 08:23:15Z raasch
+! Grids defined for rho and sa
+!
+! 48 2007-03-06 12:28:36Z raasch
+! Output topography height information (zu_s_inner, zw_s_inner) to 2d-xy and 3d
+! datasets
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.12 2006/09/26 19:35:16 raasch
+! Bugfix yv coordinates for yz cross sections
+!
+! Revision 1.1 2005/05/18 15:37:16 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! In case of extend = .FALSE.:
+! Define all necessary dimensions, axes and variables for the different
+! NetCDF datasets. This subroutine is called from check_open after a new
+! dataset is created. It leaves the open NetCDF files ready to write.
+!
+! In case of extend = .TRUE.:
+! Find out if dimensions and variables of an existing file match the values
+! of the actual run. If so, get all necessary informations (ids, etc.) from
+! this file.
+!
+! Parameter av can assume values 0 (non-averaged data) and 1 (time averaged
+! data)
+!------------------------------------------------------------------------------!
+#if defined( __netcdf )
+
+ USE arrays_3d
+ USE constants
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE netcdf_control
+ USE pegrid
+ USE particle_attributes
+ USE profil_parameter
+ USE spectrum
+ USE statistics
+
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=2) :: suffix
+ CHARACTER (LEN=2), INTENT (IN) :: callmode
+ CHARACTER (LEN=3) :: suffix1
+ CHARACTER (LEN=4) :: grid_x, grid_y, grid_z
+ CHARACTER (LEN=6) :: mode
+ CHARACTER (LEN=10) :: netcdf_var_name, netcdf_var_name_base, &
+ precision, var
+ CHARACTER (LEN=80) :: time_average_text
+ CHARACTER (LEN=2000) :: var_list, var_list_old
+
+ INTEGER :: av, i, id_x, id_y, id_z, j, ns, ns_old, nz_old
+
+ INTEGER, DIMENSION(1) :: id_dim_time_old, id_dim_x_yz_old, &
+ id_dim_y_xz_old, id_dim_zu_sp_old, &
+ id_dim_zu_xy_old, id_dim_zu_3d_old
+
+ LOGICAL :: found
+
+ LOGICAL, INTENT (INOUT) :: extend
+
+ LOGICAL, SAVE :: init_netcdf = .FALSE.
+
+ REAL, DIMENSION(1) :: last_time_coordinate
+
+ REAL, DIMENSION(:), ALLOCATABLE :: netcdf_data
+
+
+!
+!-- Initializing actions (return to calling routine check_parameters afterwards)
+ IF ( .NOT. init_netcdf ) THEN
+!
+!-- Check and set accuracy for NetCDF output. First set default value
+ nc_precision = NF90_REAL4
+
+ i = 1
+ DO WHILE ( netcdf_precision(i) /= ' ' )
+ j = INDEX( netcdf_precision(i), '_' )
+ IF ( j == 0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ define_netcdf_header: netcdf_precision must ', &
+ 'contain a "_" netcdf_precision(', i, ')="', &
+ TRIM( netcdf_precision(i) ),'"'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ var = netcdf_precision(i)(1:j-1)
+ precision = netcdf_precision(i)(j+1:)
+
+ IF ( precision == 'NF90_REAL4' ) THEN
+ j = NF90_REAL4
+ ELSEIF ( precision == 'NF90_REAL8' ) THEN
+ j = NF90_REAL8
+ ELSE
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ define_netcdf_header: illegal netcdf precision: ',&
+ 'netcdf_precision(', i, ')="', &
+ TRIM( netcdf_precision(i) ),'"'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ SELECT CASE ( var )
+ CASE ( 'xy' )
+ nc_precision(1) = j
+ CASE ( 'xz' )
+ nc_precision(2) = j
+ CASE ( 'yz' )
+ nc_precision(3) = j
+ CASE ( '2d' )
+ nc_precision(1:3) = j
+ CASE ( '3d' )
+ nc_precision(4) = j
+ CASE ( 'pr' )
+ nc_precision(5) = j
+ CASE ( 'ts' )
+ nc_precision(6) = j
+ CASE ( 'sp' )
+ nc_precision(7) = j
+ CASE ( 'prt' )
+ nc_precision(8) = j
+ CASE ( 'all' )
+ nc_precision = j
+
+ CASE DEFAULT
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ define_netcdf_header: unknown variable in ', &
+ 'inipar assignment: netcdf_precision(', i, ')="',&
+ TRIM( netcdf_precision(i) ),'"'
+ ENDIF
+ CALL local_stop
+
+ END SELECT
+
+ i = i + 1
+ IF ( i > 10 ) EXIT
+ ENDDO
+
+ init_netcdf = .TRUE.
+
+ RETURN
+
+ ENDIF
+
+!
+!-- Determine the mode to be processed
+ IF ( extend ) THEN
+ mode = callmode // '_ext'
+ ELSE
+ mode = callmode // '_new'
+ ENDIF
+
+!
+!-- Select the mode to be processed. Possibilities are xy, xz, yz, pr and ts.
+ SELECT CASE ( mode )
+
+ CASE ( '3d_new' )
+
+!
+!-- Define some global attributes of the dataset
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'Conventions', &
+ 'COARDS' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 62 )
+
+ IF ( av == 0 ) THEN
+ time_average_text = ' '
+ ELSE
+ WRITE (time_average_text, '('', '',F7.1,'' s average'')') &
+ averaging_interval
+ ENDIF
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) // &
+ TRIM( time_average_text ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 63 )
+ IF ( av == 1 ) THEN
+ WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'time_avg', &
+ TRIM( time_average_text ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 63 )
+ ENDIF
+
+!
+!-- Define time coordinate for volume data (unlimited dimension)
+ nc_stat = NF90_DEF_DIM( id_set_3d(av), 'time', NF90_UNLIMITED, &
+ id_dim_time_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 64 )
+
+ nc_stat = NF90_DEF_VAR( id_set_3d(av), 'time', NF90_DOUBLE, &
+ id_dim_time_3d(av), id_var_time_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 65 )
+
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_time_3d(av), 'units', &
+ 'seconds')
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 66 )
+
+!
+!-- Define spatial dimensions and coordinates:
+!-- Define vertical coordinate grid (zu grid)
+ nc_stat = NF90_DEF_DIM( id_set_3d(av), 'zu_3d', nz_do3d-nzb+1, &
+ id_dim_zu_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 67 )
+
+ nc_stat = NF90_DEF_VAR( id_set_3d(av), 'zu_3d', NF90_DOUBLE, &
+ id_dim_zu_3d(av), id_var_zu_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 68 )
+
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_zu_3d(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 69 )
+
+!
+!-- Define vertical coordinate grid (zw grid)
+ nc_stat = NF90_DEF_DIM( id_set_3d(av), 'zw_3d', nz_do3d-nzb+1, &
+ id_dim_zw_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 70 )
+
+ nc_stat = NF90_DEF_VAR( id_set_3d(av), 'zw_3d', NF90_DOUBLE, &
+ id_dim_zw_3d(av), id_var_zw_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 71 )
+
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_zw_3d(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 72 )
+
+!
+!-- Define x-axis (for scalar position)
+ nc_stat = NF90_DEF_DIM( id_set_3d(av), 'x', nx+2, id_dim_x_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 73 )
+
+ nc_stat = NF90_DEF_VAR( id_set_3d(av), 'x', NF90_DOUBLE, &
+ id_dim_x_3d(av), id_var_x_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 74 )
+
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_x_3d(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 75 )
+
+!
+!-- Define x-axis (for u position)
+ nc_stat = NF90_DEF_DIM( id_set_3d(av), 'xu', nx+2, id_dim_xu_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 358 )
+
+ nc_stat = NF90_DEF_VAR( id_set_3d(av), 'xu', NF90_DOUBLE, &
+ id_dim_xu_3d(av), id_var_xu_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 359 )
+
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_xu_3d(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 360 )
+
+!
+!-- Define y-axis (for scalar position)
+ nc_stat = NF90_DEF_DIM( id_set_3d(av), 'y', ny+2, id_dim_y_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 76 )
+
+ nc_stat = NF90_DEF_VAR( id_set_3d(av), 'y', NF90_DOUBLE, &
+ id_dim_y_3d(av), id_var_y_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 77 )
+
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_y_3d(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 78 )
+
+!
+!-- Define y-axis (for v position)
+ nc_stat = NF90_DEF_DIM( id_set_3d(av), 'yv', ny+2, id_dim_yv_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 361 )
+
+ nc_stat = NF90_DEF_VAR( id_set_3d(av), 'yv', NF90_DOUBLE, &
+ id_dim_yv_3d(av), id_var_yv_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 362 )
+
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_yv_3d(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 363 )
+
+!
+!-- In case of non-flat topography define 2d-arrays containing the height
+!-- informations
+ IF ( TRIM( topography ) /= 'flat' ) THEN
+!
+!-- Define zusi = zu(nzb_s_inner)
+ nc_stat = NF90_DEF_VAR( id_set_3d(av), 'zusi', NF90_DOUBLE, &
+ (/ id_dim_x_3d(av), id_dim_y_3d(av) /), &
+ id_var_zusi_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 413 )
+
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_zusi_3d(av), &
+ 'units', 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 414 )
+
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_zusi_3d(av), &
+ 'long_name', 'zu(nzb_s_inner)' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 415 )
+
+!
+!-- Define zwwi = zw(nzb_w_inner)
+ nc_stat = NF90_DEF_VAR( id_set_3d(av), 'zwwi', NF90_DOUBLE, &
+ (/ id_dim_x_3d(av), id_dim_y_3d(av) /), &
+ id_var_zwwi_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 416 )
+
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_zwwi_3d(av), &
+ 'units', 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 417 )
+
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_zwwi_3d(av), &
+ 'long_name', 'zw(nzb_w_inner)' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 418 )
+
+ ENDIF
+
+
+!
+!-- Define the variables
+ var_list = ';'
+ i = 1
+
+ DO WHILE ( do3d(av,i)(1:1) /= ' ' )
+
+!
+!-- Check for the grid
+ found = .TRUE.
+ SELECT CASE ( do3d(av,i) )
+!
+!-- Most variables are defined on the scalar grid
+ CASE ( 'e', 'p', 'pc', 'pr', 'pt', 'q', 'ql', 'ql_c', 'ql_v', &
+ 'ql_vp', 'qv', 'rho', 's', 'sa', 'vpt' )
+
+ grid_x = 'x'
+ grid_y = 'y'
+ grid_z = 'zu'
+!
+!-- u grid
+ CASE ( 'u' )
+
+ grid_x = 'xu'
+ grid_y = 'y'
+ grid_z = 'zu'
+!
+!-- v grid
+ CASE ( 'v' )
+
+ grid_x = 'x'
+ grid_y = 'yv'
+ grid_z = 'zu'
+!
+!-- w grid
+ CASE ( 'w' )
+
+ grid_x = 'x'
+ grid_y = 'y'
+ grid_z = 'zw'
+
+ CASE DEFAULT
+!
+!-- Check for user-defined quantities
+ CALL user_define_netcdf_grid( do3d(av,i), found, grid_x, &
+ grid_y, grid_z )
+
+ END SELECT
+
+!
+!-- Select the respective dimension ids
+ IF ( grid_x == 'x' ) THEN
+ id_x = id_dim_x_3d(av)
+ ELSEIF ( grid_x == 'xu' ) THEN
+ id_x = id_dim_xu_3d(av)
+ ENDIF
+
+ IF ( grid_y == 'y' ) THEN
+ id_y = id_dim_y_3d(av)
+ ELSEIF ( grid_y == 'yv' ) THEN
+ id_y = id_dim_yv_3d(av)
+ ENDIF
+
+ IF ( grid_z == 'zu' ) THEN
+ id_z = id_dim_zu_3d(av)
+ ELSEIF ( grid_z == 'zw' ) THEN
+ id_z = id_dim_zw_3d(av)
+ ENDIF
+
+!
+!-- Define the grid
+ nc_stat = NF90_DEF_VAR( id_set_3d(av), do3d(av,i), &
+ nc_precision(4), &
+ (/ id_x, id_y, id_z, id_dim_time_3d(av) /), &
+ id_var_do3d(av,i) )
+
+ IF ( .NOT. found ) THEN
+ PRINT*, '+++ define_netcdf_header: no grid defined for', &
+ ' variable ', do3d(av,i)
+ ENDIF
+
+ var_list = TRIM( var_list ) // TRIM( do3d(av,i) ) // ';'
+
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 79 )
+!
+!-- Store the 'real' name of the variable (with *, for example)
+!-- in the long_name attribute. This is evaluated by Ferret,
+!-- for example.
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_do3d(av,i), &
+ 'long_name', do3d(av,i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 80 )
+!
+!-- Define the variable's unit
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), id_var_do3d(av,i), &
+ 'units', TRIM( do3d_unit(av,i) ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 357 )
+
+ i = i + 1
+
+ ENDDO
+
+!
+!-- No arrays to output
+ IF ( i == 1 ) RETURN
+
+!
+!-- Write the list of variables as global attribute (this is used by
+!-- restart runs and by combine_plot_fields)
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', &
+ var_list )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 81 )
+
+!
+!-- Leave NetCDF define mode
+ nc_stat = NF90_ENDDEF( id_set_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 82 )
+
+!
+!-- Write data for x and xu axis (shifted by -dx/2)
+ ALLOCATE( netcdf_data(0:nx+1) )
+
+ DO i = 0, nx+1
+ netcdf_data(i) = i * dx
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_x_3d(av), netcdf_data, &
+ start = (/ 1 /), count = (/ nx+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 83 )
+
+ DO i = 0, nx+1
+ netcdf_data(i) = ( i - 0.5 ) * dx
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_xu_3d(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ nx+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 385 )
+
+ DEALLOCATE( netcdf_data )
+
+!
+!-- Write data for y and yv axis (shifted by -dy/2)
+ ALLOCATE( netcdf_data(0:ny+1) )
+
+ DO i = 0, ny+1
+ netcdf_data(i) = i * dy
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_y_3d(av), netcdf_data, &
+ start = (/ 1 /), count = (/ ny+2 /))
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 84 )
+
+ DO i = 0, ny+1
+ netcdf_data(i) = ( i - 0.5 ) * dy
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_yv_3d(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ ny+2 /))
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 387 )
+
+ DEALLOCATE( netcdf_data )
+
+!
+!-- Write zu and zw data (vertical axes)
+ nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zu_3d(av), &
+ zu(nzb:nz_do3d), start = (/ 1 /), &
+ count = (/ nz_do3d-nzb+1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 85 )
+
+ nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zw_3d(av), &
+ zw(nzb:nz_do3d), start = (/ 1 /), &
+ count = (/ nz_do3d-nzb+1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 86 )
+
+
+!
+!-- In case of non-flat topography write height information
+ IF ( TRIM( topography ) /= 'flat' ) THEN
+
+ nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zusi_3d(av), &
+ zu_s_inner(0:nx+1,0:ny+1), &
+ start = (/ 1, 1 /), &
+ count = (/ nx+2, ny+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 419 )
+
+ nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_zwwi_3d(av), &
+ zw_w_inner(0:nx+1,0:ny+1), &
+ start = (/ 1, 1 /), &
+ count = (/ nx+2, ny+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 420 )
+
+ ENDIF
+
+ CASE ( '3d_ext' )
+
+!
+!-- Get the list of variables and compare with the actual run.
+!-- First var_list_old has to be reset, since GET_ATT does not assign
+!-- trailing blanks.
+ var_list_old = ' '
+ nc_stat = NF90_GET_ATT( id_set_3d(av), NF90_GLOBAL, 'VAR_LIST', &
+ var_list_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 87 )
+
+ var_list = ';'
+ i = 1
+ DO WHILE ( do3d(av,i)(1:1) /= ' ' )
+ var_list = TRIM(var_list) // TRIM( do3d(av,i) ) // ';'
+ i = i + 1
+ ENDDO
+
+ IF ( av == 0 ) THEN
+ var = '(3d)'
+ ELSE
+ var = '(3d_av)'
+ ENDIF
+
+ IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for volume data ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended due to' // &
+ ' variable mismatch.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Get and compare the number of vertical gridpoints
+ nc_stat = NF90_INQ_VARID( id_set_3d(av), 'zu_3d', id_var_zu_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 88 )
+
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_zu_3d(av), &
+ dimids = id_dim_zu_3d_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 89 )
+ id_dim_zu_3d(av) = id_dim_zu_3d_old(1)
+
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_zu_3d(av), &
+ len = nz_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 90 )
+
+ IF ( nz_do3d-nzb+1 /= nz_old ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for volume data ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended due to' // &
+ ' mismatch in number of'
+ PRINT*, ' vertical grid points (nz_do3d).'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Get the id of the time coordinate (unlimited coordinate) and its
+!-- last index on the file. The next time level is pl3d..count+1.
+!-- The current time must be larger than the last output time
+!-- on the file.
+ nc_stat = NF90_INQ_VARID( id_set_3d(av), 'time', id_var_time_3d(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 91 )
+
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set_3d(av), id_var_time_3d(av), &
+ dimids = id_dim_time_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 92 )
+ id_dim_time_3d(av) = id_dim_time_old(1)
+
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set_3d(av), id_dim_time_3d(av), &
+ len = do3d_time_count(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 93 )
+
+ nc_stat = NF90_GET_VAR( id_set_3d(av), id_var_time_3d(av), &
+ last_time_coordinate, &
+ start = (/ do3d_time_count(av) /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 94 )
+
+ IF ( last_time_coordinate(1) >= simulated_time ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for volume data ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended becaus' // &
+ 'e the current output time'
+ PRINT*, ' is less or equal than the last output t' // &
+ 'ime on this file.'
+ PRINT*, ' New file is created instead.'
+ do3d_time_count(av) = 0
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Dataset seems to be extendable.
+!-- Now get the variable ids.
+ i = 1
+ DO WHILE ( do3d(av,i)(1:1) /= ' ' )
+ nc_stat = NF90_INQ_VARID( id_set_3d(av), TRIM( do3d(av,i) ), &
+ id_var_do3d(av,i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 95 )
+ i = i + 1
+ ENDDO
+
+!
+!-- Change the titel attribute on file
+ nc_stat = NF90_PUT_ATT( id_set_3d(av), NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 96 )
+ PRINT*, '*** NetCDF file for volume data ' // TRIM( var ) // &
+ ' from previous run found.'
+ PRINT*, ' This file will be extended.'
+
+
+ CASE ( 'xy_new' )
+
+!
+!-- Define some global attributes of the dataset
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'Conventions', &
+ 'COARDS' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 97 )
+
+ IF ( av == 0 ) THEN
+ time_average_text = ' '
+ ELSE
+ WRITE (time_average_text, '('', '',F7.1,'' s average'')') &
+ averaging_interval
+ ENDIF
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) // &
+ TRIM( time_average_text ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 98 )
+ IF ( av == 1 ) THEN
+ WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'time_avg', &
+ TRIM( time_average_text ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 98 )
+ ENDIF
+
+!
+!-- Define time coordinate for xy sections (unlimited dimension)
+ nc_stat = NF90_DEF_DIM( id_set_xy(av), 'time', NF90_UNLIMITED, &
+ id_dim_time_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 99 )
+
+ nc_stat = NF90_DEF_VAR( id_set_xy(av), 'time', NF90_DOUBLE, &
+ id_dim_time_xy(av), id_var_time_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 100 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_time_xy(av), 'units', &
+ 'seconds')
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 101 )
+
+!
+!-- Define the spatial dimensions and coordinates for xy-sections.
+!-- First, determine the number of horizontal sections to be written.
+ IF ( section(1,1) == -9999 ) THEN
+ RETURN
+ ELSE
+ ns = 1
+ DO WHILE ( section(ns,1) /= -9999 .AND. ns <= 100 )
+ ns = ns + 1
+ ENDDO
+ ns = ns - 1
+ ENDIF
+
+!
+!-- Define vertical coordinate grid (zu grid)
+ nc_stat = NF90_DEF_DIM( id_set_xy(av), 'zu_xy', ns, id_dim_zu_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 102 )
+
+ nc_stat = NF90_DEF_VAR( id_set_xy(av), 'zu_xy', NF90_DOUBLE, &
+ id_dim_zu_xy(av), id_var_zu_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 103 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zu_xy(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 104 )
+
+!
+!-- Define vertical coordinate grid (zw grid)
+ nc_stat = NF90_DEF_DIM( id_set_xy(av), 'zw_xy', ns, id_dim_zw_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 105 )
+
+ nc_stat = NF90_DEF_VAR( id_set_xy(av), 'zw_xy', NF90_DOUBLE, &
+ id_dim_zw_xy(av), id_var_zw_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 106 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zw_xy(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 107 )
+
+!
+!-- Define a pseudo vertical coordinate grid for the surface variables
+!-- u* and t* to store their height level
+ nc_stat = NF90_DEF_DIM( id_set_xy(av), 'zu1_xy', 1, &
+ id_dim_zu1_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 108 )
+
+ nc_stat = NF90_DEF_VAR( id_set_xy(av), 'zu1_xy', NF90_DOUBLE, &
+ id_dim_zu1_xy(av), id_var_zu1_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 109 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zu1_xy(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 110 )
+
+!
+!-- Define a variable to store the layer indices of the horizontal cross
+!-- sections, too
+ nc_stat = NF90_DEF_VAR( id_set_xy(av), 'ind_z_xy', NF90_DOUBLE, &
+ id_dim_zu_xy(av), id_var_ind_z_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 111 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_ind_z_xy(av), 'units', &
+ 'gridpoints')
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 112 )
+
+!
+!-- Define x-axis (for scalar position)
+ nc_stat = NF90_DEF_DIM( id_set_xy(av), 'x', nx+2, id_dim_x_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 113 )
+
+ nc_stat = NF90_DEF_VAR( id_set_xy(av), 'x', NF90_DOUBLE, &
+ id_dim_x_xy(av), id_var_x_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 114 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_x_xy(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 115 )
+
+!
+!-- Define x-axis (for u position)
+ nc_stat = NF90_DEF_DIM( id_set_xy(av), 'xu', nx+2, id_dim_xu_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 388 )
+
+ nc_stat = NF90_DEF_VAR( id_set_xy(av), 'xu', NF90_DOUBLE, &
+ id_dim_xu_xy(av), id_var_xu_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 389 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_xu_xy(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 390 )
+
+!
+!-- Define y-axis (for scalar position)
+ nc_stat = NF90_DEF_DIM( id_set_xy(av), 'y', ny+2, id_dim_y_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 116 )
+
+ nc_stat = NF90_DEF_VAR( id_set_xy(av), 'y', NF90_DOUBLE, &
+ id_dim_y_xy(av), id_var_y_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 117 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_y_xy(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 118 )
+
+!
+!-- Define y-axis (for scalar position)
+ nc_stat = NF90_DEF_DIM( id_set_xy(av), 'yv', ny+2, id_dim_yv_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 364 )
+
+ nc_stat = NF90_DEF_VAR( id_set_xy(av), 'yv', NF90_DOUBLE, &
+ id_dim_yv_xy(av), id_var_yv_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 365 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_yv_xy(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 366 )
+
+!
+!-- In case of non-flat topography define 2d-arrays containing the height
+!-- informations
+ IF ( TRIM( topography ) /= 'flat' ) THEN
+!
+!-- Define zusi = zu(nzb_s_inner)
+ nc_stat = NF90_DEF_VAR( id_set_xy(av), 'zusi', NF90_DOUBLE, &
+ (/ id_dim_x_xy(av), id_dim_y_xy(av) /), &
+ id_var_zusi_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 421 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zusi_xy(av), &
+ 'units', 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 422 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zusi_xy(av), &
+ 'long_name', 'zu(nzb_s_inner)' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 423 )
+
+!
+!-- Define zwwi = zw(nzb_w_inner)
+ nc_stat = NF90_DEF_VAR( id_set_xy(av), 'zwwi', NF90_DOUBLE, &
+ (/ id_dim_x_xy(av), id_dim_y_xy(av) /), &
+ id_var_zwwi_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 424 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zwwi_xy(av), &
+ 'units', 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 425 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_zwwi_xy(av), &
+ 'long_name', 'zw(nzb_w_inner)' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 426 )
+
+ ENDIF
+
+
+!
+!-- Define the variables
+ var_list = ';'
+ i = 1
+
+ DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+
+ IF ( INDEX( do2d(av,i), 'xy' ) /= 0 ) THEN
+!
+!-- If there is a star in the variable name (u* or t*), it is a
+!-- surface variable. Define it with id_dim_zu1_xy.
+ IF ( INDEX( do2d(av,i), '*' ) /= 0 ) THEN
+!
+!-- First, remove those characters not allowed by NetCDF
+ netcdf_var_name = do2d(av,i)
+ CALL clean_netcdf_varname( netcdf_var_name )
+
+ nc_stat = NF90_DEF_VAR( id_set_xy(av), netcdf_var_name, &
+ nc_precision(1), &
+ (/ id_dim_x_xy(av), id_dim_y_xy(av),&
+ id_dim_zu1_xy(av), &
+ id_dim_time_xy(av) /), &
+ id_var_do2d(av,i) )
+
+ var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+
+ ELSE
+
+!
+!-- Check for the grid
+ found = .TRUE.
+ SELECT CASE ( do2d(av,i) )
+!
+!-- Most variables are defined on the zu grid
+ CASE ( 'e_xy', 'p_xy', 'pc_xy', 'pr_xy', 'pt_xy', 'q_xy',&
+ 'ql_xy', 'ql_c_xy', 'ql_v_xy', 'ql_vp_xy', &
+ 'qv_xy', 'rho_xy', 's_xy', 'sa_xy', 'vpt_xy' )
+
+ grid_x = 'x'
+ grid_y = 'y'
+ grid_z = 'zu'
+!
+!-- u grid
+ CASE ( 'u_xy' )
+
+ grid_x = 'xu'
+ grid_y = 'y'
+ grid_z = 'zu'
+!
+!-- v grid
+ CASE ( 'v_xy' )
+
+ grid_x = 'x'
+ grid_y = 'yv'
+ grid_z = 'zu'
+!
+!-- w grid
+ CASE ( 'w_xy' )
+
+ grid_x = 'x'
+ grid_y = 'y'
+ grid_z = 'zw'
+
+ CASE DEFAULT
+!
+!-- Check for user-defined quantities
+ CALL user_define_netcdf_grid( do2d(av,i), found, &
+ grid_x, grid_y, grid_z )
+
+ END SELECT
+
+!
+!-- Select the respective dimension ids
+ IF ( grid_x == 'x' ) THEN
+ id_x = id_dim_x_xy(av)
+ ELSEIF ( grid_x == 'xu' ) THEN
+ id_x = id_dim_xu_xy(av)
+ ENDIF
+
+ IF ( grid_y == 'y' ) THEN
+ id_y = id_dim_y_xy(av)
+ ELSEIF ( grid_y == 'yv' ) THEN
+ id_y = id_dim_yv_xy(av)
+ ENDIF
+
+ IF ( grid_z == 'zu' ) THEN
+ id_z = id_dim_zu_xy(av)
+ ELSEIF ( grid_z == 'zw' ) THEN
+ id_z = id_dim_zw_xy(av)
+ ENDIF
+
+!
+!-- Define the grid
+ nc_stat = NF90_DEF_VAR( id_set_xy(av), do2d(av,i), &
+ nc_precision(1), &
+ (/ id_x, id_y, id_z, id_dim_time_xy(av) /), &
+ id_var_do2d(av,i) )
+
+ IF ( .NOT. found ) THEN
+ PRINT*, '+++ define_netcdf_header: no grid defined ', &
+ 'for variable ', do2d(av,i)
+ ENDIF
+
+ var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
+
+ ENDIF
+
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 119 )
+!
+!-- Store the 'real' name of the variable (with *, for example)
+!-- in the long_name attribute. This is evaluated by Ferret,
+!-- for example.
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_do2d(av,i), &
+ 'long_name', do2d(av,i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 120 )
+!
+!-- Define the variable's unit
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), id_var_do2d(av,i), &
+ 'units', TRIM( do2d_unit(av,i) ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 354 )
+ ENDIF
+
+ i = i + 1
+
+ ENDDO
+
+!
+!-- No arrays to output. Close the netcdf file and return.
+ IF ( i == 1 ) RETURN
+
+!
+!-- Write the list of variables as global attribute (this is used by
+!-- restart runs and by combine_plot_fields)
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', &
+ var_list )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 121 )
+
+!
+!-- Leave NetCDF define mode
+ nc_stat = NF90_ENDDEF( id_set_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 122 )
+
+!
+!-- Write axis data: z_xy, x, y
+ ALLOCATE( netcdf_data(1:ns) )
+
+!
+!-- Write zu data
+ DO i = 1, ns
+ IF( section(i,1) == -1 ) THEN
+ netcdf_data(i) = -1.0 ! section averaged along z
+ ELSE
+ netcdf_data(i) = zu( section(i,1) )
+ ENDIF
+ ENDDO
+ nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu_xy(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ ns /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 123 )
+
+!
+!-- Write zw data
+ DO i = 1, ns
+ IF( section(i,1) == -1 ) THEN
+ netcdf_data(i) = -1.0 ! section averaged along z
+ ELSE
+ netcdf_data(i) = zw( section(i,1) )
+ ENDIF
+ ENDDO
+ nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zw_xy(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ ns /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 124 )
+
+!
+!-- Write gridpoint number data
+ netcdf_data(1:ns) = section(1:ns,1)
+ nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_ind_z_xy(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ ns /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 125 )
+
+ DEALLOCATE( netcdf_data )
+
+!
+!-- Write the cross section height u*, t*
+ nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zu1_xy(av), &
+ (/ zu(nzb+1) /), start = (/ 1 /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 126 )
+
+!
+!-- Write data for x and xu axis (shifted by -dx/2)
+ ALLOCATE( netcdf_data(0:nx+1) )
+
+ DO i = 0, nx+1
+ netcdf_data(i) = i * dx
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_x_xy(av), netcdf_data, &
+ start = (/ 1 /), count = (/ nx+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 127 )
+
+ DO i = 0, nx+1
+ netcdf_data(i) = ( i - 0.5 ) * dx
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_xu_xy(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ nx+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 367 )
+
+ DEALLOCATE( netcdf_data )
+
+!
+!-- Write data for y and yv axis (shifted by -dy/2)
+ ALLOCATE( netcdf_data(0:ny+1) )
+
+ DO i = 0, ny+1
+ netcdf_data(i) = i * dy
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_y_xy(av), netcdf_data, &
+ start = (/ 1 /), count = (/ ny+2 /))
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 128 )
+
+ DO i = 0, ny+1
+ netcdf_data(i) = ( i - 0.5 ) * dy
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_yv_xy(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ ny+2 /))
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 368 )
+
+ DEALLOCATE( netcdf_data )
+
+!
+!-- In case of non-flat topography write height information
+ IF ( TRIM( topography ) /= 'flat' ) THEN
+
+ nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zusi_xy(av), &
+ zu_s_inner(0:nx+1,0:ny+1), &
+ start = (/ 1, 1 /), &
+ count = (/ nx+2, ny+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 427 )
+
+ nc_stat = NF90_PUT_VAR( id_set_xy(av), id_var_zwwi_xy(av), &
+ zw_w_inner(0:nx+1,0:ny+1), &
+ start = (/ 1, 1 /), &
+ count = (/ nx+2, ny+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 428 )
+
+ ENDIF
+
+
+ CASE ( 'xy_ext' )
+
+!
+!-- Get the list of variables and compare with the actual run.
+!-- First var_list_old has to be reset, since GET_ATT does not assign
+!-- trailing blanks.
+ var_list_old = ' '
+ nc_stat = NF90_GET_ATT( id_set_xy(av), NF90_GLOBAL, 'VAR_LIST', &
+ var_list_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 129 )
+
+ var_list = ';'
+ i = 1
+ DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+ IF ( INDEX( do2d(av,i), 'xy' ) /= 0 ) THEN
+ netcdf_var_name = do2d(av,i)
+ CALL clean_netcdf_varname( netcdf_var_name )
+ var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+ ENDIF
+ i = i + 1
+ ENDDO
+
+ IF ( av == 0 ) THEN
+ var = '(xy)'
+ ELSE
+ var = '(xy_av)'
+ ENDIF
+
+ IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended due to' // &
+ ' variable mismatch.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Calculate the number of current sections
+ ns = 1
+ DO WHILE ( section(ns,1) /= -9999 .AND. ns <= 100 )
+ ns = ns + 1
+ ENDDO
+ ns = ns - 1
+
+!
+!-- Get and compare the number of horizontal cross sections
+ nc_stat = NF90_INQ_VARID( id_set_xy(av), 'zu_xy', id_var_zu_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 130 )
+
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_zu_xy(av), &
+ dimids = id_dim_zu_xy_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 131 )
+ id_dim_zu_xy(av) = id_dim_zu_xy_old(1)
+
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_zu_xy(av), &
+ len = ns_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 132 )
+
+ IF ( ns /= ns_old ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended due to' // &
+ ' mismatch in number of'
+ PRINT*, ' cross sections.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Get and compare the heights of the cross sections
+ ALLOCATE( netcdf_data(1:ns_old) )
+
+ nc_stat = NF90_GET_VAR( id_set_xy(av), id_var_zu_xy(av), netcdf_data )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 133 )
+
+ DO i = 1, ns
+ IF ( section(i,1) /= -1 ) THEN
+ IF ( zu(section(i,1)) /= netcdf_data(i) ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended' // &
+ ' due to mismatch in cross'
+ PRINT*, ' section levels.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+ ELSE
+ IF ( -1.0 /= netcdf_data(i) ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended' // &
+ ' due to mismatch in cross'
+ PRINT*, ' section levels.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+ ENDIF
+ ENDDO
+
+ DEALLOCATE( netcdf_data )
+
+!
+!-- Get the id of the time coordinate (unlimited coordinate) and its
+!-- last index on the file. The next time level is do2d..count+1.
+!-- The current time must be larger than the last output time
+!-- on the file.
+ nc_stat = NF90_INQ_VARID( id_set_xy(av), 'time', id_var_time_xy(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 134 )
+
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set_xy(av), id_var_time_xy(av), &
+ dimids = id_dim_time_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 135 )
+ id_dim_time_xy(av) = id_dim_time_old(1)
+
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set_xy(av), id_dim_time_xy(av), &
+ len = do2d_xy_time_count(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 136 )
+
+ nc_stat = NF90_GET_VAR( id_set_xy(av), id_var_time_xy(av), &
+ last_time_coordinate, &
+ start = (/ do2d_xy_time_count(av) /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 137 )
+
+ IF ( last_time_coordinate(1) >= simulated_time ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for cross sections ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended becaus' // &
+ 'e the current output time'
+ PRINT*, ' is less or equal than the last output t' // &
+ 'ime on this file.'
+ PRINT*, ' New file is created instead.'
+ do2d_xy_time_count(av) = 0
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Dataset seems to be extendable.
+!-- Now get the variable ids.
+ i = 1
+ DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+ IF ( INDEX( do2d(av,i), 'xy' ) /= 0 ) THEN
+ netcdf_var_name = do2d(av,i)
+ CALL clean_netcdf_varname( netcdf_var_name )
+ nc_stat = NF90_INQ_VARID( id_set_xy(av), netcdf_var_name, &
+ id_var_do2d(av,i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 138 )
+ ENDIF
+ i = i + 1
+ ENDDO
+
+!
+!-- Change the titel attribute on file
+ nc_stat = NF90_PUT_ATT( id_set_xy(av), NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 139 )
+ PRINT*, '*** NetCDF file for cross-sections ' // TRIM( var ) // &
+ ' from previous run found.'
+ PRINT*, ' This file will be extended.'
+
+
+ CASE ( 'xz_new' )
+
+!
+!-- Define some global attributes of the dataset
+ nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'Conventions', &
+ 'COARDS' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 140 )
+
+ IF ( av == 0 ) THEN
+ time_average_text = ' '
+ ELSE
+ WRITE (time_average_text, '('', '',F7.1,'' s average'')') &
+ averaging_interval
+ ENDIF
+ nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) // &
+ TRIM( time_average_text ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 141 )
+ IF ( av == 1 ) THEN
+ WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval
+ nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'time_avg', &
+ TRIM( time_average_text ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 141 )
+ ENDIF
+
+!
+!-- Define time coordinate for xz sections (unlimited dimension)
+ nc_stat = NF90_DEF_DIM( id_set_xz(av), 'time', NF90_UNLIMITED, &
+ id_dim_time_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 142 )
+
+ nc_stat = NF90_DEF_VAR( id_set_xz(av), 'time', NF90_DOUBLE, &
+ id_dim_time_xz(av), id_var_time_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 143 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_time_xz(av), 'units', &
+ 'seconds')
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 144 )
+
+!
+!-- Define the spatial dimensions and coordinates for xz-sections.
+!-- First, determine the number of vertical sections to be written.
+ IF ( section(1,2) == -9999 ) THEN
+ RETURN
+ ELSE
+ ns = 1
+ DO WHILE ( section(ns,2) /= -9999 .AND. ns <= 100 )
+ ns = ns + 1
+ ENDDO
+ ns = ns - 1
+ ENDIF
+
+!
+!-- Define y-axis (for scalar position)
+ nc_stat = NF90_DEF_DIM( id_set_xz(av), 'y_xz', ns, id_dim_y_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 145 )
+
+ nc_stat = NF90_DEF_VAR( id_set_xz(av), 'y_xz', NF90_DOUBLE, &
+ id_dim_y_xz(av), id_var_y_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 146 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_y_xz(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 147 )
+
+!
+!-- Define y-axis (for v position)
+ nc_stat = NF90_DEF_DIM( id_set_xz(av), 'yv_xz', ns, id_dim_yv_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 369 )
+
+ nc_stat = NF90_DEF_VAR( id_set_xz(av), 'yv_xz', NF90_DOUBLE, &
+ id_dim_yv_xz(av), id_var_yv_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 370 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_yv_xz(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 371 )
+
+!
+!-- Define a variable to store the layer indices of the vertical cross
+!-- sections
+ nc_stat = NF90_DEF_VAR( id_set_xz(av), 'ind_y_xz', NF90_DOUBLE, &
+ id_dim_y_xz(av), id_var_ind_y_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 148 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_ind_y_xz(av), 'units', &
+ 'gridpoints')
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 149 )
+
+!
+!-- Define x-axis (for scalar position)
+ nc_stat = NF90_DEF_DIM( id_set_xz(av), 'x', nx+2, id_dim_x_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 150 )
+
+ nc_stat = NF90_DEF_VAR( id_set_xz(av), 'x', NF90_DOUBLE, &
+ id_dim_x_xz(av), id_var_x_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 151 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_x_xz(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 152 )
+
+!
+!-- Define x-axis (for u position)
+ nc_stat = NF90_DEF_DIM( id_set_xz(av), 'xu', nx+2, id_dim_xu_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 372 )
+
+ nc_stat = NF90_DEF_VAR( id_set_xz(av), 'xu', NF90_DOUBLE, &
+ id_dim_xu_xz(av), id_var_xu_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 373 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_xu_xz(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 374 )
+
+!
+!-- Define the two z-axes (zu and zw)
+ nc_stat = NF90_DEF_DIM( id_set_xz(av), 'zu', nz+2, id_dim_zu_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 153 )
+
+ nc_stat = NF90_DEF_VAR( id_set_xz(av), 'zu', NF90_DOUBLE, &
+ id_dim_zu_xz(av), id_var_zu_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 154 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_zu_xz(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 155 )
+
+ nc_stat = NF90_DEF_DIM( id_set_xz(av), 'zw', nz+2, id_dim_zw_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 156 )
+
+ nc_stat = NF90_DEF_VAR( id_set_xz(av), 'zw', NF90_DOUBLE, &
+ id_dim_zw_xz(av), id_var_zw_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 157 )
+
+ nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_zw_xz(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 158 )
+
+
+!
+!-- Define the variables
+ var_list = ';'
+ i = 1
+
+ DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+
+ IF ( INDEX( do2d(av,i), 'xz' ) /= 0 ) THEN
+
+!
+!-- Check for the grid
+ found = .TRUE.
+ SELECT CASE ( do2d(av,i) )
+!
+!-- Most variables are defined on the zu grid
+ CASE ( 'e_xz', 'p_xz', 'pc_xz', 'pr_xz', 'pt_xz', 'q_xz', &
+ 'ql_xz', 'ql_c_xz', 'ql_v_xz', 'ql_vp_xz', 'qv_xz', &
+ 'rho_xz', 's_xz', 'sa_xz', 'vpt_xz' )
+
+ grid_x = 'x'
+ grid_y = 'y'
+ grid_z = 'zu'
+!
+!-- u grid
+ CASE ( 'u_xz' )
+
+ grid_x = 'xu'
+ grid_y = 'y'
+ grid_z = 'zu'
+!
+!-- v grid
+ CASE ( 'v_xz' )
+
+ grid_x = 'x'
+ grid_y = 'yv'
+ grid_z = 'zu'
+!
+!-- w grid
+ CASE ( 'w_xz' )
+
+ grid_x = 'x'
+ grid_y = 'y'
+ grid_z = 'zw'
+
+ CASE DEFAULT
+!
+!-- Check for user-defined quantities
+ CALL user_define_netcdf_grid( do2d(av,i), found, &
+ grid_x, grid_y, grid_z )
+
+ END SELECT
+
+!
+!-- Select the respective dimension ids
+ IF ( grid_x == 'x' ) THEN
+ id_x = id_dim_x_xz(av)
+ ELSEIF ( grid_x == 'xu' ) THEN
+ id_x = id_dim_xu_xz(av)
+ ENDIF
+
+ IF ( grid_y == 'y' ) THEN
+ id_y = id_dim_y_xz(av)
+ ELSEIF ( grid_y == 'yv' ) THEN
+ id_y = id_dim_yv_xz(av)
+ ENDIF
+
+ IF ( grid_z == 'zu' ) THEN
+ id_z = id_dim_zu_xz(av)
+ ELSEIF ( grid_z == 'zw' ) THEN
+ id_z = id_dim_zw_xz(av)
+ ENDIF
+
+!
+!-- Define the grid
+ nc_stat = NF90_DEF_VAR( id_set_xz(av), do2d(av,i), &
+ nc_precision(2), &
+ (/ id_x, id_y, id_z, id_dim_time_xz(av) /), &
+ id_var_do2d(av,i) )
+
+ IF ( .NOT. found ) THEN
+ PRINT*, '+++ define_netcdf_header: no grid defined for', &
+ ' variable ', do2d(av,i)
+ ENDIF
+
+ var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
+
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 159 )
+!
+!-- Store the 'real' name of the variable (with *, for example)
+!-- in the long_name attribute. This is evaluated by Ferret,
+!-- for example.
+ nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_do2d(av,i), &
+ 'long_name', do2d(av,i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 160 )
+!
+!-- Define the variable's unit
+ nc_stat = NF90_PUT_ATT( id_set_xz(av), id_var_do2d(av,i), &
+ 'units', TRIM( do2d_unit(av,i) ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 355 )
+ ENDIF
+
+ i = i + 1
+
+ ENDDO
+
+!
+!-- No arrays to output. Close the netcdf file and return.
+ IF ( i == 1 ) RETURN
+
+!
+!-- Write the list of variables as global attribute (this is used by
+!-- restart runs and by combine_plot_fields)
+ nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', &
+ var_list )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 161 )
+
+!
+!-- Leave NetCDF define mode
+ nc_stat = NF90_ENDDEF( id_set_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 162 )
+
+!
+!-- Write axis data: y_xz, x, zu, zw
+ ALLOCATE( netcdf_data(1:ns) )
+
+!
+!-- Write y_xz data
+ DO i = 1, ns
+ IF( section(i,2) == -1 ) THEN
+ netcdf_data(i) = -1.0 ! section averaged along y
+ ELSE
+ netcdf_data(i) = section(i,2) * dy
+ ENDIF
+ ENDDO
+ nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_y_xz(av), netcdf_data, &
+ start = (/ 1 /), count = (/ ns /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 163 )
+
+!
+!-- Write yv_xz data
+ DO i = 1, ns
+ IF( section(i,2) == -1 ) THEN
+ netcdf_data(i) = -1.0 ! section averaged along y
+ ELSE
+ netcdf_data(i) = ( section(i,2) - 0.5 ) * dy
+ ENDIF
+ ENDDO
+ nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_yv_xz(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ ns /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 375 )
+
+!
+!-- Write gridpoint number data
+ netcdf_data(1:ns) = section(1:ns,2)
+ nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_ind_y_xz(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ ns /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 164 )
+
+ DEALLOCATE( netcdf_data )
+
+!
+!-- Write data for x and xu axis (shifted by -dx/2)
+ ALLOCATE( netcdf_data(0:nx+1) )
+
+ DO i = 0, nx+1
+ netcdf_data(i) = i * dx
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_x_xz(av), netcdf_data, &
+ start = (/ 1 /), count = (/ nx+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 165 )
+
+ DO i = 0, nx+1
+ netcdf_data(i) = ( i - 0.5 ) * dx
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_xu_xz(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ nx+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 376 )
+
+ DEALLOCATE( netcdf_data )
+
+!
+!-- Write zu and zw data (vertical axes)
+ ALLOCATE( netcdf_data(0:nz+1) )
+
+ netcdf_data(0:nz+1) = zu(nzb:nzt+1)
+ nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zu_xz(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ nz+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 166 )
+
+ netcdf_data(0:nz+1) = zw(nzb:nzt+1)
+ nc_stat = NF90_PUT_VAR( id_set_xz(av), id_var_zw_xz(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ nz+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 167 )
+
+ DEALLOCATE( netcdf_data )
+
+
+ CASE ( 'xz_ext' )
+
+!
+!-- Get the list of variables and compare with the actual run.
+!-- First var_list_old has to be reset, since GET_ATT does not assign
+!-- trailing blanks.
+ var_list_old = ' '
+ nc_stat = NF90_GET_ATT( id_set_xz(av), NF90_GLOBAL, 'VAR_LIST', &
+ var_list_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 168 )
+
+ var_list = ';'
+ i = 1
+ DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+ IF ( INDEX( do2d(av,i), 'xz' ) /= 0 ) THEN
+ netcdf_var_name = do2d(av,i)
+ CALL clean_netcdf_varname( netcdf_var_name )
+ var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+ ENDIF
+ i = i + 1
+ ENDDO
+
+ IF ( av == 0 ) THEN
+ var = '(xz)'
+ ELSE
+ var = '(xz_av)'
+ ENDIF
+
+ IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended due to' // &
+ ' variable mismatch.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Calculate the number of current sections
+ ns = 1
+ DO WHILE ( section(ns,2) /= -9999 .AND. ns <= 100 )
+ ns = ns + 1
+ ENDDO
+ ns = ns - 1
+
+!
+!-- Get and compare the number of vertical cross sections
+ nc_stat = NF90_INQ_VARID( id_set_xz(av), 'y_xz', id_var_y_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 169 )
+
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_y_xz(av), &
+ dimids = id_dim_y_xz_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 170 )
+ id_dim_y_xz(av) = id_dim_y_xz_old(1)
+
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_y_xz(av), &
+ len = ns_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 171 )
+
+ IF ( ns /= ns_old ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended due to' // &
+ ' mismatch in number of'
+ PRINT*, ' cross sections.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Get and compare the heights of the cross sections
+ ALLOCATE( netcdf_data(1:ns_old) )
+
+ nc_stat = NF90_GET_VAR( id_set_xz(av), id_var_y_xz(av), netcdf_data )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 172 )
+
+ DO i = 1, ns
+ IF ( section(i,2) /= -1 ) THEN
+ IF ( ( section(i,2) * dy ) /= netcdf_data(i) ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended' // &
+ ' due to mismatch in cross'
+ PRINT*, ' section indices.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+ ELSE
+ IF ( -1.0 /= netcdf_data(i) ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended' // &
+ ' due to mismatch in cross'
+ PRINT*, ' section indices.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+ ENDIF
+ ENDDO
+
+ DEALLOCATE( netcdf_data )
+
+!
+!-- Get the id of the time coordinate (unlimited coordinate) and its
+!-- last index on the file. The next time level is do2d..count+1.
+!-- The current time must be larger than the last output time
+!-- on the file.
+ nc_stat = NF90_INQ_VARID( id_set_xz(av), 'time', id_var_time_xz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 173 )
+
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set_xz(av), id_var_time_xz(av), &
+ dimids = id_dim_time_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 174 )
+ id_dim_time_xz(av) = id_dim_time_old(1)
+
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set_xz(av), id_dim_time_xz(av), &
+ len = do2d_xz_time_count(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 175 )
+
+ nc_stat = NF90_GET_VAR( id_set_xz(av), id_var_time_xz(av), &
+ last_time_coordinate, &
+ start = (/ do2d_xz_time_count(av) /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 176 )
+
+ IF ( last_time_coordinate(1) >= simulated_time ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for cross sections ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended becaus' // &
+ 'e the current output time'
+ PRINT*, ' is less or equal than the last output t' // &
+ 'ime on this file.'
+ PRINT*, ' New file is created instead.'
+ do2d_xz_time_count(av) = 0
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Dataset seems to be extendable.
+!-- Now get the variable ids.
+ i = 1
+ DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+ IF ( INDEX( do2d(av,i), 'xz' ) /= 0 ) THEN
+ netcdf_var_name = do2d(av,i)
+ CALL clean_netcdf_varname( netcdf_var_name )
+ nc_stat = NF90_INQ_VARID( id_set_xz(av), netcdf_var_name, &
+ id_var_do2d(av,i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 177 )
+ ENDIF
+ i = i + 1
+ ENDDO
+
+!
+!-- Change the titel attribute on file
+ nc_stat = NF90_PUT_ATT( id_set_xz(av), NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 178 )
+ PRINT*, '*** NetCDF file for cross-sections ' // TRIM( var ) // &
+ ' from previous run found.'
+ PRINT*, ' This file will be extended.'
+
+
+ CASE ( 'yz_new' )
+
+!
+!-- Define some global attributes of the dataset
+ nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'Conventions', &
+ 'COARDS' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 179 )
+
+ IF ( av == 0 ) THEN
+ time_average_text = ' '
+ ELSE
+ WRITE (time_average_text, '('', '',F7.1,'' s average'')') &
+ averaging_interval
+ ENDIF
+ nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) // &
+ TRIM( time_average_text ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 180 )
+ IF ( av == 1 ) THEN
+ WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval
+ nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'time_avg', &
+ TRIM( time_average_text ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 180 )
+ ENDIF
+
+!
+!-- Define time coordinate for yz sections (unlimited dimension)
+ nc_stat = NF90_DEF_DIM( id_set_yz(av), 'time', NF90_UNLIMITED, &
+ id_dim_time_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 181 )
+
+ nc_stat = NF90_DEF_VAR( id_set_yz(av), 'time', NF90_DOUBLE, &
+ id_dim_time_yz(av), id_var_time_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 182 )
+
+ nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_time_yz(av), 'units', &
+ 'seconds')
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 183 )
+
+!
+!-- Define the spatial dimensions and coordinates for yz-sections.
+!-- First, determine the number of vertical sections to be written.
+ IF ( section(1,3) == -9999 ) THEN
+ RETURN
+ ELSE
+ ns = 1
+ DO WHILE ( section(ns,3) /= -9999 .AND. ns <= 100 )
+ ns = ns + 1
+ ENDDO
+ ns = ns - 1
+ ENDIF
+
+!
+!-- Define x axis (for scalar position)
+ nc_stat = NF90_DEF_DIM( id_set_yz(av), 'x_yz', ns, id_dim_x_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 184 )
+
+ nc_stat = NF90_DEF_VAR( id_set_yz(av), 'x_yz', NF90_DOUBLE, &
+ id_dim_x_yz(av), id_var_x_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 185 )
+
+ nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_x_yz(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 186 )
+
+!
+!-- Define x axis (for u position)
+ nc_stat = NF90_DEF_DIM( id_set_yz(av), 'xu_yz', ns, id_dim_xu_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 377 )
+
+ nc_stat = NF90_DEF_VAR( id_set_yz(av), 'xu_yz', NF90_DOUBLE, &
+ id_dim_xu_yz(av), id_var_xu_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 378 )
+
+ nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_xu_yz(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 379 )
+
+!
+!-- Define a variable to store the layer indices of the vertical cross
+!-- sections
+ nc_stat = NF90_DEF_VAR( id_set_yz(av), 'ind_x_yz', NF90_DOUBLE, &
+ id_dim_x_yz(av), id_var_ind_x_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 187 )
+
+ nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_ind_x_yz(av), 'units', &
+ 'gridpoints')
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 188 )
+
+!
+!-- Define y-axis (for scalar position)
+ nc_stat = NF90_DEF_DIM( id_set_yz(av), 'y', ny+2, id_dim_y_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 189 )
+
+ nc_stat = NF90_DEF_VAR( id_set_yz(av), 'y', NF90_DOUBLE, &
+ id_dim_y_yz(av), id_var_y_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 190 )
+
+ nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_y_yz(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 191 )
+
+!
+!-- Define y-axis (for v position)
+ nc_stat = NF90_DEF_DIM( id_set_yz(av), 'yv', ny+2, id_dim_yv_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 380 )
+
+ nc_stat = NF90_DEF_VAR( id_set_yz(av), 'yv', NF90_DOUBLE, &
+ id_dim_yv_yz(av), id_var_yv_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 381 )
+
+ nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_yv_yz(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 382 )
+
+!
+!-- Define the two z-axes (zu and zw)
+ nc_stat = NF90_DEF_DIM( id_set_yz(av), 'zu', nz+2, id_dim_zu_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 192 )
+
+ nc_stat = NF90_DEF_VAR( id_set_yz(av), 'zu', NF90_DOUBLE, &
+ id_dim_zu_yz(av), id_var_zu_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 193 )
+
+ nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_zu_yz(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 194 )
+
+ nc_stat = NF90_DEF_DIM( id_set_yz(av), 'zw', nz+2, id_dim_zw_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 195 )
+
+ nc_stat = NF90_DEF_VAR( id_set_yz(av), 'zw', NF90_DOUBLE, &
+ id_dim_zw_yz(av), id_var_zw_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 196 )
+
+ nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_zw_yz(av), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 197 )
+
+
+!
+!-- Define the variables
+ var_list = ';'
+ i = 1
+
+ DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+
+ IF ( INDEX( do2d(av,i), 'yz' ) /= 0 ) THEN
+
+!
+!-- Check for the grid
+ found = .TRUE.
+ SELECT CASE ( do2d(av,i) )
+!
+!-- Most variables are defined on the zu grid
+ CASE ( 'e_yz', 'p_yz', 'pc_yz', 'pr_yz', 'pt_yz', 'q_yz', &
+ 'ql_yz', 'ql_c_yz', 'ql_v_yz', 'ql_vp_yz', 'qv_yz', &
+ 'rho_yz', 's_yz', 'sa_yz', 'vpt_yz' )
+
+ grid_x = 'x'
+ grid_y = 'y'
+ grid_z = 'zu'
+!
+!-- u grid
+ CASE ( 'u_yz' )
+
+ grid_x = 'xu'
+ grid_y = 'y'
+ grid_z = 'zu'
+!
+!-- v grid
+ CASE ( 'v_yz' )
+
+ grid_x = 'x'
+ grid_y = 'yv'
+ grid_z = 'zu'
+!
+!-- w grid
+ CASE ( 'w_yz' )
+
+ grid_x = 'x'
+ grid_y = 'y'
+ grid_z = 'zw'
+
+ CASE DEFAULT
+!
+!-- Check for user-defined quantities
+ CALL user_define_netcdf_grid( do2d(av,i), found, &
+ grid_x, grid_y, grid_z )
+
+ END SELECT
+
+!
+!-- Select the respective dimension ids
+ IF ( grid_x == 'x' ) THEN
+ id_x = id_dim_x_yz(av)
+ ELSEIF ( grid_x == 'xu' ) THEN
+ id_x = id_dim_xu_yz(av)
+ ENDIF
+
+ IF ( grid_y == 'y' ) THEN
+ id_y = id_dim_y_yz(av)
+ ELSEIF ( grid_y == 'yv' ) THEN
+ id_y = id_dim_yv_yz(av)
+ ENDIF
+
+ IF ( grid_z == 'zu' ) THEN
+ id_z = id_dim_zu_yz(av)
+ ELSEIF ( grid_z == 'zw' ) THEN
+ id_z = id_dim_zw_yz(av)
+ ENDIF
+
+!
+!-- Define the grid
+ nc_stat = NF90_DEF_VAR( id_set_yz(av), do2d(av,i), &
+ nc_precision(3), &
+ (/ id_x, id_y, id_z, id_dim_time_yz(av) /), &
+ id_var_do2d(av,i) )
+
+ IF ( .NOT. found ) THEN
+ PRINT*, '+++ define_netcdf_header: no grid defined for', &
+ ' variable ', do2d(av,i)
+ ENDIF
+
+ var_list = TRIM( var_list ) // TRIM( do2d(av,i) ) // ';'
+
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 198 )
+!
+!-- Store the 'real' name of the variable (with *, for example)
+!-- in the long_name attribute. This is evaluated by Ferret,
+!-- for example.
+ nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_do2d(av,i), &
+ 'long_name', do2d(av,i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 199 )
+!
+!-- Define the variable's unit
+ nc_stat = NF90_PUT_ATT( id_set_yz(av), id_var_do2d(av,i), &
+ 'units', TRIM( do2d_unit(av,i) ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 356 )
+ ENDIF
+
+ i = i + 1
+
+ ENDDO
+
+!
+!-- No arrays to output. Close the netcdf file and return.
+ IF ( i == 1 ) RETURN
+
+!
+!-- Write the list of variables as global attribute (this is used by
+!-- restart runs and by combine_plot_fields)
+ nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'VAR_LIST', &
+ var_list )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 200 )
+
+!
+!-- Leave NetCDF define mode
+ nc_stat = NF90_ENDDEF( id_set_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 201 )
+
+!
+!-- Write axis data: x_yz, y, zu, zw
+ ALLOCATE( netcdf_data(1:ns) )
+
+!
+!-- Write x_yz data
+ DO i = 1, ns
+ IF( section(i,3) == -1 ) THEN
+ netcdf_data(i) = -1.0 ! section averaged along x
+ ELSE
+ netcdf_data(i) = section(i,3) * dx
+ ENDIF
+ ENDDO
+ nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_x_yz(av), netcdf_data, &
+ start = (/ 1 /), count = (/ ns /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 202 )
+
+!
+!-- Write x_yz data (xu grid)
+ DO i = 1, ns
+ IF( section(i,3) == -1 ) THEN
+ netcdf_data(i) = -1.0 ! section averaged along x
+ ELSE
+ netcdf_data(i) = (section(i,3)-0.5) * dx
+ ENDIF
+ ENDDO
+ nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_xu_yz(av), netcdf_data, &
+ start = (/ 1 /), count = (/ ns /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 383 )
+
+!
+!-- Write gridpoint number data
+ netcdf_data(1:ns) = section(1:ns,3)
+ nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_ind_x_yz(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ ns /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 203 )
+
+ DEALLOCATE( netcdf_data )
+
+!
+!-- Write data for y and yv axis (shifted by -dy/2)
+ ALLOCATE( netcdf_data(0:ny+1) )
+
+ DO j = 0, ny+1
+ netcdf_data(j) = j * dy
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_y_yz(av), netcdf_data, &
+ start = (/ 1 /), count = (/ ny+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 204 )
+
+ DO j = 0, ny+1
+ netcdf_data(j) = ( j - 0.5 ) * dy
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_yv_yz(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ ny+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 384 )
+
+ DEALLOCATE( netcdf_data )
+
+!
+!-- Write zu and zw data (vertical axes)
+ ALLOCATE( netcdf_data(0:nz+1) )
+
+ netcdf_data(0:nz+1) = zu(nzb:nzt+1)
+ nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_zu_yz(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ nz+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 205 )
+
+ netcdf_data(0:nz+1) = zw(nzb:nzt+1)
+ nc_stat = NF90_PUT_VAR( id_set_yz(av), id_var_zw_yz(av), &
+ netcdf_data, start = (/ 1 /), &
+ count = (/ nz+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 206 )
+
+ DEALLOCATE( netcdf_data )
+
+
+ CASE ( 'yz_ext' )
+
+!
+!-- Get the list of variables and compare with the actual run.
+!-- First var_list_old has to be reset, since GET_ATT does not assign
+!-- trailing blanks.
+ var_list_old = ' '
+ nc_stat = NF90_GET_ATT( id_set_yz(av), NF90_GLOBAL, 'VAR_LIST', &
+ var_list_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 207 )
+
+ var_list = ';'
+ i = 1
+ DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+ IF ( INDEX( do2d(av,i), 'yz' ) /= 0 ) THEN
+ netcdf_var_name = do2d(av,i)
+ CALL clean_netcdf_varname( netcdf_var_name )
+ var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+ ENDIF
+ i = i + 1
+ ENDDO
+
+ IF ( av == 0 ) THEN
+ var = '(yz)'
+ ELSE
+ var = '(yz_av)'
+ ENDIF
+
+ IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended due to' // &
+ ' variable mismatch.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Calculate the number of current sections
+ ns = 1
+ DO WHILE ( section(ns,3) /= -9999 .AND. ns <= 100 )
+ ns = ns + 1
+ ENDDO
+ ns = ns - 1
+
+!
+!-- Get and compare the number of vertical cross sections
+ nc_stat = NF90_INQ_VARID( id_set_yz(av), 'x_yz', id_var_x_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 208 )
+
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set_yz(av), id_var_x_yz(av), &
+ dimids = id_dim_x_yz_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 209 )
+ id_dim_x_yz(av) = id_dim_x_yz_old(1)
+
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set_yz(av), id_dim_x_yz(av), &
+ len = ns_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 210 )
+
+ IF ( ns /= ns_old ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended due to' // &
+ ' mismatch in number of'
+ PRINT*, ' cross sections.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Get and compare the heights of the cross sections
+ ALLOCATE( netcdf_data(1:ns_old) )
+
+ nc_stat = NF90_GET_VAR( id_set_yz(av), id_var_x_yz(av), netcdf_data )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 211 )
+
+ DO i = 1, ns
+ IF ( section(i,3) /= -1 ) THEN
+ IF ( ( section(i,3) * dx ) /= netcdf_data(i) ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended' // &
+ ' due to mismatch in cross'
+ PRINT*, ' section indices.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+ ELSE
+ IF ( -1.0 /= netcdf_data(i) ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for cross-sections ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended' // &
+ ' due to mismatch in cross'
+ PRINT*, ' section indices.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+ ENDIF
+ ENDDO
+
+ DEALLOCATE( netcdf_data )
+
+!
+!-- Get the id of the time coordinate (unlimited coordinate) and its
+!-- last index on the file. The next time level is pl2d..count+1.
+!-- The current time must be larger than the last output time
+!-- on the file.
+ nc_stat = NF90_INQ_VARID( id_set_yz(av), 'time', id_var_time_yz(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 212 )
+
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set_yz(av), id_var_time_yz(av), &
+ dimids = id_dim_time_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 213 )
+ id_dim_time_yz(av) = id_dim_time_old(1)
+
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set_yz(av), id_dim_time_yz(av), &
+ len = do2d_yz_time_count(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 214 )
+
+ nc_stat = NF90_GET_VAR( id_set_yz(av), id_var_time_yz(av), &
+ last_time_coordinate, &
+ start = (/ do2d_yz_time_count(av) /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 215 )
+
+ IF ( last_time_coordinate(1) >= simulated_time ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for cross sections ' // &
+ TRIM( var ) // ' from previuos run found,'
+ PRINT*, ' but this file cannot be extended becaus' // &
+ 'e the current output time'
+ PRINT*, ' is less or equal than the last output t' // &
+ 'ime on this file.'
+ PRINT*, ' New file is created instead.'
+ do2d_yz_time_count(av) = 0
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Dataset seems to be extendable.
+!-- Now get the variable ids.
+ i = 1
+ DO WHILE ( do2d(av,i)(1:1) /= ' ' )
+ IF ( INDEX( do2d(av,i), 'yz' ) /= 0 ) THEN
+ netcdf_var_name = do2d(av,i)
+ CALL clean_netcdf_varname( netcdf_var_name )
+ nc_stat = NF90_INQ_VARID( id_set_yz(av), netcdf_var_name, &
+ id_var_do2d(av,i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 216 )
+ ENDIF
+ i = i + 1
+ ENDDO
+
+!
+!-- Change the titel attribute on file
+ nc_stat = NF90_PUT_ATT( id_set_yz(av), NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 217 )
+ PRINT*, '*** NetCDF file for cross-sections ' // TRIM( var ) // &
+ ' from previous run found.'
+ PRINT*, ' This file will be extended.'
+
+
+ CASE ( 'pr_new' )
+
+!
+!-- Define some global attributes of the dataset
+ IF ( averaging_interval_pr /= 0.0 ) THEN
+ WRITE (time_average_text,'('', '',F7.1,'' s average'')') &
+ averaging_interval_pr
+ nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) // &
+ TRIM( time_average_text ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 218 )
+
+ WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval_pr
+ nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'time_avg', &
+ TRIM( time_average_text ) )
+ ELSE
+ nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 219 )
+
+!
+!-- Define time coordinate for profiles (unlimited dimension)
+ nc_stat = NF90_DEF_DIM( id_set_pr, 'time', NF90_UNLIMITED, &
+ id_dim_time_pr )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 220 )
+
+ nc_stat = NF90_DEF_VAR( id_set_pr, 'time', NF90_DOUBLE, &
+ id_dim_time_pr, id_var_time_pr )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 221 )
+
+ nc_stat = NF90_PUT_ATT( id_set_pr, id_var_time_pr, 'units', 'seconds')
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 222 )
+
+!
+!-- Define the variables
+ var_list = ';'
+ DO i = 1, dopr_n
+!
+!-- First, remove those characters not allowed by NetCDF
+ netcdf_var_name = data_output_pr(i)
+ CALL clean_netcdf_varname( netcdf_var_name )
+
+ IF ( statistic_regions == 0 ) THEN
+
+!
+!-- Define the z-axes (each variable gets its own z-axis)
+ nc_stat = NF90_DEF_DIM( id_set_pr, 'z'//TRIM(netcdf_var_name), &
+ nzt+2-nzb, id_dim_z_pr(i,0) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 223 )
+
+ nc_stat = NF90_DEF_VAR( id_set_pr, 'z'//TRIM(netcdf_var_name), &
+ NF90_DOUBLE, id_dim_z_pr(i,0), &
+ id_var_z_pr(i,0) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 224 )
+
+ nc_stat = NF90_PUT_ATT( id_set_pr, id_var_z_pr(i,0), 'units', &
+ 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 225 )
+
+!
+!-- Define the variable
+ nc_stat = NF90_DEF_VAR( id_set_pr, netcdf_var_name, &
+ nc_precision(5), (/ id_dim_z_pr(i,0), &
+ id_dim_time_pr /), id_var_dopr(i,0) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 226 )
+
+ nc_stat = NF90_PUT_ATT( id_set_pr, id_var_dopr(i,0), &
+ 'long_name', TRIM( data_output_pr(i) ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 227 )
+
+ nc_stat = NF90_PUT_ATT( id_set_pr, id_var_dopr(i,0), &
+ 'units', TRIM( dopr_unit(i) ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 228 )
+
+ var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+
+ ELSE
+!
+!-- If statistic regions are defined, add suffix _SR+#SR to the
+!-- names
+ DO j = 0, statistic_regions
+ WRITE ( suffix, '(''_'',I1)' ) j
+
+!
+!-- Define the z-axes (each variable gets it own z-axis)
+ nc_stat = NF90_DEF_DIM( id_set_pr, &
+ 'z'//TRIM(netcdf_var_name)//suffix, &
+ nzt+2-nzb, id_dim_z_pr(i,j) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 229 )
+
+ nc_stat = NF90_DEF_VAR( id_set_pr, &
+ 'z'//TRIM(netcdf_var_name)//suffix, &
+ nc_precision(5), id_dim_z_pr(i,j), &
+ id_var_z_pr(i,j) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 230 )
+
+ nc_stat = NF90_PUT_ATT( id_set_pr, id_var_z_pr(i,j), &
+ 'units', 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 231 )
+
+!
+!-- Define the variable
+ nc_stat = NF90_DEF_VAR( id_set_pr, &
+ TRIM( netcdf_var_name ) // suffix, &
+ nc_precision(5), &
+ (/ id_dim_z_pr(i,j), &
+ id_dim_time_pr /), id_var_dopr(i,j) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 232 )
+
+ nc_stat = NF90_PUT_ATT( id_set_pr, id_var_dopr(i,j), &
+ 'long_name', &
+ TRIM( data_output_pr(i) ) // ' SR ' &
+ // suffix(2:2) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 233 )
+
+ nc_stat = NF90_PUT_ATT( id_set_pr, id_var_dopr(i,j), &
+ 'units', TRIM( dopr_unit(i) ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 234 )
+
+ var_list = TRIM(var_list) // TRIM(netcdf_var_name) // &
+ suffix // ';'
+
+ ENDDO
+
+ ENDIF
+
+ ENDDO
+
+!
+!-- Write the list of variables as global attribute (this is used by
+!-- restart runs)
+ nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'VAR_LIST', var_list )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 235 )
+
+!
+!-- Define normalization variables (as time series)
+ DO i = 1, dopr_norm_num
+
+ nc_stat = NF90_DEF_VAR( id_set_pr, 'NORM_' // &
+ TRIM( dopr_norm_names(i) ), &
+ nc_precision(5), (/ id_dim_time_pr /), &
+ id_var_norm_dopr(i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 236 )
+
+ nc_stat = NF90_PUT_ATT( id_set_pr, id_var_norm_dopr(i), &
+ 'long_name', &
+ TRIM( dopr_norm_longnames(i) ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 237 )
+
+ ENDDO
+
+!
+!-- Leave NetCDF define mode
+ nc_stat = NF90_ENDDEF( id_set_pr )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 238 )
+
+!
+!-- Write z-axes data
+ DO i = 1, dopr_n
+ DO j = 0, statistic_regions
+
+ nc_stat = NF90_PUT_VAR( id_set_pr, id_var_z_pr(i,j), &
+ hom(nzb:nzt+1,2,dopr_index(i),0), &
+ start = (/ 1 /), &
+ count = (/ nzt-nzb+2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 239 )
+
+ ENDDO
+ ENDDO
+
+
+ CASE ( 'pr_ext' )
+
+!
+!-- Get the list of variables and compare with the actual run.
+!-- First var_list_old has to be reset, since GET_ATT does not assign
+!-- trailing blanks.
+ var_list_old = ' '
+ nc_stat = NF90_GET_ATT( id_set_pr, NF90_GLOBAL, 'VAR_LIST', &
+ var_list_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 240 )
+
+ var_list = ';'
+ DO i = 1, dopr_n
+
+ netcdf_var_name = data_output_pr(i)
+ CALL clean_netcdf_varname( netcdf_var_name )
+
+ IF ( statistic_regions == 0 ) THEN
+ var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+ ELSE
+ DO j = 0, statistic_regions
+ WRITE ( suffix, '(''_'',I1)' ) j
+ var_list = TRIM(var_list) // TRIM(netcdf_var_name) // &
+ suffix // ';'
+ ENDDO
+ ENDIF
+
+ ENDDO
+
+ IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for vertical profiles from' // &
+ ' previuos run found,'
+ PRINT*, ' but this file cannot be extended due to' // &
+ ' variable mismatch.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Get the id of the time coordinate (unlimited coordinate) and its
+!-- last index on the file. The next time level is dopr..count+1.
+!-- The current time must be larger than the last output time
+!-- on the file.
+ nc_stat = NF90_INQ_VARID( id_set_pr, 'time', id_var_time_pr )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 241 )
+
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set_pr, id_var_time_pr, &
+ dimids = id_dim_time_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 242 )
+ id_dim_time_pr = id_dim_time_old(1)
+
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set_pr, id_dim_time_pr, &
+ len = dopr_time_count )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 243 )
+
+ nc_stat = NF90_GET_VAR( id_set_pr, id_var_time_pr, &
+ last_time_coordinate, &
+ start = (/ dopr_time_count /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 244 )
+
+ IF ( last_time_coordinate(1) >= simulated_time ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for vertical profiles from' // &
+ ' previuos run found,'
+ PRINT*, ' but this file cannot be extended becaus' // &
+ 'e the current output time'
+ PRINT*, ' is less or equal than the last output t' // &
+ 'ime on this file.'
+ PRINT*, ' New file is created instead.'
+ dopr_time_count = 0
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Dataset seems to be extendable.
+!-- Now get the variable ids.
+ i = 1
+ DO i = 1, dopr_n
+
+ netcdf_var_name_base = data_output_pr(i)
+ CALL clean_netcdf_varname( netcdf_var_name_base )
+
+ IF ( statistic_regions == 0 ) THEN
+ nc_stat = NF90_INQ_VARID( id_set_pr, netcdf_var_name_base, &
+ id_var_dopr(i,0) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 245 )
+ ELSE
+ DO j = 0, statistic_regions
+ WRITE ( suffix, '(''_'',I1)' ) j
+ netcdf_var_name = TRIM( netcdf_var_name_base ) // suffix
+ nc_stat = NF90_INQ_VARID( id_set_pr, netcdf_var_name, &
+ id_var_dopr(i,j) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 246 )
+ ENDDO
+ ENDIF
+
+ ENDDO
+
+!
+!-- Get ids of the normalization variables
+ DO i = 1, dopr_norm_num
+ nc_stat = NF90_INQ_VARID( id_set_pr, &
+ 'NORM_' // TRIM( dopr_norm_names(i) ), &
+ id_var_norm_dopr(i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 247 )
+ ENDDO
+
+!
+!-- Change the title attribute on file
+ nc_stat = NF90_PUT_ATT( id_set_pr, NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 248 )
+ PRINT*, '*** NetCDF file for vertical profiles from previous run' // &
+ ' found.'
+ PRINT*, ' This file will be extended.'
+
+
+ CASE ( 'ts_new' )
+
+!
+!-- Define some global attributes of the dataset
+ nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 249 )
+
+!
+!-- Define time coordinate for time series (unlimited dimension)
+ nc_stat = NF90_DEF_DIM( id_set_ts, 'time', NF90_UNLIMITED, &
+ id_dim_time_ts )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 250 )
+
+ nc_stat = NF90_DEF_VAR( id_set_ts, 'time', NF90_DOUBLE, &
+ id_dim_time_ts, id_var_time_ts )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 251 )
+
+ nc_stat = NF90_PUT_ATT( id_set_ts, id_var_time_ts, 'units', 'seconds')
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 252 )
+
+!
+!-- Define the variables
+ var_list = ';'
+ DO i = 1, dots_num
+!
+!-- First, remove those characters not allowed by NetCDF
+ netcdf_var_name = dots_label(i)
+ CALL clean_netcdf_varname( netcdf_var_name )
+
+ IF ( statistic_regions == 0 ) THEN
+
+ nc_stat = NF90_DEF_VAR( id_set_ts, netcdf_var_name, &
+ nc_precision(6), (/ id_dim_time_ts /), &
+ id_var_dots(i,0) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 253 )
+
+ nc_stat = NF90_PUT_ATT( id_set_ts, id_var_dots(i,0), &
+ 'long_name', TRIM( dots_label(i) ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 254 )
+
+ nc_stat = NF90_PUT_ATT( id_set_ts, id_var_dots(i,0), &
+ 'units', TRIM( dots_unit(i) ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 255 )
+
+ var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+
+ ELSE
+!
+!-- If statistic regions are defined, add suffix _SR+#SR to the
+!-- names
+ DO j = 0, statistic_regions
+ WRITE ( suffix, '(''_'',I1)' ) j
+
+ nc_stat = NF90_DEF_VAR( id_set_ts, &
+ TRIM( netcdf_var_name ) // suffix, &
+ nc_precision(6), &
+ (/ id_dim_time_ts /), &
+ id_var_dots(i,j) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 256 )
+
+ nc_stat = NF90_PUT_ATT( id_set_ts, id_var_dots(i,j), &
+ 'long_name', &
+ TRIM( dots_label(i) ) // ' SR ' // &
+ suffix(2:2) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 257 )
+
+ var_list = TRIM(var_list) // TRIM(netcdf_var_name) // &
+ suffix // ';'
+
+ ENDDO
+
+ ENDIF
+
+ ENDDO
+
+!
+!-- Write the list of variables as global attribute (this is used by
+!-- restart runs)
+ nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'VAR_LIST', var_list )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 258 )
+
+!
+!-- Leave NetCDF define mode
+ nc_stat = NF90_ENDDEF( id_set_ts )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 259 )
+
+
+ CASE ( 'ts_ext' )
+
+!
+!-- Get the list of variables and compare with the actual run.
+!-- First var_list_old has to be reset, since GET_ATT does not assign
+!-- trailing blanks.
+ var_list_old = ' '
+ nc_stat = NF90_GET_ATT( id_set_ts, NF90_GLOBAL, 'VAR_LIST', &
+ var_list_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 260 )
+
+ var_list = ';'
+ i = 1
+ DO i = 1, dots_num
+
+ netcdf_var_name = dots_label(i)
+ CALL clean_netcdf_varname( netcdf_var_name )
+
+ IF ( statistic_regions == 0 ) THEN
+ var_list = TRIM(var_list) // TRIM(netcdf_var_name) // ';'
+ ELSE
+ DO j = 0, statistic_regions
+ WRITE ( suffix, '(''_'',I1)' ) j
+ var_list = TRIM(var_list) // TRIM(netcdf_var_name) // &
+ suffix // ';'
+ ENDDO
+ ENDIF
+
+ ENDDO
+
+ IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for time series from' //&
+ ' previuos run found,'
+ PRINT*, ' but this file cannot be extended due to' // &
+ ' variable mismatch.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Get the id of the time coordinate (unlimited coordinate) and its
+!-- last index on the file. The next time level is dots..count+1.
+!-- The current time must be larger than the last output time
+!-- on the file.
+ nc_stat = NF90_INQ_VARID( id_set_ts, 'time', id_var_time_ts )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 261 )
+
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set_ts, id_var_time_ts, &
+ dimids = id_dim_time_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 262 )
+ id_dim_time_ts = id_dim_time_old(1)
+
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set_ts, id_dim_time_ts, &
+ len = dots_time_count )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 263 )
+
+ nc_stat = NF90_GET_VAR( id_set_ts, id_var_time_ts, &
+ last_time_coordinate, &
+ start = (/ dots_time_count /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 264 )
+
+ IF ( last_time_coordinate(1) >= simulated_time ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for time series from' // &
+ ' previuos run found,'
+ PRINT*, ' but this file cannot be extended becaus' // &
+ 'e the current output time'
+ PRINT*, ' is less or equal than the last output t' // &
+ 'ime on this file.'
+ PRINT*, ' New file is created instead.'
+ dots_time_count = 0
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Dataset seems to be extendable.
+!-- Now get the variable ids
+ i = 1
+ DO i = 1, dots_num
+
+ netcdf_var_name_base = dots_label(i)
+ CALL clean_netcdf_varname( netcdf_var_name_base )
+
+ IF ( statistic_regions == 0 ) THEN
+ nc_stat = NF90_INQ_VARID( id_set_ts, netcdf_var_name_base, &
+ id_var_dots(i,0) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 265 )
+ ELSE
+ DO j = 0, statistic_regions
+ WRITE ( suffix, '(''_'',I1)' ) j
+ netcdf_var_name = TRIM( netcdf_var_name_base ) // suffix
+ nc_stat = NF90_INQ_VARID( id_set_ts, netcdf_var_name, &
+ id_var_dots(i,j) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 266 )
+ ENDDO
+ ENDIF
+
+ ENDDO
+
+!
+!-- Change the title attribute on file
+ nc_stat = NF90_PUT_ATT( id_set_ts, NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 267 )
+ PRINT*, '*** NetCDF file for time series from previous run found.'
+ PRINT*, ' This file will be extended.'
+
+
+ CASE ( 'sp_new' )
+
+!
+!-- Define some global attributes of the dataset
+ IF ( averaging_interval_sp /= 0.0 ) THEN
+ WRITE (time_average_text,'('', '',F7.1,'' s average'')') &
+ averaging_interval_sp
+ nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) // &
+ TRIM( time_average_text ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 268 )
+
+ WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval_sp
+ nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'time_avg', &
+ TRIM( time_average_text ) )
+ ELSE
+ nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 269 )
+
+!
+!-- Define time coordinate for spectra (unlimited dimension)
+ nc_stat = NF90_DEF_DIM( id_set_sp, 'time', NF90_UNLIMITED, &
+ id_dim_time_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 270 )
+
+ nc_stat = NF90_DEF_VAR( id_set_sp, 'time', NF90_DOUBLE, &
+ id_dim_time_sp, id_var_time_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 271 )
+
+ nc_stat = NF90_PUT_ATT( id_set_sp, id_var_time_sp, 'units', 'seconds')
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 272 )
+
+!
+!-- Define the spatial dimensions and coordinates for spectra.
+!-- First, determine the number of vertical levels for which spectra
+!-- are to be output.
+ ns = 1
+ DO WHILE ( comp_spectra_level(ns) /= 999999 .AND. ns <= 100 )
+ ns = ns + 1
+ ENDDO
+ ns = ns - 1
+
+!
+!-- Define vertical coordinate grid (zu grid)
+ nc_stat = NF90_DEF_DIM( id_set_sp, 'zu_sp', ns, id_dim_zu_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 273 )
+
+ nc_stat = NF90_DEF_VAR( id_set_sp, 'zu_sp', NF90_DOUBLE, &
+ id_dim_zu_sp, id_var_zu_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 274 )
+
+ nc_stat = NF90_PUT_ATT( id_set_sp, id_var_zu_sp, 'units', 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 275 )
+
+!
+!-- Define vertical coordinate grid (zw grid)
+ nc_stat = NF90_DEF_DIM( id_set_sp, 'zw_sp', ns, id_dim_zw_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 276 )
+
+ nc_stat = NF90_DEF_VAR( id_set_sp, 'zw_sp', NF90_DOUBLE, &
+ id_dim_zw_sp, id_var_zw_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 277 )
+
+ nc_stat = NF90_PUT_ATT( id_set_sp, id_var_zw_sp, 'units', 'meters' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 278 )
+
+!
+!-- Define x-axis
+ nc_stat = NF90_DEF_DIM( id_set_sp, 'k_x', nx/2, id_dim_x_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 279 )
+
+ nc_stat = NF90_DEF_VAR( id_set_sp, 'k_x', NF90_DOUBLE, id_dim_x_sp, &
+ id_var_x_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 280 )
+
+ nc_stat = NF90_PUT_ATT( id_set_sp, id_var_x_sp, 'units', 'm-1' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 281 )
+
+!
+!-- Define y-axis
+ nc_stat = NF90_DEF_DIM( id_set_sp, 'k_y', ny/2, id_dim_y_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 282 )
+
+ nc_stat = NF90_DEF_VAR( id_set_sp, 'k_y', NF90_DOUBLE, id_dim_y_sp, &
+ id_var_y_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 283 )
+
+ nc_stat = NF90_PUT_ATT( id_set_sp, id_var_y_sp, 'units', 'm-1' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 284 )
+
+!
+!-- Define the variables
+ var_list = ';'
+ i = 1
+ DO WHILE ( data_output_sp(i) /= ' ' .AND. i <= 10 )
+
+ IF ( INDEX( spectra_direction(i), 'x' ) /= 0 ) THEN
+
+!
+!-- Define the variable
+ netcdf_var_name = TRIM( data_output_sp(i) ) // '_x'
+ IF ( data_output_sp(i) == 'w' ) THEN
+ nc_stat = NF90_DEF_VAR( id_set_sp, netcdf_var_name, &
+ nc_precision(7), (/ id_dim_x_sp, &
+ id_dim_zw_sp, id_dim_time_sp /), &
+ id_var_dospx(i) )
+ ELSE
+ nc_stat = NF90_DEF_VAR( id_set_sp, netcdf_var_name, &
+ nc_precision(7), (/ id_dim_x_sp, &
+ id_dim_zu_sp, id_dim_time_sp /), &
+ id_var_dospx(i) )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 285 )
+
+ nc_stat = NF90_PUT_ATT( id_set_sp, id_var_dospx(i), &
+ 'long_name', netcdf_var_name )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 286 )
+
+ nc_stat = NF90_PUT_ATT( id_set_sp, id_var_dospx(i), &
+ 'units', 'unknown' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 287 )
+
+ var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
+
+ ENDIF
+
+ IF ( INDEX( spectra_direction(i), 'y' ) /= 0 ) THEN
+
+!
+!-- Define the variable
+ netcdf_var_name = TRIM( data_output_sp(i) ) // '_y'
+ IF ( data_output_sp(i) == 'w' ) THEN
+ nc_stat = NF90_DEF_VAR( id_set_sp, netcdf_var_name, &
+ nc_precision(7), (/ id_dim_y_sp, &
+ id_dim_zw_sp, id_dim_time_sp /), &
+ id_var_dospy(i) )
+ ELSE
+ nc_stat = NF90_DEF_VAR( id_set_sp, netcdf_var_name, &
+ nc_precision(7), (/ id_dim_y_sp, &
+ id_dim_zu_sp, id_dim_time_sp /), &
+ id_var_dospy(i) )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 288 )
+
+ nc_stat = NF90_PUT_ATT( id_set_sp, id_var_dospy(i), &
+ 'long_name', netcdf_var_name )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 289 )
+
+ nc_stat = NF90_PUT_ATT( id_set_sp, id_var_dospy(i), &
+ 'units', 'unknown' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 290 )
+
+ var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
+
+ ENDIF
+
+ i = i + 1
+
+ ENDDO
+
+!
+!-- Write the list of variables as global attribute (this is used by
+!-- restart runs)
+ nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'VAR_LIST', var_list )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 291 )
+
+!
+!-- Leave NetCDF define mode
+ nc_stat = NF90_ENDDEF( id_set_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 292 )
+
+!
+!-- Write axis data: zu_sp, zw_sp, k_x, k_y
+ ALLOCATE( netcdf_data(1:ns) )
+
+!
+!-- Write zu data
+ netcdf_data(1:ns) = zu( comp_spectra_level(1:ns) )
+ nc_stat = NF90_PUT_VAR( id_set_sp, id_var_zu_sp, netcdf_data, &
+ start = (/ 1 /), count = (/ ns /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 293 )
+
+!
+!-- Write zw data
+ netcdf_data(1:ns) = zw( comp_spectra_level(1:ns) )
+ nc_stat = NF90_PUT_VAR( id_set_sp, id_var_zw_sp, netcdf_data, &
+ start = (/ 1 /), count = (/ ns /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 294 )
+
+ DEALLOCATE( netcdf_data )
+
+!
+!-- Write data for x and y axis (wavenumbers)
+ ALLOCATE( netcdf_data(nx/2) )
+ DO i = 1, nx/2
+ netcdf_data(i) = 2.0 * pi * i / ( dx * ( nx + 1 ) )
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_sp, id_var_x_sp, netcdf_data, &
+ start = (/ 1 /), count = (/ nx/2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 295 )
+
+ DEALLOCATE( netcdf_data )
+
+ ALLOCATE( netcdf_data(ny/2) )
+ DO i = 1, ny/2
+ netcdf_data(i) = 2.0 * pi * i / ( dy * ( ny + 1 ) )
+ ENDDO
+
+ nc_stat = NF90_PUT_VAR( id_set_sp, id_var_y_sp, netcdf_data, &
+ start = (/ 1 /), count = (/ ny/2 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 296 )
+
+ DEALLOCATE( netcdf_data )
+
+
+ CASE ( 'sp_ext' )
+
+!
+!-- Get the list of variables and compare with the actual run.
+!-- First var_list_old has to be reset, since GET_ATT does not assign
+!-- trailing blanks.
+ var_list_old = ' '
+ nc_stat = NF90_GET_ATT( id_set_sp, NF90_GLOBAL, 'VAR_LIST', &
+ var_list_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 297 )
+
+ var_list = ';'
+ i = 1
+ DO WHILE ( data_output_sp(i) /= ' ' .AND. i <= 10 )
+
+ IF ( INDEX( spectra_direction(i), 'x' ) /= 0 ) THEN
+ netcdf_var_name = TRIM( data_output_sp(i) ) // '_x'
+ var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
+ ENDIF
+
+ IF ( INDEX( spectra_direction(i), 'y' ) /= 0 ) THEN
+ netcdf_var_name = TRIM( data_output_sp(i) ) // '_y'
+ var_list = TRIM( var_list ) // TRIM( netcdf_var_name ) // ';'
+ ENDIF
+
+ i = i + 1
+
+ ENDDO
+
+ IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for spectra from previous ' //&
+ 'run found,'
+ PRINT*, ' but this file cannot be extended due to' // &
+ ' variable mismatch.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Determine the number of current vertical levels for which spectra
+!-- shall be output
+ ns = 1
+ DO WHILE ( comp_spectra_level(ns) /= 999999 .AND. ns <= 100 )
+ ns = ns + 1
+ ENDDO
+ ns = ns - 1
+
+!
+!-- Get and compare the number of vertical levels
+ nc_stat = NF90_INQ_VARID( id_set_sp, 'zu_sp', id_var_zu_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 298 )
+
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set_sp, id_var_zu_sp, &
+ dimids = id_dim_zu_sp_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 299 )
+ id_dim_zu_sp = id_dim_zu_sp_old(1)
+
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set_sp, id_dim_zu_sp, &
+ len = ns_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 300 )
+
+ IF ( ns /= ns_old ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for spectra from previous ' //&
+ 'run found,'
+ PRINT*, ' but this file cannot be extended due to' // &
+ ' mismatch in number of'
+ PRINT*, ' vertical levels.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Get and compare the heights of the cross sections
+ ALLOCATE( netcdf_data(1:ns_old) )
+
+ nc_stat = NF90_GET_VAR( id_set_sp, id_var_zu_sp, netcdf_data )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 301 )
+
+ DO i = 1, ns
+ IF ( zu(comp_spectra_level(i)) /= netcdf_data(i) ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for spectra from previou' // &
+ 's run found,'
+ PRINT*, ' but this file cannot be extended due' // &
+ ' to mismatch in heights'
+ PRINT*, ' of vertical levels.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+ ENDDO
+
+ DEALLOCATE( netcdf_data )
+
+!
+!-- Get the id of the time coordinate (unlimited coordinate) and its
+!-- last index on the file. The next time level is plsp..count+1.
+!-- The current time must be larger than the last output time
+!-- on the file.
+ nc_stat = NF90_INQ_VARID( id_set_sp, 'time', id_var_time_sp )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 302 )
+
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set_sp, id_var_time_sp, &
+ dimids = id_dim_time_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 303 )
+ id_dim_time_sp = id_dim_time_old(1)
+
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set_sp, id_dim_time_sp, &
+ len = dosp_time_count )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 304 )
+
+ nc_stat = NF90_GET_VAR( id_set_sp, id_var_time_sp, &
+ last_time_coordinate, &
+ start = (/ dosp_time_count /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 305 )
+
+ IF ( last_time_coordinate(1) >= simulated_time ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for spectra from previous ' // &
+ 'run found,'
+ PRINT*, ' but this file cannot be extended becaus' // &
+ 'e the current output time'
+ PRINT*, ' is less or equal than the last output t' // &
+ 'ime on this file.'
+ PRINT*, ' New file is created instead.'
+ dosp_time_count = 0
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Dataset seems to be extendable.
+!-- Now get the variable ids.
+ i = 1
+ DO WHILE ( data_output_sp(i) /= ' ' .AND. i <= 10 )
+
+ IF ( INDEX( spectra_direction(i), 'x' ) /= 0 ) THEN
+ netcdf_var_name = TRIM( data_output_sp(i) ) // '_x'
+ nc_stat = NF90_INQ_VARID( id_set_sp, netcdf_var_name, &
+ id_var_dospx(i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 306 )
+ ENDIF
+
+ IF ( INDEX( spectra_direction(i), 'y' ) /= 0 ) THEN
+ netcdf_var_name = TRIM( data_output_sp(i) ) // '_y'
+ nc_stat = NF90_INQ_VARID( id_set_sp, netcdf_var_name, &
+ id_var_dospy(i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 307 )
+ ENDIF
+
+ i = i + 1
+
+ ENDDO
+
+!
+!-- Change the titel attribute on file
+ IF ( averaging_interval_sp /= 0.0 ) THEN
+ WRITE (time_average_text,'('', '',F7.1,'' s average'')') &
+ averaging_interval_sp
+ nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) // &
+ TRIM( time_average_text ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 308 )
+
+ WRITE ( time_average_text,'(F7.1,'' s avg'')' ) averaging_interval_sp
+ nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'time_avg', &
+ TRIM( time_average_text ) )
+ ELSE
+ nc_stat = NF90_PUT_ATT( id_set_sp, NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 309 )
+
+ PRINT*, '*** NetCDF file for spectra from previous run found.'
+ PRINT*, ' This file will be extended.'
+
+
+ CASE ( 'pt_new' )
+
+!
+!-- Define some global attributes of the dataset
+ nc_stat = NF90_PUT_ATT( id_set_prt, NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 310 )
+
+!
+!-- Define time coordinate for particles (unlimited dimension)
+ nc_stat = NF90_DEF_DIM( id_set_prt, 'time', NF90_UNLIMITED, &
+ id_dim_time_prt )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 311 )
+
+ nc_stat = NF90_DEF_VAR( id_set_prt, 'time', NF90_DOUBLE, &
+ id_dim_time_prt, id_var_time_prt )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 312 )
+
+ nc_stat = NF90_PUT_ATT( id_set_prt, id_var_time_prt, 'units', &
+ 'seconds' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 313 )
+
+!
+!-- Define particle coordinate (maximum particle number)
+ nc_stat = NF90_DEF_DIM( id_set_prt, 'particle_number', &
+ maximum_number_of_particles, id_dim_prtnum )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 314 )
+
+ nc_stat = NF90_DEF_VAR( id_set_prt, 'particle_number', NF90_DOUBLE, &
+ id_dim_prtnum, id_var_prtnum )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 315 )
+
+ nc_stat = NF90_PUT_ATT( id_set_prt, id_var_prtnum, 'units', &
+ 'particle number' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 316 )
+
+!
+!-- Define variable which contains the real number of particles in use
+ nc_stat = NF90_DEF_VAR( id_set_prt, 'real_num_of_prt', NF90_INT, &
+ id_dim_time_prt, id_var_rnop_prt )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 317 )
+
+ nc_stat = NF90_PUT_ATT( id_set_prt, id_var_rnop_prt, 'units', &
+ 'particle number' )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 318 )
+
+!
+!-- Define the variables
+ DO i = 1, 17
+
+ nc_stat = NF90_DEF_VAR( id_set_prt, prt_var_names(i), &
+ nc_precision(8), &
+ (/ id_dim_prtnum, id_dim_time_prt /), &
+ id_var_prt(i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 319 )
+
+ nc_stat = NF90_PUT_ATT( id_set_prt, id_var_prt(i), &
+ 'long_name', TRIM( prt_var_names(i) ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 320 )
+
+ nc_stat = NF90_PUT_ATT( id_set_prt, id_var_prt(i), &
+ 'units', TRIM( prt_var_units(i) ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 321 )
+
+ ENDDO
+
+!
+!-- Leave NetCDF define mode
+ nc_stat = NF90_ENDDEF( id_set_prt )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 322 )
+
+
+ CASE ( 'pt_ext' )
+
+!
+!-- Get the id of the time coordinate (unlimited coordinate) and its
+!-- last index on the file. The next time level is prt..count+1.
+!-- The current time must be larger than the last output time
+!-- on the file.
+ nc_stat = NF90_INQ_VARID( id_set_prt, 'time', id_var_time_prt )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 323 )
+
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set_prt, id_var_time_prt, &
+ dimids = id_dim_time_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 324 )
+ id_dim_time_prt = id_dim_time_old(1)
+
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set_prt, id_dim_time_prt, &
+ len = prt_time_count )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 325 )
+
+ nc_stat = NF90_GET_VAR( id_set_prt, id_var_time_prt, &
+ last_time_coordinate, &
+ start = (/ prt_time_count /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 326 )
+
+ IF ( last_time_coordinate(1) >= simulated_time ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for particles from previous ' //&
+ 'run found,'
+ PRINT*, ' but this file cannot be extended becaus' // &
+ 'e the current output time'
+ PRINT*, ' is less or equal than the last output t' // &
+ 'ime on this file.'
+ PRINT*, ' New file is created instead.'
+ prt_time_count = 0
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Dataset seems to be extendable.
+!-- Now get the variable ids.
+ nc_stat = NF90_INQ_VARID( id_set_prt, 'real_num_of_prt', &
+ id_var_rnop_prt )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 327 )
+
+ DO i = 1, 17
+
+ nc_stat = NF90_INQ_VARID( id_set_prt, prt_var_names(i), &
+ id_var_prt(i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 328 )
+
+ ENDDO
+
+ IF ( myid == 0 ) THEN
+ PRINT*, '*** NetCDF file for particles from previous run found.'
+ PRINT*, ' This file will be extended.'
+ ENDIF
+
+
+ CASE ( 'ps_new' )
+
+!
+!-- Define some global attributes of the dataset
+ nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 396 )
+
+!
+!-- Define time coordinate for particle time series (unlimited dimension)
+ nc_stat = NF90_DEF_DIM( id_set_pts, 'time', NF90_UNLIMITED, &
+ id_dim_time_pts )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 397 )
+
+ nc_stat = NF90_DEF_VAR( id_set_pts, 'time', NF90_DOUBLE, &
+ id_dim_time_pts, id_var_time_pts )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 398 )
+
+ nc_stat = NF90_PUT_ATT( id_set_pts, id_var_time_pts, 'units', &
+ 'seconds')
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 399 )
+
+!
+!-- Define the variables. If more than one particle group is defined,
+!-- define seperate variables for each group
+ var_list = ';'
+ DO i = 1, dopts_num
+
+!
+!-- First, remove those characters not allowed by NetCDF
+ netcdf_var_name = dopts_label(i)
+ CALL clean_netcdf_varname( netcdf_var_name )
+
+ DO j = 0, number_of_particle_groups
+
+ IF ( j == 0 ) THEN
+ suffix1 = ''
+ ELSE
+ WRITE ( suffix1, '(''_'',I2.2)' ) j
+ ENDIF
+
+ nc_stat = NF90_DEF_VAR( id_set_pts, &
+ TRIM( netcdf_var_name ) // suffix1, &
+ nc_precision(6), &
+ (/ id_dim_time_pts /), &
+ id_var_dopts(i,j) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 400 )
+
+ IF ( j == 0 ) THEN
+ nc_stat = NF90_PUT_ATT( id_set_pts, id_var_dopts(i,j), &
+ 'long_name', &
+ TRIM( dopts_label(i) ) )
+ ELSE
+ nc_stat = NF90_PUT_ATT( id_set_pts, id_var_dopts(i,j), &
+ 'long_name', &
+ TRIM( dopts_label(i) ) // ' PG ' // &
+ suffix1(2:3) )
+ ENDIF
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 401 )
+
+ nc_stat = NF90_PUT_ATT( id_set_pts, id_var_dopts(i,j), &
+ 'units', TRIM( dopts_unit(i) ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 402 )
+
+ var_list = TRIM(var_list) // TRIM(netcdf_var_name) // &
+ suffix1 // ';'
+
+ IF ( number_of_particle_groups == 1 ) EXIT
+
+ ENDDO
+
+ ENDDO
+
+!
+!-- Write the list of variables as global attribute (this is used by
+!-- restart runs)
+ nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'VAR_LIST', &
+ var_list )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 403 )
+
+!
+!-- Leave NetCDF define mode
+ nc_stat = NF90_ENDDEF( id_set_pts )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 404 )
+
+
+ CASE ( 'ps_ext' )
+
+!
+!-- Get the list of variables and compare with the actual run.
+!-- First var_list_old has to be reset, since GET_ATT does not assign
+!-- trailing blanks.
+ var_list_old = ' '
+ nc_stat = NF90_GET_ATT( id_set_pts, NF90_GLOBAL, 'VAR_LIST', &
+ var_list_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 405 )
+
+ var_list = ';'
+ i = 1
+ DO i = 1, dopts_num
+
+ netcdf_var_name = dopts_label(i)
+ CALL clean_netcdf_varname( netcdf_var_name )
+
+ DO j = 0, number_of_particle_groups
+
+ IF ( j == 0 ) THEN
+ suffix1 = ''
+ ELSE
+ WRITE ( suffix1, '(''_'',I2.2)' ) j
+ ENDIF
+
+ var_list = TRIM(var_list) // TRIM(netcdf_var_name) // &
+ suffix1 // ';'
+
+ IF ( number_of_particle_groups == 1 ) EXIT
+
+ ENDDO
+
+ ENDDO
+
+ IF ( TRIM( var_list ) /= TRIM( var_list_old ) ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for particle time series ' //&
+ 'from previuos run found,'
+ PRINT*, ' but this file cannot be extended due to' // &
+ ' variable mismatch.'
+ PRINT*, ' New file is created instead.'
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Get the id of the time coordinate (unlimited coordinate) and its
+!-- last index on the file. The next time level is dots..count+1.
+!-- The current time must be larger than the last output time
+!-- on the file.
+ nc_stat = NF90_INQ_VARID( id_set_pts, 'time', id_var_time_pts )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 406 )
+
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set_pts, id_var_time_pts, &
+ dimids = id_dim_time_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 407 )
+ id_dim_time_pts = id_dim_time_old(1)
+
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set_pts, id_dim_time_pts, &
+ len = dopts_time_count )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 408 )
+
+ nc_stat = NF90_GET_VAR( id_set_pts, id_var_time_pts, &
+ last_time_coordinate, &
+ start = (/ dopts_time_count /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 409 )
+
+ IF ( last_time_coordinate(1) >= simulated_time ) THEN
+ PRINT*, '+++ WARNING: NetCDF file for time series from' // &
+ ' previuos run found,'
+ PRINT*, ' but this file cannot be extended becaus' // &
+ 'e the current output time'
+ PRINT*, ' is less or equal than the last output t' // &
+ 'ime on this file.'
+ PRINT*, ' New file is created instead.'
+ dopts_time_count = 0
+ extend = .FALSE.
+ RETURN
+ ENDIF
+
+!
+!-- Dataset seems to be extendable.
+!-- Now get the variable ids
+ i = 1
+ DO i = 1, dopts_num
+
+ netcdf_var_name_base = dopts_label(i)
+ CALL clean_netcdf_varname( netcdf_var_name_base )
+
+ DO j = 0, number_of_particle_groups
+
+ IF ( j == 0 ) THEN
+ suffix1 = ''
+ ELSE
+ WRITE ( suffix1, '(''_'',I2.2)' ) j
+ ENDIF
+
+ netcdf_var_name = TRIM( netcdf_var_name_base ) // suffix1
+
+ nc_stat = NF90_INQ_VARID( id_set_pts, netcdf_var_name, &
+ id_var_dopts(i,j) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 410 )
+
+ IF ( number_of_particle_groups == 1 ) EXIT
+
+ ENDDO
+
+ ENDDO
+
+!
+!-- Change the title attribute on file
+ nc_stat = NF90_PUT_ATT( id_set_pts, NF90_GLOBAL, 'title', &
+ TRIM( run_description_header ) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 411 )
+ PRINT*, '*** NetCDF file for particle time series from previous ', &
+ 'run found.'
+ PRINT*, ' This file will be extended.'
+
+
+ CASE DEFAULT
+
+ PRINT*, '+++ define_netcdf_header: mode "', mode, '" not supported'
+
+ END SELECT
+
+#endif
+ END SUBROUTINE define_netcdf_header
+
+
+
+ SUBROUTINE handle_netcdf_error( errno )
+#if defined( __netcdf )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Prints out a text message corresponding to the current status.
+!------------------------------------------------------------------------------!
+
+ USE netcdf
+ USE netcdf_control
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: errno
+
+ IF ( nc_stat /= NF90_NOERR ) THEN
+ PRINT*, '+++ netcdf error ', errno,': ', TRIM( NF90_STRERROR( nc_stat ) )
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ CALL local_stop
+#endif
+ ENDIF
+
+#endif
+ END SUBROUTINE handle_netcdf_error
+
+
+
+ SUBROUTINE clean_netcdf_varname( string )
+#if defined( __netcdf )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Replace those characters in string which are not allowed by NetCDF.
+!------------------------------------------------------------------------------!
+
+ USE netcdf_control
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=10), INTENT(INOUT) :: string
+
+ INTEGER :: i, ic
+
+ DO i = 1, replace_num
+ DO
+ ic = INDEX( string, replace_char(i) )
+ IF ( ic /= 0 ) THEN
+ string(ic:ic) = replace_by(i)
+ ELSE
+ EXIT
+ ENDIF
+ ENDDO
+ ENDDO
+
+#endif
+ END SUBROUTINE clean_netcdf_varname
Index: /palm/tags/release-3.4a/SOURCE/package_parin.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/package_parin.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/package_parin.f90 (revision 141)
@@ -0,0 +1,133 @@
+ SUBROUTINE package_parin
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 116 2007-10-11 02:30:27Z raasch
+! +dt_sort_particles in package_parin
+!
+! 60 2007-03-11 11:50:04Z raasch
+! Particles-paclage is now part of the default code
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.18 2006/08/04 14:52:23 raasch
+! +dt_dopts, dt_min_part, end_time_prel, particles_per_point,
+! use_sgs_for_particles in particles_par
+!
+! Revision 1.1 2000/12/28 13:21:57 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! This subroutine reads from the NAMELIST file variables controling model
+! software packages which are used optionally in the run.
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE dvrp_variables
+ USE particle_attributes
+ USE spectrum
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=80) :: zeile
+
+ NAMELIST /dvrp_graphics_par/ dt_dvrp, dvrp_directory, dvrp_file, &
+ dvrp_host, dvrp_output, dvrp_password, &
+ dvrp_username, mode_dvrp, &
+ slicer_range_limits_dvrp, superelevation, &
+ superelevation_x, superelevation_y, threshold
+ NAMELIST /particles_par/ bc_par_b, bc_par_lr, bc_par_ns, bc_par_t, &
+ density_ratio, radius, dt_dopts, &
+ dt_min_part, dt_prel, dt_sort_particles, &
+ dt_write_particle_data, dvrp_psize, &
+ end_time_prel, initial_weighting_factor, &
+ maximum_number_of_particles, &
+ maximum_number_of_tailpoints, &
+ maximum_tailpoint_age, &
+ minimum_tailpoint_distance, &
+ number_of_particle_groups, &
+ particles_per_point, &
+ particle_advection_start, &
+ particle_maximum_age, pdx, pdy, pdz, psb, &
+ psl, psn, psr, pss, pst, &
+ random_start_position, &
+ read_particles_from_restartfile, &
+ skip_particles_for_tail, use_particle_tails, &
+ use_sgs_for_particles, &
+ vertical_particle_advection, &
+ write_particle_statistics
+ NAMELIST /spectra_par/ averaging_interval_sp, comp_spectra_level, &
+ data_output_sp, dt_dosp, plot_spectra_level, &
+ skip_time_dosp, spectra_direction
+
+!
+!-- Position the namelist-file at the beginning (it was already opened in
+!-- parin), search for the namelist-group of the package and position the
+!-- file at this line. Do the same for each optionally used package.
+ zeile = ' '
+
+#if defined( __dvrp_graphics )
+ REWIND ( 11 )
+ zeile = ' '
+ DO WHILE ( INDEX( zeile, '&dvrp_graphics_par' ) == 0 )
+ READ ( 11, '(A)', END=10 ) zeile
+ ENDDO
+ BACKSPACE ( 11 )
+
+!
+!-- Read user-defined namelist
+ READ ( 11, dvrp_graphics_par )
+
+ 10 CONTINUE
+#endif
+
+!
+!-- Try to find particles package
+ REWIND ( 11 )
+ zeile = ' '
+ DO WHILE ( INDEX( zeile, '&particles_par' ) == 0 )
+ READ ( 11, '(A)', END=20 ) zeile
+ ENDDO
+ BACKSPACE ( 11 )
+
+!
+!-- Read user-defined namelist
+ READ ( 11, particles_par )
+
+!
+!-- Set flag that indicates that particles are switched on
+ particle_advection = .TRUE.
+
+ 20 CONTINUE
+
+
+#if defined( __spectra )
+ REWIND ( 11 )
+ zeile = ' '
+ DO WHILE ( INDEX( zeile, '&spectra_par' ) == 0 )
+ READ ( 11, '(A)', END=30 ) zeile
+ ENDDO
+ BACKSPACE ( 11 )
+
+!
+!-- Read user-defined namelist
+ READ ( 11, spectra_par )
+
+!
+!-- Default setting of dt_dosp here (instead of check_parameters), because its
+!-- current value is needed in init_pegrid
+ IF ( dt_dosp == 9999999.9 ) dt_dosp = dt_data_output
+
+ 30 CONTINUE
+#endif
+
+ END SUBROUTINE package_parin
Index: /palm/tags/release-3.4a/SOURCE/palm.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/palm.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/palm.f90 (revision 141)
@@ -0,0 +1,213 @@
+ PROGRAM palm
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 108 2007-08-24 15:10:38Z letzel
+! Get coupling mode from environment variable, change location of debug output
+!
+! 75 2007-03-22 09:54:05Z raasch
+! __vtk directives removed, write_particles is called only in case of particle
+! advection switched on, open unit 9 for debug output,
+! setting of palm version moved from modules to here
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.10 2006/08/04 14:53:12 raasch
+! Distibution of run description header removed, call of header moved behind
+! init_3d_model
+!
+! Revision 1.2 2001/01/25 07:15:06 raasch
+! Program name changed to PALM, module test_variables removed.
+! Initialization of dvrp logging as well as exit of dvrp moved to new
+! subroutines init_dvrp_logging and close_dvrp (file init_dvrp.f90)
+!
+! Revision 1.1 1997/07/24 11:23:35 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Large-Eddy Simulation (LES) model for the convective boundary layer,
+! optimized for use on parallel machines (implementation realized using the
+! Message Passing Interface (MPI)). The model can also be run on vector machines
+! (less well optimized) and workstations. Versions for the different types of
+! machines are controlled via cpp-directives.
+! Model runs are only feasible using the ksh-script mrun.
+!------------------------------------------------------------------------------!
+
+
+ USE arrays_3d
+ USE constants
+ USE control_parameters
+ USE cpulog
+ USE dvrp_variables
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE model_1d
+ USE particle_attributes
+ USE pegrid
+ USE spectrum
+ USE statistics
+
+ IMPLICIT NONE
+
+!
+!-- Local variables
+ CHARACTER (LEN=9) :: time_to_string
+ CHARACTER (LEN=1) :: cdum
+ INTEGER :: i, run_description_header_i(80)
+
+ version = 'PALM 3.4a'
+
+#if defined( __parallel )
+!
+!-- MPI initialisation. comm2d is preliminary set, because
+!-- it will be defined in init_pegrid but is used before in cpu_log.
+ CALL MPI_INIT( ierr )
+ CALL MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, ierr )
+ comm_palm = MPI_COMM_WORLD
+ comm2d = MPI_COMM_WORLD
+#endif
+
+#if defined( __mpi2 )
+!
+!-- Get information about the coupling mode from the environment variable
+!-- which has been set by the mpiexec command
+ CALL local_getenv( 'coupling_mode', 13, coupling_mode, i )
+ IF ( i == 0 ) coupling_mode = 'uncoupled'
+ IF ( coupling_mode == 'ocean_to_atmosphere' ) coupling_char = '_O'
+#endif
+
+!
+!-- Initialize measuring of the CPU-time remaining to the run
+ CALL local_tremain_ini
+
+!
+!-- Start of total CPU time measuring.
+ CALL cpu_log( log_point(1), 'total', 'start' )
+ CALL cpu_log( log_point(2), 'initialisation', 'start' )
+
+!
+!-- Initialize dvrp logging. Also, one PE maybe split from the global
+!-- communicator for doing the dvrp output. In that case, the number of
+!-- PEs available for PALM is reduced by one and communicator comm_palm
+!-- is changed respectively.
+#if defined( __parallel )
+ CALL MPI_COMM_RANK( comm_palm, myid, ierr )
+#endif
+
+!
+!-- Open a file for debug output
+ WRITE (myid_char,'(''_'',I4.4)') myid
+ OPEN( 9, FILE='DEBUG'//TRIM( coupling_char )//myid_char, FORM='FORMATTED' )
+
+#if defined( __mpi2 )
+!
+!-- TEST OUTPUT (TO BE REMOVED)
+ WRITE(9,*) '*** coupling_mode = "', TRIM( coupling_mode ), '"'
+ CALL LOCAL_FLUSH( 9 )
+ print*, '*** PE', myid, ' ', TRIM( coupling_mode )
+#endif
+
+ CALL init_dvrp_logging
+
+!
+!-- Read control parameters from NAMELIST files and read environment-variables
+ CALL parin
+
+!
+!-- Determine processor topology and local array indices
+ CALL init_pegrid
+
+!
+!-- Generate grid parameters
+ CALL init_grid
+
+!
+!-- Check control parameters and deduce further quantities
+ CALL check_parameters
+
+!
+!-- Initialize all necessary variables
+ CALL init_3d_model
+
+!
+!-- Output of program header
+ IF ( myid == 0 ) CALL header
+
+ CALL cpu_log( log_point(2), 'initialisation', 'stop' )
+
+!
+!-- Set start time in format hh:mm:ss
+ simulated_time_chr = time_to_string( simulated_time )
+
+!
+!-- If required, output of initial arrays
+ IF ( do2d_at_begin ) THEN
+ CALL data_output_2d( 'xy', 0 )
+ CALL data_output_2d( 'xz', 0 )
+ CALL data_output_2d( 'yz', 0 )
+ ENDIF
+ IF ( do3d_at_begin ) THEN
+ CALL data_output_3d( 0 )
+ ENDIF
+
+!
+!-- Integration of the model equations using the leap-frog scheme
+ CALL time_integration
+
+!
+!-- If required, write binary data for model continuation runs
+ IF ( write_binary(1:4) == 'true' ) CALL write_3d_binary
+
+!
+!-- If required, write binary particle data
+ IF ( particle_advection ) CALL write_particles
+
+!
+!-- If required, repeat output of header including the required CPU-time
+ IF ( myid == 0 ) CALL header
+
+!
+!-- If required, final user-defined actions, and
+!-- last actions on the open files and close files. Unit 14 was opened
+!-- in write_3d_binary but it is closed here, to allow writing on this
+!-- unit in routine user_last_actions.
+ CALL cpu_log( log_point(4), 'last actions', 'start' )
+ CALL user_last_actions
+ IF ( write_binary(1:4) == 'true' ) CALL close_file( 14 )
+ CALL close_file( 0 )
+ CALL close_dvrp
+ CALL cpu_log( log_point(4), 'last actions', 'stop' )
+
+#if defined( __mpi2 )
+!
+!-- Test exchange via intercommunicator
+ IF ( coupling_mode == 'atmosphere_to_ocean' ) THEN
+ i = 12345 + myid
+ CALL MPI_SEND( i, 1, MPI_INTEGER, myid, 11, comm_inter, ierr )
+ ELSEIF ( coupling_mode == 'ocean_to_atmosphere' ) THEN
+ CALL MPI_RECV( i, 1, MPI_INTEGER, myid, 11, comm_inter, status, ierr )
+ PRINT*, '### myid: ', myid, ' received from atmosphere: i = ', i
+ ENDIF
+#endif
+
+!
+!-- Take final CPU-time for CPU-time analysis
+ CALL cpu_log( log_point(1), 'total', 'stop' )
+ CALL cpu_statistics
+
+#if defined( __parallel )
+ CALL MPI_FINALIZE( ierr )
+#endif
+
+ END PROGRAM palm
+
Index: /palm/tags/release-3.4a/SOURCE/parin.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/parin.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/parin.f90 (revision 141)
@@ -0,0 +1,287 @@
+ SUBROUTINE parin
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 138 2007-11-28 10:03:58Z letzel
+! +canopy_mode, drag_coefficient, lad_surface, lad_vertical_gradient,
+! lad_vertical_gradient_level, pch_index, plant_canopy,
+! +allocation of leaf area density field
+!
+! 108 2007-08-24 15:10:38Z letzel
+! +e_init, top_momentumflux_u|v in inipar, +dt_coupling in d3par
+!
+! 95 2007-06-02 16:48:38Z raasch
+! +bc_sa_t, bottom_salinityflux, ocean, sa_surface, sa_vertical_gradient,
+! sa_vertical_gradient_level, top_salinityflux in inipar,
+! sa_init is allocated
+!
+! 87 2007-05-22 15:46:47Z raasch
+! Size of hom increased by the maximum number of user-defined profiles,
+! var_hom renamed pr_palm
+!
+! 82 2007-04-16 15:40:52Z raasch
+! +return_addres, return_username in envpar
+!
+! 75 2007-03-22 09:54:05Z raasch
+! +dt_max, netcdf_64bit_3d, precipitation_amount_interval in d3par,
+! +loop_optimization, pt_reference in inipar, -data_output_ts,
+! moisture renamed humidity
+!
+! 20 2007-02-26 00:12:32Z raasch
+! +top_heatflux, use_top_fluxes in inipar
+!
+! -netcdf_64bit_3d
+!
+! 3 2007-02-13 11:30:58Z raasch
+! +netcdf_64bit_3d in d3par,
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.57 2007/02/11 13:11:22 raasch
+! Values of environment variables are now read from file ENVPAR instead of
+! reading them with a system call, + NAMELIST envpar
+!
+! Revision 1.1 1997/07/24 11:22:50 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! This subroutine reads variables controling the run from the NAMELIST files
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE averaging
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE model_1d
+ USE pegrid
+ USE profil_parameter
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: idum
+
+
+ NAMELIST /inipar/ adjust_mixing_length, alpha_surface, bc_e_b, bc_lr, &
+ bc_ns, bc_p_b, bc_p_t, bc_pt_b, bc_pt_t, bc_q_b, &
+ bc_q_t,bc_s_b, bc_s_t, bc_sa_t, bc_uv_b, bc_uv_t, &
+ bottom_salinityflux, building_height, building_length_x, &
+ building_length_y, building_wall_left, &
+ building_wall_south, canopy_mode, cloud_droplets, cloud_physics, &
+ conserve_volume_flow, cut_spline_overshoot, damp_level_1d, &
+ dissipation_1d, drag_coefficient, dt, dt_pr_1d, &
+ dt_run_control_1d, dx, dy, dz, dz_max, dz_stretch_factor, &
+ dz_stretch_level, e_init, e_min, end_time_1d, fft_method, &
+ galilei_transformation, grid_matching, humidity, &
+ inflow_disturbance_begin, inflow_disturbance_end, &
+ initializing_actions, km_constant, km_damp_max, lad_surface, &
+ lad_vertical_gradient, lad_vertical_gradient_level, &
+ long_filter_factor, loop_optimization, mixing_length_1d, &
+ momentum_advec, netcdf_precision, npex, npey, nsor_ini, nx, ny, &
+ nz, ocean, omega, outflow_damping_width, overshoot_limit_e, &
+ overshoot_limit_pt, overshoot_limit_u, overshoot_limit_v, &
+ overshoot_limit_w, passive_scalar, pch_index, phi, &
+ plant_canopy, prandtl_layer, precipitation, pt_reference, &
+ pt_surface, pt_surface_initial_change, pt_vertical_gradient, &
+ pt_vertical_gradient_level, q_surface, q_surface_initial_change, &
+ q_vertical_gradient, q_vertical_gradient_level, radiation, &
+ random_generator, random_heatflux, rif_max, rif_min, &
+ roughness_length, sa_surface, sa_vertical_gradient, &
+ sa_vertical_gradient_level, scalar_advec, statistic_regions, &
+ surface_heatflux, surface_pressure, surface_scalarflux, &
+ surface_waterflux, s_surface, s_surface_initial_change, &
+ s_vertical_gradient, s_vertical_gradient_level, top_heatflux, &
+ top_momentumflux_u, top_momentumflux_v, top_salinityflux, &
+ timestep_scheme, topography, ug_surface, &
+ ug_vertical_gradient, ug_vertical_gradient_level, ups_limit_e, &
+ ups_limit_pt, ups_limit_u, ups_limit_v, ups_limit_w, &
+ use_surface_fluxes, use_top_fluxes, use_ug_for_galilei_tr, &
+ use_upstream_for_tke, vg_surface, vg_vertical_gradient, &
+ vg_vertical_gradient_level, wall_adjustment, wall_heatflux
+
+
+ NAMELIST /d3par/ averaging_interval, averaging_interval_pr, &
+ call_psolver_at_all_substeps, cfl_factor, &
+ create_disturbances, cross_normalized_x, &
+ cross_normalized_y, cross_profiles, cross_ts_uymax, &
+ cross_ts_uymin, cross_xtext, cycle_mg, data_output, &
+ data_output_format, data_output_pr, &
+ data_output_2d_on_each_pe, disturbance_amplitude, &
+ disturbance_energy_limit, disturbance_level_b, &
+ disturbance_level_t, do2d_at_begin, do3d_at_begin, &
+ do3d_compress, do3d_comp_prec, dt, dt_averaging_input, &
+ dt_averaging_input_pr, dt_coupling, dt_data_output, &
+ dt_data_output_av, dt_disturb, dt_dopr, &
+ dt_dopr_listing, dt_dots, dt_do2d_xy, dt_do2d_xz, &
+ dt_do2d_yz, dt_do3d, dt_max, dt_restart, dt_run_control,&
+ end_time, force_print_header, mg_cycles, &
+ mg_switch_to_pe0_level, netcdf_64bit, netcdf_64bit_3d, &
+ ngsrb, normalizing_region, nsor, nz_do3d, omega_sor, &
+ prandtl_number, precipitation_amount_interval, &
+ profile_columns, profile_rows, psolver, &
+ rayleigh_damping_factor, rayleigh_damping_height, &
+ residual_limit, restart_time, section_xy, section_xz, &
+ section_yz, skip_time_data_output, &
+ skip_time_data_output_av, skip_time_dopr, &
+ skip_time_dosp, skip_time_do2d_xy, skip_time_do2d_xz, &
+ skip_time_do2d_yz, skip_time_do3d, &
+ termination_time_needed, use_prior_plot1d_parameters, &
+ z_max_do1d, z_max_do1d_normalized, z_max_do2d
+
+
+ NAMELIST /envpar/ host, maximum_cpu_time_allowed, revision, return_addres,&
+ return_username, run_identifier, tasks_per_node, &
+ write_binary
+
+
+#if defined( __parallel )
+!
+!-- Preliminary determination of processor-id which is needed here to open the
+!-- input files belonging to the corresponding processor and to produce
+!-- messages by PE0 only (myid and myid_char are later determined in
+!-- init_pegrid)
+ CALL MPI_COMM_RANK( comm_palm, myid, ierr )
+ WRITE (myid_char,'(''_'',I4.4)') myid
+!
+!-- Since on IBM machines the process rank may be changed when the final
+!-- communicator is defined, save the preliminary processor-id for opening
+!-- the binary output file for restarts (unit 14), because otherwise
+!-- a mismatch occurs when reading this file in the next job
+ myid_char_14 = myid_char
+#endif
+
+!
+!-- Open the NAMELIST-file which is send with this job
+ CALL check_open( 11 )
+
+!
+!-- Read the control parameters for initialization.
+!-- The namelist "inipar" must be provided in the NAMELIST-file. If this is
+!-- not the case and the file contains - instead of "inipar" - any other
+!-- namelist, a read error is created on t3e and control is transferred
+!-- to the statement with label 10. Therefore, on t3e machines one can not
+!-- distinguish between errors produced by a wrong "inipar" namelist or
+!-- because this namelist is totally missing.
+ READ ( 11, inipar, ERR=10, END=11 )
+ GOTO 12
+ 10 IF ( myid == 0 ) THEN
+ PRINT*, '+++ parin: errors in \$inipar'
+ PRINT*, ' or no \$inipar-namelist found (CRAY-machines only)'
+ ENDIF
+ CALL local_stop
+ 11 IF ( myid == 0 ) THEN
+ PRINT*, '+++ parin: no \$inipar-namelist found'
+ ENDIF
+ CALL local_stop
+
+!
+!-- If required, read control parameters from restart file (produced by
+!-- a prior run)
+ 12 IF ( TRIM( initializing_actions ) == 'read_restart_data' ) THEN
+
+ CALL read_var_list
+!
+!-- Increment the run count
+ runnr = runnr + 1
+
+ ENDIF
+
+!
+!-- Definition of names of areas used for computing statistics. They must
+!-- be defined at this place, because they are allowed to be redefined by
+!-- the user in user_parin.
+ region = 'total domain'
+
+!
+!-- Read runtime parameters given by the user for this run (namelist "d3par").
+!-- The namelist "d3par" can be omitted. In that case, default values are
+!-- used for the parameters.
+ READ ( 11, d3par, END=20 )
+
+!
+!-- Read control parameters for optionally used model software packages
+ 20 CALL package_parin
+
+!
+!-- Read user-defined variables
+ CALL user_parin
+
+!
+!-- Check in case of initial run, if the grid point numbers are well defined
+!-- and allocate some arrays which are already needed in init_pegrid or
+!-- check_parameters. During restart jobs, these arrays will be allocated
+!-- in read_var_list. All other arrays are allocated in init_3d_model.
+ IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN
+
+ IF ( nx <= 0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ parin: no value or wrong value given for nx: nx=', nx
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( ny <= 0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ parin: no value or wrong value given for ny: ny=', ny
+ ENDIF
+ CALL local_stop
+ ENDIF
+ IF ( nz <= 0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ parin: no value or wrong value given for nz: nz=', nz
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ ALLOCATE( ug(0:nz+1), vg(0:nz+1), &
+ pt_init(0:nz+1), q_init(0:nz+1), sa_init(0:nz+1), &
+ u_init(0:nz+1), v_init(0:nz+1), &
+ hom(0:nz+1,2,pr_palm+max_pr_user,0:statistic_regions) )
+ hom = 0.0
+
+ IF ( plant_canopy ) THEN
+ ALLOCATE( lad(0:nz+1) )
+ lad(:) = 0.0
+ ENDIF
+
+ ENDIF
+
+!
+!-- NAMELIST-file is not needed anymore
+ CALL close_file( 11 )
+
+!
+!-- Read values of environment variables (this NAMELIST file is generated by
+!-- mrun)
+ OPEN ( 90, FILE='ENVPAR', STATUS='OLD', FORM='FORMATTED', ERR=30 )
+ READ ( 90, envpar, ERR=31, END=32 )
+ CLOSE ( 90 )
+ RETURN
+
+ 30 IF ( myid == 0 ) THEN
+ PRINT*, '+++ parin: WARNING: local file ENVPAR not found'
+ PRINT*, ' some variables for steering may not be properly set'
+ ENDIF
+ RETURN
+
+ 31 IF ( myid == 0 ) THEN
+ PRINT*, '+++ parin: WARNING: errors in local file ENVPAR'
+ PRINT*, ' some variables for steering may not be properly set'
+ ENDIF
+ RETURN
+
+ 32 IF ( myid == 0 ) THEN
+ PRINT*, '+++ parin: WARNING: no envpar-NAMELIST found in local file ', &
+ 'ENVPAR'
+ PRINT*, ' some variables for steering may not be properly set'
+ ENDIF
+
+ END SUBROUTINE parin
Index: /palm/tags/release-3.4a/SOURCE/particle_boundary_conds.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/particle_boundary_conds.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/particle_boundary_conds.f90 (revision 141)
@@ -0,0 +1,577 @@
+ SUBROUTINE particle_boundary_conds
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! Initial version (2007/03/09)
+!
+! Description:
+! ------------
+! Calculates the reflection of particles from vertical walls.
+! Routine developed by Jin Zhang (2006-2007)
+! To do: Code structure for finding the t_index values and for checking the
+! reflection conditions is basically the same for all four cases, so it
+! should be possible to further simplify/shorten it.
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE particle_attributes
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: i, inc, ir, i1, i2, i3, i5, j, jr, j1, j2, j3, j5, k, k1, k2, &
+ k3, k5, n, t_index, t_index_number
+
+ LOGICAL :: reflect_x, reflect_y, reflect_z
+
+ REAL :: dt_particle, pos_x, pos_x_old, pos_y, pos_y_old, pos_z, &
+ pos_z_old, prt_x, prt_y, prt_z, tmp_t, xline, yline, zline
+
+ REAL :: t(1:200)
+
+ CALL cpu_log( log_point_s(48), 'advec_part_refle', 'start' )
+
+
+
+ reflect_x = .FALSE.
+ reflect_y = .FALSE.
+ reflect_z = .FALSE.
+
+ DO n = 1, number_of_particles
+
+ dt_particle = particles(n)%age - particles(n)%age_m
+
+ i2 = ( particles(n)%x + 0.5 * dx ) * ddx
+ j2 = ( particles(n)%y + 0.5 * dy ) * ddy
+ k2 = particles(n)%z / dz + 1
+
+ prt_x = particles(n)%x
+ prt_y = particles(n)%y
+ prt_z = particles(n)%z
+
+!
+!-- If the particle position is below the surface, it has to be reflected
+ IF ( k2 <= nzb_s_inner(j2,i2) .AND. nzb_s_inner(j2,i2) /=0 ) THEN
+
+ pos_x_old = particles(n)%x - particles(n)%speed_x * dt_particle
+ pos_y_old = particles(n)%y - particles(n)%speed_y * dt_particle
+ pos_z_old = particles(n)%z - particles(n)%speed_z * dt_particle
+ i1 = ( pos_x_old + 0.5 * dx ) * ddx
+ j1 = ( pos_y_old + 0.5 * dy ) * ddy
+ k1 = pos_z_old / dz
+
+!
+!-- Case 1
+ IF ( particles(n)%x > pos_x_old .AND. particles(n)%y > pos_y_old ) &
+ THEN
+ t_index = 1
+
+ DO i = i1, i2
+ xline = i * dx + 0.5 * dx
+ t(t_index) = ( xline - pos_x_old ) / &
+ ( particles(n)%x - pos_x_old )
+ t_index = t_index + 1
+ ENDDO
+
+ DO j = j1, j2
+ yline = j * dy + 0.5 * dy
+ t(t_index) = ( yline - pos_y_old ) / &
+ ( particles(n)%y - pos_y_old )
+ t_index = t_index + 1
+ ENDDO
+
+ IF ( particles(n)%z < pos_z_old ) THEN
+ DO k = k1, k2 , -1
+ zline = k * dz
+ t(t_index) = ( pos_z_old - zline ) / &
+ ( pos_z_old - particles(n)%z )
+ t_index = t_index + 1
+ ENDDO
+ ENDIF
+
+ t_index_number = t_index - 1
+
+!
+!-- Sorting t
+ inc = 1
+ jr = 1
+ DO WHILE ( inc <= t_index_number )
+ inc = 3 * inc + 1
+ ENDDO
+
+ DO WHILE ( inc > 1 )
+ inc = inc / 3
+ DO ir = inc+1, t_index_number
+ tmp_t = t(ir)
+ jr = ir
+ DO WHILE ( t(jr-inc) > tmp_t )
+ t(jr) = t(jr-inc)
+ jr = jr - inc
+ IF ( jr <= inc ) EXIT
+ ENDDO
+ t(jr) = tmp_t
+ ENDDO
+ ENDDO
+
+ case1: DO t_index = 1, t_index_number
+
+ pos_x = pos_x_old + t(t_index) * ( prt_x - pos_x_old )
+ pos_y = pos_y_old + t(t_index) * ( prt_y - pos_y_old )
+ pos_z = pos_z_old + t(t_index) * ( prt_z - pos_z_old )
+
+ i3 = ( pos_x + 0.5 * dx ) * ddx
+ j3 = ( pos_y + 0.5 * dy ) * ddy
+ k3 = pos_z / dz
+
+ i5 = pos_x * ddx
+ j5 = pos_y * ddy
+ k5 = pos_z / dz
+
+ IF ( k5 <= nzb_s_inner(j5,i3) .AND. &
+ nzb_s_inner(j5,i3) /= 0 ) THEN
+
+ IF ( pos_z == nzb_s_inner(j5,i3) * dz .AND. &
+ k3 == nzb_s_inner(j5,i3) ) THEN
+ reflect_z = .TRUE.
+ EXIT case1
+ ENDIF
+
+ ENDIF
+
+ IF ( k5 <= nzb_s_inner(j3,i5) .AND. &
+ nzb_s_inner(j3,i5) /= 0 ) THEN
+
+ IF ( pos_z == nzb_s_inner(j3,i5) * dz .AND. &
+ k3 == nzb_s_inner(j3,i5) ) THEN
+ reflect_z = .TRUE.
+ EXIT case1
+ ENDIF
+
+ ENDIF
+
+ IF ( k3 <= nzb_s_inner(j3,i3) .AND. &
+ nzb_s_inner(j3,i3) /= 0 ) THEN
+
+ IF ( pos_z == nzb_s_inner(j3,i3) * dz .AND. &
+ k3 == nzb_s_inner(j3,i3) ) THEN
+ reflect_z = .TRUE.
+ EXIT case1
+ ENDIF
+
+ IF ( pos_y == ( j3 * dy - 0.5 * dy ) .AND. &
+ pos_z < nzb_s_inner(j3,i3) * dz ) THEN
+ reflect_y = .TRUE.
+ EXIT case1
+ ENDIF
+
+ IF ( pos_x == ( i3 * dx - 0.5 * dx ) .AND. &
+ pos_z < nzb_s_inner(j3,i3) * dz ) THEN
+ reflect_x = .TRUE.
+ EXIT case1
+ ENDIF
+
+ ENDIF
+
+ ENDDO case1
+
+!
+!-- Case 2
+ ELSEIF ( particles(n)%x > pos_x_old .AND. &
+ particles(n)%y < pos_y_old ) THEN
+
+ t_index = 1
+
+ DO i = i1, i2
+ xline = i * dx + 0.5 * dx
+ t(t_index) = ( xline - pos_x_old ) / &
+ ( particles(n)%x - pos_x_old )
+ t_index = t_index + 1
+ ENDDO
+
+ DO j = j1, j2, -1
+ yline = j * dy - 0.5 * dy
+ t(t_index) = ( pos_y_old - yline ) / &
+ ( pos_y_old - particles(n)%y )
+ t_index = t_index + 1
+ ENDDO
+
+ IF ( particles(n)%z < pos_z_old ) THEN
+ DO k = k1, k2 , -1
+ zline = k * dz
+ t(t_index) = ( pos_z_old - zline ) / &
+ ( pos_z_old - particles(n)%z )
+ t_index = t_index + 1
+ ENDDO
+ ENDIF
+ t_index_number = t_index-1
+
+!
+!-- Sorting t
+ inc = 1
+ jr = 1
+ DO WHILE ( inc <= t_index_number )
+ inc = 3 * inc + 1
+ ENDDO
+
+ DO WHILE ( inc > 1 )
+ inc = inc / 3
+ DO ir = inc+1, t_index_number
+ tmp_t = t(ir)
+ jr = ir
+ DO WHILE ( t(jr-inc) > tmp_t )
+ t(jr) = t(jr-inc)
+ jr = jr - inc
+ IF ( jr <= inc ) EXIT
+ ENDDO
+ t(jr) = tmp_t
+ ENDDO
+ ENDDO
+
+ case2: DO t_index = 1, t_index_number
+
+ pos_x = pos_x_old + t(t_index) * ( prt_x - pos_x_old )
+ pos_y = pos_y_old + t(t_index) * ( prt_y - pos_y_old )
+ pos_z = pos_z_old + t(t_index) * ( prt_z - pos_z_old )
+
+ i3 = ( pos_x + 0.5 * dx ) * ddx
+ j3 = ( pos_y + 0.5 * dy ) * ddy
+ k3 = pos_z / dz
+
+ i5 = pos_x * ddx
+ j5 = pos_y * ddy
+ k5 = pos_z / dz
+
+ IF ( k5 <= nzb_s_inner(j3,i5) .AND. &
+ nzb_s_inner(j3,i5) /= 0 ) THEN
+
+ IF ( pos_z == nzb_s_inner(j3,i5) * dz .AND. &
+ k3 == nzb_s_inner(j3,i5) ) THEN
+ reflect_z = .TRUE.
+ EXIT case2
+ ENDIF
+
+ ENDIF
+
+ IF ( k3 <= nzb_s_inner(j3,i3) .AND. &
+ nzb_s_inner(j3,i3) /= 0 ) THEN
+
+ IF ( pos_z == nzb_s_inner(j3,i3) * dz .AND. &
+ k3 == nzb_s_inner(j3,i3) ) THEN
+ reflect_z = .TRUE.
+ EXIT case2
+ ENDIF
+
+ IF ( pos_x == ( i3 * dx - 0.5 * dx ) .AND. &
+ pos_z < nzb_s_inner(j3,i3) * dz ) THEN
+ reflect_x = .TRUE.
+ EXIT case2
+ ENDIF
+
+ ENDIF
+
+ IF ( k5 <= nzb_s_inner(j5,i3) .AND. &
+ nzb_s_inner(j5,i3) /= 0 ) THEN
+
+ IF ( pos_z == nzb_s_inner(j5,i3) * dz .AND. &
+ k3 == nzb_s_inner(j5,i3) ) THEN
+ reflect_z = .TRUE.
+ EXIT case2
+ ENDIF
+
+ IF ( pos_y == ( j5 * dy + 0.5 * dy ) .AND. &
+ pos_z < nzb_s_inner(j5,i3) * dz ) THEN
+ reflect_y = .TRUE.
+ EXIT case2
+ ENDIF
+
+ ENDIF
+
+ ENDDO case2
+
+!
+!-- Case 3
+ ELSEIF ( particles(n)%x < pos_x_old .AND. &
+ particles(n)%y > pos_y_old ) THEN
+
+ t_index = 1
+
+ DO i = i1, i2, -1
+ xline = i * dx - 0.5 * dx
+ t(t_index) = ( pos_x_old - xline ) / &
+ ( pos_x_old - particles(n)%x )
+ t_index = t_index + 1
+ ENDDO
+
+ DO j = j1, j2
+ yline = j * dy + 0.5 * dy
+ t(t_index) = ( yline - pos_y_old ) / &
+ ( particles(n)%y - pos_y_old )
+ t_index = t_index + 1
+ ENDDO
+
+ IF ( particles(n)%z < pos_z_old ) THEN
+ DO k = k1, k2 , -1
+ zline = k * dz
+ t(t_index) = ( pos_z_old - zline ) / &
+ ( pos_z_old - particles(n)%z )
+ t_index = t_index + 1
+ ENDDO
+ ENDIF
+ t_index_number = t_index - 1
+
+!
+!-- Sorting t
+ inc = 1
+ jr = 1
+
+ DO WHILE ( inc <= t_index_number )
+ inc = 3 * inc + 1
+ ENDDO
+
+ DO WHILE ( inc > 1 )
+ inc = inc / 3
+ DO ir = inc+1, t_index_number
+ tmp_t = t(ir)
+ jr = ir
+ DO WHILE ( t(jr-inc) > tmp_t )
+ t(jr) = t(jr-inc)
+ jr = jr - inc
+ IF ( jr <= inc ) EXIT
+ ENDDO
+ t(jr) = tmp_t
+ ENDDO
+ ENDDO
+
+ case3: DO t_index = 1, t_index_number
+
+ pos_x = pos_x_old + t(t_index) * ( prt_x - pos_x_old )
+ pos_y = pos_y_old + t(t_index) * ( prt_y - pos_y_old )
+ pos_z = pos_z_old + t(t_index) * ( prt_z - pos_z_old )
+
+ i3 = ( pos_x + 0.5 * dx ) * ddx
+ j3 = ( pos_y + 0.5 * dy ) * ddy
+ k3 = pos_z / dz
+
+ i5 = pos_x * ddx
+ j5 = pos_y * ddy
+ k5 = pos_z / dz
+
+ IF ( k5 <= nzb_s_inner(j5,i3) .AND. &
+ nzb_s_inner(j5,i3) /= 0 ) THEN
+
+ IF ( pos_z == nzb_s_inner(j5,i3) * dz .AND. &
+ k3 == nzb_s_inner(j5,i3) ) THEN
+ reflect_z = .TRUE.
+ EXIT case3
+ ENDIF
+
+ ENDIF
+
+ IF ( k3 <= nzb_s_inner(j3,i3) .AND. &
+ nzb_s_inner(j3,i3) /= 0 ) THEN
+
+ IF ( pos_z == nzb_s_inner(j3,i3) * dz .AND. &
+ k3 == nzb_s_inner(j3,i3) ) THEN
+ reflect_z = .TRUE.
+ EXIT case3
+ ENDIF
+
+ IF ( pos_y == ( j3 * dy - 0.5 * dy ) .AND. &
+ pos_z < nzb_s_inner(j3,i3) * dz ) THEN
+ reflect_y = .TRUE.
+ EXIT case3
+ ENDIF
+
+ ENDIF
+
+ IF ( k5 <= nzb_s_inner(j3,i5) .AND. &
+ nzb_s_inner(j3,i5) /= 0 ) THEN
+
+ IF ( pos_z == nzb_s_inner(j3,i5) * dz .AND. &
+ k3 == nzb_s_inner(j3,i5) ) THEN
+ reflect_z = .TRUE.
+ EXIT case3
+ ENDIF
+
+ IF ( pos_x == ( i5 * dx + 0.5 * dx ) .AND. &
+ pos_z < nzb_s_inner(j3,i5) * dz ) THEN
+ reflect_x = .TRUE.
+ EXIT case3
+ ENDIF
+
+ ENDIF
+
+ ENDDO case3
+
+!
+!-- Case 4
+ ELSEIF ( particles(n)%x < pos_x_old .AND. &
+ particles(n)%y < pos_y_old ) THEN
+
+ t_index = 1
+
+ DO i = i1, i2, -1
+ xline = i * dx - 0.5 * dx
+ t(t_index) = ( pos_x_old - xline ) / &
+ ( pos_x_old - particles(n)%x )
+ t_index = t_index + 1
+ ENDDO
+
+ DO j = j1, j2, -1
+ yline = j * dy - 0.5 * dy
+ t(t_index) = ( pos_y_old - yline ) / &
+ ( pos_y_old - particles(n)%y )
+ t_index = t_index + 1
+ ENDDO
+
+ IF ( particles(n)%z < pos_z_old ) THEN
+ DO k = k1, k2 , -1
+ zline = k * dz
+ t(t_index) = ( pos_z_old - zline ) / &
+ ( pos_z_old-particles(n)%z )
+ t_index = t_index + 1
+ ENDDO
+ ENDIF
+ t_index_number = t_index-1
+
+!
+!-- Sorting t
+ inc = 1
+ jr = 1
+
+ DO WHILE ( inc <= t_index_number )
+ inc = 3 * inc + 1
+ ENDDO
+
+ DO WHILE ( inc > 1 )
+ inc = inc / 3
+ DO ir = inc+1, t_index_number
+ tmp_t = t(ir)
+ jr = ir
+ DO WHILE ( t(jr-inc) > tmp_t )
+ t(jr) = t(jr-inc)
+ jr = jr - inc
+ IF ( jr <= inc ) EXIT
+ ENDDO
+ t(jr) = tmp_t
+ ENDDO
+ ENDDO
+
+ case4: DO t_index = 1, t_index_number
+
+ pos_x = pos_x_old + t(t_index) * ( prt_x - pos_x_old )
+ pos_y = pos_y_old + t(t_index) * ( prt_y - pos_y_old )
+ pos_z = pos_z_old + t(t_index) * ( prt_z - pos_z_old )
+
+ i3 = ( pos_x + 0.5 * dx ) * ddx
+ j3 = ( pos_y + 0.5 * dy ) * ddy
+ k3 = pos_z / dz
+
+ i5 = pos_x * ddx
+ j5 = pos_y * ddy
+ k5 = pos_z / dz
+
+ IF ( k3 <= nzb_s_inner(j3,i3) .AND. &
+ nzb_s_inner(j3,i3) /= 0 ) THEN
+
+ IF ( pos_z == nzb_s_inner(j3,i3) * dz .AND. &
+ k3 == nzb_s_inner(j3,i3) ) THEN
+ reflect_z = .TRUE.
+ EXIT case4
+ ENDIF
+
+ ENDIF
+
+ IF ( k5 <= nzb_s_inner(j3,i5) .AND. &
+ nzb_s_inner(j3,i5) /= 0 ) THEN
+
+ IF ( pos_z == nzb_s_inner(j3,i5) * dz .AND. &
+ k3 == nzb_s_inner(j3,i5) ) THEN
+ reflect_z = .TRUE.
+ EXIT case4
+ ENDIF
+
+ IF ( pos_x == ( i5 * dx + 0.5 * dx ) .AND. &
+ nzb_s_inner(j3,i5) /=0 .AND. &
+ pos_z < nzb_s_inner(j3,i5) * dz ) THEN
+ reflect_x = .TRUE.
+ EXIT case4
+ ENDIF
+
+ ENDIF
+
+ IF ( k5 <= nzb_s_inner(j5,i3) .AND. &
+ nzb_s_inner(j5,i3) /= 0 ) THEN
+
+ IF ( pos_z == nzb_s_inner(j5,i3) * dz .AND. &
+ k5 == nzb_s_inner(j5,i3) ) THEN
+ reflect_z = .TRUE.
+ EXIT case4
+ ENDIF
+
+ IF ( pos_y == ( j5 * dy + 0.5 * dy ) .AND. &
+ nzb_s_inner(j5,i3) /= 0 .AND. &
+ pos_z < nzb_s_inner(j5,i3) * dz ) THEN
+ reflect_y = .TRUE.
+ EXIT case4
+ ENDIF
+
+ ENDIF
+
+ ENDDO case4
+
+ ENDIF
+
+ ENDIF ! Check, if particle position is below the surface
+
+!
+!-- Do the respective reflection, in case that one of the above conditions
+!-- is found to be true
+ IF ( reflect_z ) THEN
+
+ particles(n)%z = 2.0 * pos_z - prt_z
+ particles(n)%speed_z = - particles(n)%speed_z
+
+ IF ( use_sgs_for_particles ) THEN
+ particles(n)%speed_z_sgs = - particles(n)%speed_z_sgs
+ ENDIF
+ reflect_z = .FALSE.
+
+ ELSEIF ( reflect_y ) THEN
+
+ particles(n)%y = 2.0 * pos_y - prt_y
+ particles(n)%speed_y = - particles(n)%speed_y
+
+ IF ( use_sgs_for_particles ) THEN
+ particles(n)%speed_y_sgs = - particles(n)%speed_y_sgs
+ ENDIF
+ reflect_y = .FALSE.
+
+ ELSEIF ( reflect_x ) THEN
+
+ particles(n)%x = 2.0 * pos_x - prt_x
+ particles(n)%speed_x = - particles(n)%speed_x
+
+ IF ( use_sgs_for_particles ) THEN
+ particles(n)%speed_x_sgs = - particles(n)%speed_x_sgs
+ ENDIF
+ reflect_x = .FALSE.
+
+ ENDIF
+
+ ENDDO
+
+ CALL cpu_log( log_point_s(48), 'advec_part_refle', 'stop' )
+
+
+ END SUBROUTINE particle_boundary_conds
Index: /palm/tags/release-3.4a/SOURCE/plant_canopy_model.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/plant_canopy_model.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/plant_canopy_model.f90 (revision 141)
@@ -0,0 +1,266 @@
+ MODULE plant_canopy_model_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 138 2007-11-28 10:03:58Z letzel
+! Initial revision
+!
+! Description:
+! ------------
+! Evaluation of the drag due to vegetation
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC plant_canopy_model
+
+ INTERFACE plant_canopy_model
+ MODULE PROCEDURE plant_canopy_model
+ MODULE PROCEDURE plant_canopy_model_ij
+ END INTERFACE plant_canopy_model
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE plant_canopy_model( component )
+
+ USE arrays_3d
+ USE control_parameters
+ USE indices
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: component, i, j, k
+
+!
+!-- Compute drag for the three velocity components and the SGS-TKE
+ SELECT CASE ( component )
+
+!
+!-- u-component
+ CASE ( 1 )
+ DO i = nxlu, nxr
+ DO j = nys, nyn
+ DO k = nzb_u_inner(j,i)+1, pch_index
+ tend(k,j,i) = tend(k,j,i) - &
+ cdc(k,j,i) * lad_u(k,j,i) * &
+ SQRT( u(k,j,i)**2 + &
+ ( ( v(k,j,i-1) + &
+ v(k,j,i) + &
+ v(k,j+1,i) + &
+ v(k,j+1,i+1) ) &
+ / 4.0 )**2 + &
+ ( ( w(k-1,j,i-1) + &
+ w(k-1,j,i) + &
+ w(k,j,i-1) + &
+ w(k,j,i) ) &
+ / 4.0 )**2 ) * &
+ u(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- v-component
+ CASE ( 2 )
+ DO i = nxl, nxr
+ DO j = nysv, nyn
+ DO k = nzb_v_inner(j,i)+1, pch_index
+ tend(k,j,i) = tend(k,j,i) - &
+ cdc(k,j,i) * lad_v(k,j,i) * &
+ SQRT( ( ( u(k,j-1,i) + &
+ u(k,j-1,i+1) + &
+ u(k,j,i) + &
+ u(k,j,i+1) ) &
+ / 4.0 )**2 + &
+ v(k,j,i)**2 + &
+ ( ( w(k-1,j-1,i) + &
+ w(k-1,j,i) + &
+ w(k,j-1,i) + &
+ w(k,j,i) ) &
+ / 4.0 )**2 ) * &
+ v(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- w-component
+ CASE ( 3 )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_w_inner(j,i)+1, pch_index
+ tend(k,j,i) = tend(k,j,i) - &
+ cdc(k,j,i) * lad_w(k,j,i) * &
+ SQRT( ( ( u(k,j,i) + &
+ u(k,j,i+1) + &
+ u(k+1,j,i) + &
+ u(k+1,j,i+1) ) &
+ / 4.0 )**2 + &
+ ( ( v(k,j,i) + &
+ v(k,j+1,i) + &
+ v(k+1,j,i) + &
+ v(k+1,j+1,i) ) &
+ / 4.0 )**2 + &
+ w(k,j,i)**2 ) * &
+ w(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- sgs-tke
+ CASE ( 4 )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, pch_index
+ tend(k,j,i) = tend(k,j,i) - &
+ 2.0 * cdc(k,j,i) * lad_s(k,j,i) * &
+ SQRT( ( ( u(k,j,i) + &
+ u(k,j,i+1) ) &
+ / 2.0 )**2 + &
+ ( ( v(k,j,i) + &
+ v(k,j+1,i) ) &
+ / 2.0 )**2 + &
+ ( ( w(k,j,i) + &
+ w(k+1,j,i) ) &
+ / 2.0 )**2 ) * &
+ e(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE DEFAULT
+
+ IF ( myid == 0 ) PRINT*,'+++ pcm: wrong component: ', &
+ component
+ CALL local_stop
+
+ END SELECT
+
+ END SUBROUTINE plant_canopy_model
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE plant_canopy_model_ij( i, j, component )
+
+ USE arrays_3d
+ USE control_parameters
+ USE indices
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: component, i, j, k
+
+ IF ( drag_coefficient /= 0.0 ) THEN
+
+!
+!-- Compute drag for the three velocity components
+ SELECT CASE ( component )
+
+!
+!-- u-component
+ CASE ( 1 )
+ DO k = nzb_u_inner(j,i)+1, pch_index
+ tend(k,j,i) = tend(k,j,i) - &
+ cdc(k,j,i) * lad_u(k,j,i) * &
+ SQRT( u(k,j,i)**2 + &
+ ( ( v(k,j,i-1) + &
+ v(k,j,i) + &
+ v(k,j+1,i) + &
+ v(k,j+1,i+1) ) &
+ / 4.0 )**2 + &
+ ( ( w(k-1,j,i-1) + &
+ w(k-1,j,i) + &
+ w(k,j,i-1) + &
+ w(k,j,i) ) &
+ / 4.0 )**2 ) * &
+ u(k,j,i)
+ ENDDO
+
+!
+!-- v-component
+ CASE ( 2 )
+ DO k = nzb_v_inner(j,i)+1, pch_index
+ tend(k,j,i) = tend(k,j,i) - &
+ cdc(k,j,i) * lad_v(k,j,i) * &
+ SQRT( ( ( u(k,j-1,i) + &
+ u(k,j-1,i+1) + &
+ u(k,j,i) + &
+ u(k,j,i+1) ) &
+ / 4.0 )**2 + &
+ v(k,j,i)**2 + &
+ ( ( w(k-1,j-1,i) + &
+ w(k-1,j,i) + &
+ w(k,j-1,i) + &
+ w(k,j,i) ) &
+ / 4.0 )**2 ) * &
+ v(k,j,i)
+ ENDDO
+
+!
+!-- w-component
+ CASE ( 3 )
+ DO k = nzb_w_inner(j,i)+1, pch_index
+ tend(k,j,i) = tend(k,j,i) - &
+ cdc(k,j,i) * lad_w(k,j,i) * &
+ SQRT( ( ( u(k,j,i) + &
+ u(k,j,i+1) + &
+ u(k+1,j,i) + &
+ u(k+1,j,i+1) ) &
+ / 4.0 )**2 + &
+ ( ( v(k,j,i) + &
+ v(k,j+1,i) + &
+ v(k+1,j,i) + &
+ v(k+1,j+1,i) ) &
+ / 4.0 )**2 + &
+ w(k,j,i)**2 ) * &
+ w(k,j,i)
+
+ ENDDO
+
+!
+!-- sgs-tke
+ CASE ( 4 )
+ DO k = nzb_s_inner(j,i)+1, pch_index
+ tend(k,j,i) = tend(k,j,i) - &
+ 2.0 * cdc(k,j,i) * lad_s(k,j,i) * &
+ SQRT( ( ( u(k,j,i) + &
+ u(k,j,i+1) ) &
+ / 2.0 )**2 + &
+ ( ( v(k,j,i) + &
+ v(k,j+1,i) ) &
+ / 2.0 )**2 + &
+ ( ( w(k,j,i) + &
+ w(k+1,j,i) ) &
+ / 2.0 )**2 ) * &
+ e(k,j,i)
+
+ ENDDO
+
+ CASE DEFAULT
+
+ IF ( myid == 0 ) PRINT*,'+++ pcm: wrong component: ', &
+ component
+ CALL local_stop
+
+ END SELECT
+
+ ENDIF
+
+ END SUBROUTINE plant_canopy_model_ij
+
+ END MODULE plant_canopy_model_mod
Index: /palm/tags/release-3.4a/SOURCE/poisfft.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/poisfft.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/poisfft.f90 (revision 141)
@@ -0,0 +1,1536 @@
+ MODULE poisfft_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 128 2007-10-26 13:11:14Z raasch
+! Bugfix: wavenumber calculation for even nx in routines maketri
+!
+! 85 2007-05-11 09:35:14Z raasch
+! Bugfix: work_fft*_vec removed from some PRIVATE-declarations
+!
+! 76 2007-03-29 00:58:32Z raasch
+! Tridiagonal coefficients adjusted for Neumann boundary conditions both at
+! the bottom and the top.
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.24 2006/08/04 15:00:24 raasch
+! Default setting of the thread number tn in case of not using OpenMP
+!
+! Revision 1.23 2006/02/23 12:48:38 raasch
+! Additional compiler directive in routine tridia_1dd for preventing loop
+! exchange on NEC-SX6
+!
+! Revision 1.20 2004/04/30 12:38:09 raasch
+! Parts of former poisfft_hybrid moved to this subroutine,
+! former subroutine changed to a module, renaming of FFT-subroutines and
+! -module, FFTs completely substituted by calls of fft_x and fft_y,
+! NAG fft used in the non-parallel case completely removed, l in maketri
+! is now a 1d-array, variables passed by modules instead of using parameter
+! lists, enlarged transposition arrays introduced
+!
+! Revision 1.1 1997/07/24 11:24:14 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! See below.
+!------------------------------------------------------------------------------!
+
+!--------------------------------------------------------------------------!
+! poisfft !
+! !
+! Original version: Stephan Siano (pois3d) !
+! !
+! Institute of Meteorology and Climatology, University of Hannover !
+! Germany !
+! !
+! Version as of July 23,1996 !
+! !
+! !
+! Version for parallel computers: Siegfried Raasch !
+! !
+! Version as of July 03,1997 !
+! !
+! Solves the Poisson equation with a 2D spectral method !
+! d^2 p / dx^2 + d^2 p / dy^2 + d^2 p / dz^2 = s !
+! !
+! Input: !
+! real ar contains in the (nnx,nny,nnz) elements, !
+! starting from the element (1,nys,nxl), the !
+! values for s !
+! real work Temporary array !
+! !
+! Output: !
+! real ar contains the solution for p !
+!--------------------------------------------------------------------------!
+
+ USE fft_xy
+ USE indices
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ PRIVATE
+ PUBLIC poisfft, poisfft_init
+
+ INTERFACE poisfft
+ MODULE PROCEDURE poisfft
+ END INTERFACE poisfft
+
+ INTERFACE poisfft_init
+ MODULE PROCEDURE poisfft_init
+ END INTERFACE poisfft_init
+
+ CONTAINS
+
+ SUBROUTINE poisfft_init
+
+ CALL fft_init
+
+ END SUBROUTINE poisfft_init
+
+
+ SUBROUTINE poisfft( ar, work )
+
+ USE cpulog
+ USE interfaces
+ USE pegrid
+
+ IMPLICIT NONE
+
+ REAL, DIMENSION(1:nza,nys:nyna,nxl:nxra) :: ar, work
+
+
+ CALL cpu_log( log_point_s(3), 'poisfft', 'start' )
+
+!
+!-- Two-dimensional Fourier Transformation in x- and y-direction.
+#if defined( __parallel )
+ IF ( pdims(2) == 1 ) THEN
+
+!
+!-- 1d-domain-decomposition along x:
+!-- FFT along y and transposition y --> x
+ CALL ffty_tr_yx( ar, work, ar )
+
+!
+!-- FFT along x, solving the tridiagonal system and backward FFT
+ CALL fftx_tri_fftx( ar )
+
+!
+!-- Transposition x --> y and backward FFT along y
+ CALL tr_xy_ffty( ar, work, ar )
+
+ ELSEIF ( pdims(1) == 1 ) THEN
+
+!
+!-- 1d-domain-decomposition along y:
+!-- FFT along x and transposition x --> y
+ CALL fftx_tr_xy( ar, work, ar )
+
+!
+!-- FFT along y, solving the tridiagonal system and backward FFT
+ CALL ffty_tri_ffty( ar )
+
+!
+!-- Transposition y --> x and backward FFT along x
+ CALL tr_yx_fftx( ar, work, ar )
+
+ ELSE
+
+!
+!-- 2d-domain-decomposition
+!-- Transposition z --> x
+ CALL cpu_log( log_point_s(5), 'transpo forward', 'start' )
+ CALL transpose_zx( ar, work, ar, work, ar )
+ CALL cpu_log( log_point_s(5), 'transpo forward', 'pause' )
+
+ CALL cpu_log( log_point_s(4), 'fft_x', 'start' )
+ CALL fftxp( ar, 'forward' )
+ CALL cpu_log( log_point_s(4), 'fft_x', 'pause' )
+
+!
+!-- Transposition x --> y
+ CALL cpu_log( log_point_s(5), 'transpo forward', 'continue' )
+ CALL transpose_xy( ar, work, ar, work, ar )
+ CALL cpu_log( log_point_s(5), 'transpo forward', 'pause' )
+
+ CALL cpu_log( log_point_s(7), 'fft_y', 'start' )
+ CALL fftyp( ar, 'forward' )
+ CALL cpu_log( log_point_s(7), 'fft_y', 'pause' )
+
+!
+!-- Transposition y --> z
+ CALL cpu_log( log_point_s(5), 'transpo forward', 'continue' )
+ CALL transpose_yz( ar, work, ar, work, ar )
+ CALL cpu_log( log_point_s(5), 'transpo forward', 'stop' )
+
+!
+!-- Solve the Poisson equation in z-direction in cartesian space.
+ CALL cpu_log( log_point_s(6), 'tridia', 'start' )
+ CALL tridia( ar )
+ CALL cpu_log( log_point_s(6), 'tridia', 'stop' )
+
+!
+!-- Inverse Fourier Transformation
+!-- Transposition z --> y
+ CALL cpu_log( log_point_s(8), 'transpo invers', 'start' )
+ CALL transpose_zy( ar, work, ar, work, ar )
+ CALL cpu_log( log_point_s(8), 'transpo invers', 'pause' )
+
+ CALL cpu_log( log_point_s(7), 'fft_y', 'continue' )
+ CALL fftyp( ar, 'backward' )
+ CALL cpu_log( log_point_s(7), 'fft_y', 'stop' )
+
+!
+!-- Transposition y --> x
+ CALL cpu_log( log_point_s(8), 'transpo invers', 'continue' )
+ CALL transpose_yx( ar, work, ar, work, ar )
+ CALL cpu_log( log_point_s(8), 'transpo invers', 'pause' )
+
+ CALL cpu_log( log_point_s(4), 'fft_x', 'continue' )
+ CALL fftxp( ar, 'backward' )
+ CALL cpu_log( log_point_s(4), 'fft_x', 'stop' )
+
+!
+!-- Transposition x --> z
+ CALL cpu_log( log_point_s(8), 'transpo invers', 'continue' )
+ CALL transpose_xz( ar, work, ar, work, ar )
+ CALL cpu_log( log_point_s(8), 'transpo invers', 'stop' )
+
+ ENDIF
+
+#else
+
+!
+!-- Two-dimensional Fourier Transformation along x- and y-direction.
+ CALL cpu_log( log_point_s(4), 'fft_x', 'start' )
+ CALL fftx( ar, 'forward' )
+ CALL cpu_log( log_point_s(4), 'fft_x', 'pause' )
+ CALL cpu_log( log_point_s(7), 'fft_y', 'start' )
+ CALL ffty( ar, 'forward' )
+ CALL cpu_log( log_point_s(7), 'fft_y', 'pause' )
+
+!
+!-- Solve the Poisson equation in z-direction in cartesian space.
+ CALL cpu_log( log_point_s(6), 'tridia', 'start' )
+ CALL tridia( ar )
+ CALL cpu_log( log_point_s(6), 'tridia', 'stop' )
+
+!
+!-- Inverse Fourier Transformation.
+ CALL cpu_log( log_point_s(7), 'fft_y', 'continue' )
+ CALL ffty( ar, 'backward' )
+ CALL cpu_log( log_point_s(7), 'fft_y', 'stop' )
+ CALL cpu_log( log_point_s(4), 'fft_x', 'continue' )
+ CALL fftx( ar, 'backward' )
+ CALL cpu_log( log_point_s(4), 'fft_x', 'stop' )
+
+#endif
+
+ CALL cpu_log( log_point_s(3), 'poisfft', 'stop' )
+
+ END SUBROUTINE poisfft
+
+
+
+ SUBROUTINE tridia( ar )
+
+!------------------------------------------------------------------------------!
+! solves the linear system of equations:
+!
+! -(4 pi^2(i^2/(dx^2*nnx^2)+j^2/(dy^2*nny^2))+
+! 1/(dzu(k)*dzw(k))+1/(dzu(k-1)*dzw(k)))*p(i,j,k)+
+! 1/(dzu(k)*dzw(k))*p(i,j,k+1)+1/(dzu(k-1)*dzw(k))*p(i,j,k-1)=d(i,j,k)
+!
+! by using the Thomas algorithm
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, nnyh
+
+ REAL, DIMENSION(nxl_z:nxr_z,0:nz-1) :: ar1
+ REAL, DIMENSION(5,nxl_z:nxr_z,0:nz-1) :: tri
+
+#if defined( __parallel )
+ REAL :: ar(nxl_z:nxr_za,nys_z:nyn_za,1:nza)
+#else
+ REAL :: ar(1:nz,nys_z:nyn_z,nxl_z:nxr_z)
+#endif
+
+
+ nnyh = (ny+1) / 2
+
+!
+!-- Define constant elements of the tridiagonal matrix.
+ DO k = 0, nz-1
+ DO i = nxl_z, nxr_z
+ tri(2,i,k) = ddzu(k+1) * ddzw(k+1)
+ tri(3,i,k) = ddzu(k+2) * ddzw(k+1)
+ ENDDO
+ ENDDO
+
+#if defined( __parallel )
+!
+!-- Repeat for all y-levels.
+ DO j = nys_z, nyn_z
+ IF ( j <= nnyh ) THEN
+ CALL maketri( tri, j )
+ ELSE
+ CALL maketri( tri, ny+1-j )
+ ENDIF
+ CALL split( tri )
+ CALL substi( ar, ar1, tri, j )
+ ENDDO
+#else
+!
+!-- First y-level.
+ CALL maketri( tri, nys_z )
+ CALL split( tri )
+ CALL substi( ar, ar1, tri, 0 )
+
+!
+!-- Further y-levels.
+ DO j = 1, nnyh - 1
+ CALL maketri( tri, j )
+ CALL split( tri )
+ CALL substi( ar, ar1, tri, j )
+ CALL substi( ar, ar1, tri, ny+1-j )
+ ENDDO
+ CALL maketri( tri, nnyh )
+ CALL split( tri )
+ CALL substi( ar, ar1, tri, nnyh+nys )
+#endif
+
+ CONTAINS
+
+ SUBROUTINE maketri( tri, j )
+
+!------------------------------------------------------------------------------!
+! Computes the i- and j-dependent component of the matrix
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE constants
+ USE control_parameters
+ USE grid_variables
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, nnxh
+ REAL :: a, c
+ REAL :: ll(nxl_z:nxr_z)
+ REAL :: tri(5,nxl_z:nxr_z,0:nz-1)
+
+
+ nnxh = ( nx + 1 ) / 2
+
+!
+!-- Provide the tridiagonal matrix for solution of the Poisson equation in
+!-- Fourier space. The coefficients are computed following the method of
+!-- Schmidt et al. (DFVLR-Mitteilung 84-15), which departs from Stephan
+!-- Siano's original version by discretizing the Poisson equation,
+!-- before it is Fourier-transformed
+#if defined( __parallel )
+ DO i = nxl_z, nxr_z
+ IF ( i >= 0 .AND. i <= nnxh ) THEN
+ ll(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * i ) / &
+ FLOAT( nx+1 ) ) ) / ( dx * dx ) + &
+ 2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+ FLOAT( ny+1 ) ) ) / ( dy * dy )
+ ELSE
+ ll(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( nx+1-i ) ) / &
+ FLOAT( nx+1 ) ) ) / ( dx * dx ) + &
+ 2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+ FLOAT( ny+1 ) ) ) / ( dy * dy )
+ ENDIF
+ DO k = 0,nz-1
+ a = -1.0 * ddzu(k+2) * ddzw(k+1)
+ c = -1.0 * ddzu(k+1) * ddzw(k+1)
+ tri(1,i,k) = a + c - ll(i)
+ ENDDO
+ ENDDO
+#else
+ DO i = 0, nnxh
+ ll(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * i ) / FLOAT( nx+1 ) ) ) / &
+ ( dx * dx ) + &
+ 2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / FLOAT( ny+1 ) ) ) / &
+ ( dy * dy )
+ DO k = 0, nz-1
+ a = -1.0 * ddzu(k+2) * ddzw(k+1)
+ c = -1.0 * ddzu(k+1) * ddzw(k+1)
+ tri(1,i,k) = a + c - ll(i)
+ IF ( i >= 1 .and. i < nnxh ) THEN
+ tri(1,nx+1-i,k) = tri(1,i,k)
+ ENDIF
+ ENDDO
+ ENDDO
+#endif
+ IF ( ibc_p_b == 1 .OR. ibc_p_b == 2 ) THEN
+ DO i = nxl_z, nxr_z
+ tri(1,i,0) = tri(1,i,0) + tri(2,i,0)
+ ENDDO
+ ENDIF
+ IF ( ibc_p_t == 1 ) THEN
+ DO i = nxl_z, nxr_z
+ tri(1,i,nz-1) = tri(1,i,nz-1) + tri(3,i,nz-1)
+ ENDDO
+ ENDIF
+
+ END SUBROUTINE maketri
+
+
+ SUBROUTINE substi( ar, ar1, tri, j )
+
+!------------------------------------------------------------------------------!
+! Substitution (Forward and Backward) (Thomas algorithm)
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: ar1(nxl_z:nxr_z,0:nz-1)
+ REAL :: tri(5,nxl_z:nxr_z,0:nz-1)
+#if defined( __parallel )
+ REAL :: ar(nxl_z:nxr_za,nys_z:nyn_za,1:nza)
+#else
+ REAL :: ar(1:nz,nys_z:nyn_z,nxl_z:nxr_z)
+#endif
+
+!
+!-- Forward substitution.
+ DO i = nxl_z, nxr_z
+#if defined( __parallel )
+ ar1(i,0) = ar(i,j,1)
+#else
+ ar1(i,0) = ar(1,j,i)
+#endif
+ ENDDO
+ DO k = 1, nz - 1
+ DO i = nxl_z, nxr_z
+#if defined( __parallel )
+ ar1(i,k) = ar(i,j,k+1) - tri(5,i,k) * ar1(i,k-1)
+#else
+ ar1(i,k) = ar(k+1,j,i) - tri(5,i,k) * ar1(i,k-1)
+#endif
+ ENDDO
+ ENDDO
+
+!
+!-- Backward substitution.
+ DO i = nxl_z, nxr_z
+#if defined( __parallel )
+ ar(i,j,nz) = ar1(i,nz-1) / tri(4,i,nz-1)
+#else
+ ar(nz,j,i) = ar1(i,nz-1) / tri(4,i,nz-1)
+#endif
+ ENDDO
+ DO k = nz-2, 0, -1
+ DO i = nxl_z, nxr_z
+#if defined( __parallel )
+ ar(i,j,k+1) = ( ar1(i,k) - tri(3,i,k) * ar(i,j,k+2) ) &
+ / tri(4,i,k)
+#else
+ ar(k+1,j,i) = ( ar1(i,k) - tri(3,i,k) * ar(k+2,j,i) ) &
+ / tri(4,i,k)
+#endif
+ ENDDO
+ ENDDO
+
+!
+!-- Indices i=0, j=0 correspond to horizontally averaged pressure.
+!-- The respective values of ar should be zero at all k-levels if
+!-- acceleration of horizontally averaged vertical velocity is zero.
+ IF ( ibc_p_b == 1 .AND. ibc_p_t == 1 ) THEN
+ IF ( j == 0 .AND. nxl_z == 0 ) THEN
+#if defined( __parallel )
+ DO k = 1, nz
+ ar(nxl_z,j,k) = 0.0
+ ENDDO
+#else
+ DO k = 1, nz
+ ar(k,j,nxl_z) = 0.0
+ ENDDO
+#endif
+ ENDIF
+ ENDIF
+
+ END SUBROUTINE substi
+
+
+ SUBROUTINE split( tri )
+
+!------------------------------------------------------------------------------!
+! Splitting of the tridiagonal matrix (Thomas algorithm)
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ INTEGER :: i, k
+ REAL :: tri(5,nxl_z:nxr_z,0:nz-1)
+
+!
+!-- Splitting.
+ DO i = nxl_z, nxr_z
+ tri(4,i,0) = tri(1,i,0)
+ ENDDO
+ DO k = 1, nz-1
+ DO i = nxl_z, nxr_z
+ tri(5,i,k) = tri(2,i,k) / tri(4,i,k-1)
+ tri(4,i,k) = tri(1,i,k) - tri(3,i,k-1) * tri(5,i,k)
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE split
+
+ END SUBROUTINE tridia
+
+
+#if defined( __parallel )
+ SUBROUTINE fftxp( ar, direction )
+
+!------------------------------------------------------------------------------!
+! Fourier-transformation along x-direction Parallelized version
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: direction
+ INTEGER :: j, k
+ REAL :: ar(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa)
+
+!
+!-- Performing the fft with one of the methods implemented
+ DO k = nzb_x, nzt_x
+ DO j = nys_x, nyn_x
+ CALL fft_x( ar(0:nx,j,k), direction )
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE fftxp
+
+#else
+ SUBROUTINE fftx( ar, direction )
+
+!------------------------------------------------------------------------------!
+! Fourier-transformation along x-direction Non parallel version
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: direction
+ INTEGER :: i, j, k
+ REAL :: ar(1:nz,0:ny,0:nx)
+
+!
+!-- Performing the fft with one of the methods implemented
+ DO k = 1, nz
+ DO j = 0, ny
+ CALL fft_x( ar(k,j,0:nx), direction )
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE fftx
+#endif
+
+
+#if defined( __parallel )
+ SUBROUTINE fftyp( ar, direction )
+
+!------------------------------------------------------------------------------!
+! Fourier-transformation along y-direction Parallelized version
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: direction
+ INTEGER :: i, k
+ REAL :: ar(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya)
+
+!
+!-- Performing the fft with one of the methods implemented
+ DO k = nzb_y, nzt_y
+ DO i = nxl_y, nxr_y
+ CALL fft_y( ar(0:ny,i,k), direction )
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE fftyp
+
+#else
+ SUBROUTINE ffty( ar, direction )
+
+!------------------------------------------------------------------------------!
+! Fourier-transformation along y-direction Non parallel version
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: direction
+ INTEGER :: i, k
+ REAL :: ar(1:nz,0:ny,0:nx)
+
+!
+!-- Performing the fft with one of the methods implemented
+ DO k = 1, nz
+ DO i = 0, nx
+ CALL fft_y( ar(k,0:ny,i), direction )
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE ffty
+#endif
+
+#if defined( __parallel )
+ SUBROUTINE ffty_tr_yx( f_in, work, f_out )
+
+!------------------------------------------------------------------------------!
+! Fourier-transformation along y with subsequent transposition y --> x for
+! a 1d-decomposition along x
+!
+! ATTENTION: The performance of this routine is much faster on the NEC-SX6,
+! if the first index of work_ffty_vec is odd. Otherwise
+! memory bank conflicts may occur (especially if the index is a
+! multiple of 128). That's why work_ffty_vec is dimensioned as
+! 0:ny+1.
+! Of course, this will not work if users are using an odd number
+! of gridpoints along y.
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, iend, iouter, ir, j, k
+ INTEGER, PARAMETER :: stridex = 4
+
+ REAL, DIMENSION(0:ny,stridex) :: work_ffty
+#if defined( __nec )
+ REAL, DIMENSION(0:ny+1,1:nz,nxl:nxr) :: work_ffty_vec
+#endif
+ REAL, DIMENSION(1:nza,0:nya,nxl:nxra) :: f_in
+ REAL, DIMENSION(nnx,1:nza,nys_x:nyn_xa,pdims(1)) :: f_out
+ REAL, DIMENSION(nxl:nxra,1:nza,0:nya) :: work
+
+!
+!-- Carry out the FFT along y, where all data are present due to the
+!-- 1d-decomposition along x. Resort the data in a way that x becomes
+!-- the first index.
+ CALL cpu_log( log_point_s(7), 'fft_y', 'start' )
+
+ IF ( host(1:3) == 'nec' ) THEN
+#if defined( __nec )
+!
+!-- Code optimized for vector processors
+!$OMP PARALLEL PRIVATE ( i, j, k )
+!$OMP DO
+ DO i = nxl, nxr
+
+ DO j = 0, ny
+ DO k = 1, nz
+ work_ffty_vec(j,k,i) = f_in(k,j,i)
+ ENDDO
+ ENDDO
+
+ CALL fft_y_m( work_ffty_vec(:,:,i), ny+1, 'forward' )
+
+ ENDDO
+
+!$OMP DO
+ DO k = 1, nz
+ DO j = 0, ny
+ DO i = nxl, nxr
+ work(i,k,j) = work_ffty_vec(j,k,i)
+ ENDDO
+ ENDDO
+ ENDDO
+!$OMP END PARALLEL
+#endif
+
+ ELSE
+
+!
+!-- Cache optimized code.
+!-- The i-(x-)direction is split into a strided outer loop and an inner
+!-- loop for better cache performance
+!$OMP PARALLEL PRIVATE (i,iend,iouter,ir,j,k,work_ffty)
+!$OMP DO
+ DO iouter = nxl, nxr, stridex
+
+ iend = MIN( iouter+stridex-1, nxr ) ! Upper bound for inner i loop
+
+ DO k = 1, nz
+
+ DO i = iouter, iend
+
+ ir = i-iouter+1 ! counter within a stride
+ DO j = 0, ny
+ work_ffty(j,ir) = f_in(k,j,i)
+ ENDDO
+!
+!-- FFT along y
+ CALL fft_y( work_ffty(:,ir), 'forward' )
+
+ ENDDO
+
+!
+!-- Resort
+ DO j = 0, ny
+ DO i = iouter, iend
+ work(i,k,j) = work_ffty(j,i-iouter+1)
+ ENDDO
+ ENDDO
+
+ ENDDO
+
+ ENDDO
+!$OMP END PARALLEL
+
+ ENDIF
+ CALL cpu_log( log_point_s(7), 'fft_y', 'pause' )
+
+!
+!-- Transpose array
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+ CALL MPI_ALLTOALL( work(nxl,1,0), sendrecvcount_xy, MPI_REAL, &
+ f_out(1,1,nys_x,1), sendrecvcount_xy, MPI_REAL, &
+ comm1dx, ierr )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+ END SUBROUTINE ffty_tr_yx
+
+
+ SUBROUTINE tr_xy_ffty( f_in, work, f_out )
+
+!------------------------------------------------------------------------------!
+! Transposition x --> y with a subsequent backward Fourier transformation for
+! a 1d-decomposition along x
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, iend, iouter, ir, j, k
+ INTEGER, PARAMETER :: stridex = 4
+
+ REAL, DIMENSION(0:ny,stridex) :: work_ffty
+#if defined( __nec )
+ REAL, DIMENSION(0:ny+1,1:nz,nxl:nxr) :: work_ffty_vec
+#endif
+ REAL, DIMENSION(nnx,1:nza,nys_x:nyn_xa,pdims(1)) :: f_in
+ REAL, DIMENSION(1:nza,0:nya,nxl:nxra) :: f_out
+ REAL, DIMENSION(nxl:nxra,1:nza,0:nya) :: work
+
+!
+!-- Transpose array
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+ CALL MPI_ALLTOALL( f_in(1,1,nys_x,1), sendrecvcount_xy, MPI_REAL, &
+ work(nxl,1,0), sendrecvcount_xy, MPI_REAL, &
+ comm1dx, ierr )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!-- Resort the data in a way that y becomes the first index and carry out the
+!-- backward fft along y.
+ CALL cpu_log( log_point_s(7), 'fft_y', 'continue' )
+
+ IF ( host(1:3) == 'nec' ) THEN
+#if defined( __nec )
+!
+!-- Code optimized for vector processors
+!$OMP PARALLEL PRIVATE ( i, j, k )
+!$OMP DO
+ DO k = 1, nz
+ DO j = 0, ny
+ DO i = nxl, nxr
+ work_ffty_vec(j,k,i) = work(i,k,j)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!$OMP DO
+ DO i = nxl, nxr
+
+ CALL fft_y_m( work_ffty_vec(:,:,i), ny+1, 'backward' )
+
+ DO j = 0, ny
+ DO k = 1, nz
+ f_out(k,j,i) = work_ffty_vec(j,k,i)
+ ENDDO
+ ENDDO
+
+ ENDDO
+!$OMP END PARALLEL
+#endif
+
+ ELSE
+
+!
+!-- Cache optimized code.
+!-- The i-(x-)direction is split into a strided outer loop and an inner
+!-- loop for better cache performance
+!$OMP PARALLEL PRIVATE ( i, iend, iouter, ir, j, k, work_ffty )
+!$OMP DO
+ DO iouter = nxl, nxr, stridex
+
+ iend = MIN( iouter+stridex-1, nxr ) ! Upper bound for inner i loop
+
+ DO k = 1, nz
+!
+!-- Resort
+ DO j = 0, ny
+ DO i = iouter, iend
+ work_ffty(j,i-iouter+1) = work(i,k,j)
+ ENDDO
+ ENDDO
+
+ DO i = iouter, iend
+
+!
+!-- FFT along y
+ ir = i-iouter+1 ! counter within a stride
+ CALL fft_y( work_ffty(:,ir), 'backward' )
+
+ DO j = 0, ny
+ f_out(k,j,i) = work_ffty(j,ir)
+ ENDDO
+ ENDDO
+
+ ENDDO
+
+ ENDDO
+!$OMP END PARALLEL
+
+ ENDIF
+
+ CALL cpu_log( log_point_s(7), 'fft_y', 'stop' )
+
+ END SUBROUTINE tr_xy_ffty
+
+
+ SUBROUTINE fftx_tri_fftx( ar )
+
+!------------------------------------------------------------------------------!
+! FFT along x, solution of the tridiagonal system and backward FFT for
+! a 1d-decomposition along x
+!
+! WARNING: this subroutine may still not work for hybrid parallelization
+! with OpenMP (for possible necessary changes see the original
+! routine poisfft_hybrid, developed by Klaus Ketelsen, May 2002)
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ character(len=3) :: myth_char
+
+ INTEGER :: i, j, k, m, n, omp_get_thread_num, tn
+
+ REAL, DIMENSION(0:nx) :: work_fftx
+ REAL, DIMENSION(0:nx,1:nz) :: work_trix
+ REAL, DIMENSION(nnx,1:nza,nys_x:nyn_xa,pdims(1)) :: ar
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: tri
+
+
+ CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'start' )
+
+ ALLOCATE( tri(5,0:nx,0:nz-1,0:threads_per_task-1) )
+
+ tn = 0 ! Default thread number in case of one thread
+!$OMP PARALLEL DO PRIVATE ( i, j, k, m, n, tn, work_fftx, work_trix )
+ DO j = nys_x, nyn_x
+
+!$ tn = omp_get_thread_num()
+
+ IF ( host(1:3) == 'nec' ) THEN
+!
+!-- Code optimized for vector processors
+ DO k = 1, nz
+
+ m = 0
+ DO n = 1, pdims(1)
+ DO i = 1, nnx_pe( n-1 ) ! WARN: pcoord(i) should be used!!
+ work_trix(m,k) = ar(i,k,j,n)
+ m = m + 1
+ ENDDO
+ ENDDO
+
+ ENDDO
+
+ CALL fft_x_m( work_trix, 'forward' )
+
+ ELSE
+!
+!-- Cache optimized code
+ DO k = 1, nz
+
+ m = 0
+ DO n = 1, pdims(1)
+ DO i = 1, nnx_pe( n-1 ) ! WARN: pcoord(i) should be used!!
+ work_fftx(m) = ar(i,k,j,n)
+ m = m + 1
+ ENDDO
+ ENDDO
+
+ CALL fft_x( work_fftx, 'forward' )
+
+ DO i = 0, nx
+ work_trix(i,k) = work_fftx(i)
+ ENDDO
+
+ ENDDO
+
+ ENDIF
+
+!
+!-- Solve the linear equation system
+ CALL tridia_1dd( ddx2, ddy2, nx, ny, j, work_trix, tri(:,:,:,tn) )
+
+ IF ( host(1:3) == 'nec' ) THEN
+!
+!-- Code optimized for vector processors
+ CALL fft_x_m( work_trix, 'backward' )
+
+ DO k = 1, nz
+
+ m = 0
+ DO n = 1, pdims(1)
+ DO i = 1, nnx_pe( n-1 ) ! WARN: pcoord(i) should be used!!
+ ar(i,k,j,n) = work_trix(m,k)
+ m = m + 1
+ ENDDO
+ ENDDO
+
+ ENDDO
+
+ ELSE
+!
+!-- Cache optimized code
+ DO k = 1, nz
+
+ DO i = 0, nx
+ work_fftx(i) = work_trix(i,k)
+ ENDDO
+
+ CALL fft_x( work_fftx, 'backward' )
+
+ m = 0
+ DO n = 1, pdims(1)
+ DO i = 1, nnx_pe( n-1 ) ! WARN: pcoord(i) should be used!!
+ ar(i,k,j,n) = work_fftx(m)
+ m = m + 1
+ ENDDO
+ ENDDO
+
+ ENDDO
+
+ ENDIF
+
+ ENDDO
+
+ DEALLOCATE( tri )
+
+ CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'stop' )
+
+ END SUBROUTINE fftx_tri_fftx
+
+
+ SUBROUTINE fftx_tr_xy( f_in, work, f_out )
+
+!------------------------------------------------------------------------------!
+! Fourier-transformation along x with subsequent transposition x --> y for
+! a 1d-decomposition along y
+!
+! ATTENTION: The NEC-branch of this routine may significantly profit from
+! further optimizations. So far, performance is much worse than
+! for routine ffty_tr_yx (more than three times slower).
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL, DIMENSION(0:nx,1:nz,nys:nyn) :: work_fftx
+ REAL, DIMENSION(1:nza,nys:nyna,0:nxa) :: f_in
+ REAL, DIMENSION(nny,1:nza,nxl_y:nxr_ya,pdims(2)) :: f_out
+ REAL, DIMENSION(nys:nyna,1:nza,0:nxa) :: work
+
+!
+!-- Carry out the FFT along x, where all data are present due to the
+!-- 1d-decomposition along y. Resort the data in a way that y becomes
+!-- the first index.
+ CALL cpu_log( log_point_s(4), 'fft_x', 'start' )
+
+ IF ( host(1:3) == 'nec' ) THEN
+!
+!-- Code for vector processors
+!$OMP PARALLEL PRIVATE ( i, j, k )
+!$OMP DO
+ DO i = 0, nx
+
+ DO j = nys, nyn
+ DO k = 1, nz
+ work_fftx(i,k,j) = f_in(k,j,i)
+ ENDDO
+ ENDDO
+
+ ENDDO
+
+!$OMP DO
+ DO j = nys, nyn
+
+ CALL fft_x_m( work_fftx(:,:,j), 'forward' )
+
+ DO k = 1, nz
+ DO i = 0, nx
+ work(j,k,i) = work_fftx(i,k,j)
+ ENDDO
+ ENDDO
+
+ ENDDO
+!$OMP END PARALLEL
+
+ ELSE
+
+!
+!-- Cache optimized code (there might be still a potential for better
+!-- optimization).
+!$OMP PARALLEL PRIVATE (i,j,k,work_fftx)
+!$OMP DO
+ DO i = 0, nx
+
+ DO j = nys, nyn
+ DO k = 1, nz
+ work_fftx(i,k,j) = f_in(k,j,i)
+ ENDDO
+ ENDDO
+
+ ENDDO
+
+!$OMP DO
+ DO j = nys, nyn
+ DO k = 1, nz
+
+ CALL fft_x( work_fftx(0:nx,k,j), 'forward' )
+
+ DO i = 0, nx
+ work(j,k,i) = work_fftx(i,k,j)
+ ENDDO
+ ENDDO
+
+ ENDDO
+!$OMP END PARALLEL
+
+ ENDIF
+ CALL cpu_log( log_point_s(4), 'fft_x', 'pause' )
+
+!
+!-- Transpose array
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+ CALL MPI_ALLTOALL( work(nys,1,0), sendrecvcount_xy, MPI_REAL, &
+ f_out(1,1,nxl_y,1), sendrecvcount_xy, MPI_REAL, &
+ comm1dy, ierr )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+ END SUBROUTINE fftx_tr_xy
+
+
+ SUBROUTINE tr_yx_fftx( f_in, work, f_out )
+
+!------------------------------------------------------------------------------!
+! Transposition y --> x with a subsequent backward Fourier transformation for
+! a 1d-decomposition along x
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL, DIMENSION(0:nx,1:nz,nys:nyn) :: work_fftx
+ REAL, DIMENSION(nny,1:nza,nxl_y:nxr_ya,pdims(2)) :: f_in
+ REAL, DIMENSION(1:nza,nys:nyna,0:nxa) :: f_out
+ REAL, DIMENSION(nys:nyna,1:nza,0:nxa) :: work
+
+!
+!-- Transpose array
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+ CALL MPI_ALLTOALL( f_in(1,1,nxl_y,1), sendrecvcount_xy, MPI_REAL, &
+ work(nys,1,0), sendrecvcount_xy, MPI_REAL, &
+ comm1dy, ierr )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!-- Carry out the FFT along x, where all data are present due to the
+!-- 1d-decomposition along y. Resort the data in a way that y becomes
+!-- the first index.
+ CALL cpu_log( log_point_s(4), 'fft_x', 'continue' )
+
+ IF ( host(1:3) == 'nec' ) THEN
+!
+!-- Code optimized for vector processors
+!$OMP PARALLEL PRIVATE ( i, j, k )
+!$OMP DO
+ DO j = nys, nyn
+
+ DO k = 1, nz
+ DO i = 0, nx
+ work_fftx(i,k,j) = work(j,k,i)
+ ENDDO
+ ENDDO
+
+ CALL fft_x_m( work_fftx(:,:,j), 'backward' )
+
+ ENDDO
+
+!$OMP DO
+ DO i = 0, nx
+ DO j = nys, nyn
+ DO k = 1, nz
+ f_out(k,j,i) = work_fftx(i,k,j)
+ ENDDO
+ ENDDO
+ ENDDO
+!$OMP END PARALLEL
+
+ ELSE
+
+!
+!-- Cache optimized code (there might be still a potential for better
+!-- optimization).
+!$OMP PARALLEL PRIVATE (i,j,k,work_fftx)
+!$OMP DO
+ DO j = nys, nyn
+ DO k = 1, nz
+
+ DO i = 0, nx
+ work_fftx(i,k,j) = work(j,k,i)
+ ENDDO
+
+ CALL fft_x( work_fftx(0:nx,k,j), 'backward' )
+
+ ENDDO
+ ENDDO
+
+!$OMP DO
+ DO i = 0, nx
+ DO j = nys, nyn
+ DO k = 1, nz
+ f_out(k,j,i) = work_fftx(i,k,j)
+ ENDDO
+ ENDDO
+ ENDDO
+!$OMP END PARALLEL
+
+ ENDIF
+ CALL cpu_log( log_point_s(4), 'fft_x', 'stop' )
+
+ END SUBROUTINE tr_yx_fftx
+
+
+ SUBROUTINE ffty_tri_ffty( ar )
+
+!------------------------------------------------------------------------------!
+! FFT along y, solution of the tridiagonal system and backward FFT for
+! a 1d-decomposition along y
+!
+! WARNING: this subroutine may still not work for hybrid parallelization
+! with OpenMP (for possible necessary changes see the original
+! routine poisfft_hybrid, developed by Klaus Ketelsen, May 2002)
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, m, n, omp_get_thread_num, tn
+
+ REAL, DIMENSION(0:ny) :: work_ffty
+ REAL, DIMENSION(0:ny,1:nz) :: work_triy
+ REAL, DIMENSION(nny,1:nza,nxl_y:nxr_ya,pdims(2)) :: ar
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: tri
+
+
+ CALL cpu_log( log_point_s(39), 'fft_y + tridia', 'start' )
+
+ ALLOCATE( tri(5,0:ny,0:nz-1,0:threads_per_task-1) )
+
+ tn = 0 ! Default thread number in case of one thread
+!$OMP PARALLEL PRIVATE ( i, j, k, m, n, tn, work_ffty, work_triy )
+!$OMP DO
+ DO i = nxl_y, nxr_y
+
+!$ tn = omp_get_thread_num()
+
+ IF ( host(1:3) == 'nec' ) THEN
+!
+!-- Code optimized for vector processors
+ DO k = 1, nz
+
+ m = 0
+ DO n = 1, pdims(2)
+ DO j = 1, nny_pe( n-1 ) ! WARN: pcoord(j) should be used!!
+ work_triy(m,k) = ar(j,k,i,n)
+ m = m + 1
+ ENDDO
+ ENDDO
+
+ ENDDO
+
+ CALL fft_y_m( work_triy, ny, 'forward' )
+
+ ELSE
+!
+!-- Cache optimized code
+ DO k = 1, nz
+
+ m = 0
+ DO n = 1, pdims(2)
+ DO j = 1, nny_pe( n-1 ) ! WARN: pcoord(j) should be used!!
+ work_ffty(m) = ar(j,k,i,n)
+ m = m + 1
+ ENDDO
+ ENDDO
+
+ CALL fft_y( work_ffty, 'forward' )
+
+ DO j = 0, ny
+ work_triy(j,k) = work_ffty(j)
+ ENDDO
+
+ ENDDO
+
+ ENDIF
+
+!
+!-- Solve the linear equation system
+ CALL tridia_1dd( ddy2, ddx2, ny, nx, i, work_triy, tri(:,:,:,tn) )
+
+ IF ( host(1:3) == 'nec' ) THEN
+!
+!-- Code optimized for vector processors
+ CALL fft_y_m( work_triy, ny, 'backward' )
+
+ DO k = 1, nz
+
+ m = 0
+ DO n = 1, pdims(2)
+ DO j = 1, nny_pe( n-1 ) ! WARN: pcoord(j) should be used!!
+ ar(j,k,i,n) = work_triy(m,k)
+ m = m + 1
+ ENDDO
+ ENDDO
+
+ ENDDO
+
+ ELSE
+!
+!-- Cache optimized code
+ DO k = 1, nz
+
+ DO j = 0, ny
+ work_ffty(j) = work_triy(j,k)
+ ENDDO
+
+ CALL fft_y( work_ffty, 'backward' )
+
+ m = 0
+ DO n = 1, pdims(2)
+ DO j = 1, nny_pe( n-1 ) ! WARN: pcoord(j) should be used!!
+ ar(j,k,i,n) = work_ffty(m)
+ m = m + 1
+ ENDDO
+ ENDDO
+
+ ENDDO
+
+ ENDIF
+
+ ENDDO
+!$OMP END PARALLEL
+
+ DEALLOCATE( tri )
+
+ CALL cpu_log( log_point_s(39), 'fft_y + tridia', 'stop' )
+
+ END SUBROUTINE ffty_tri_ffty
+
+
+ SUBROUTINE tridia_1dd( ddx2, ddy2, nx, ny, j, ar, tri )
+
+!------------------------------------------------------------------------------!
+! Solves the linear system of equations for a 1d-decomposition along x (see
+! tridia)
+!
+! Attention: when using the intel compiler, array tri must be passed as an
+! argument to the contained subroutines. Otherwise addres faults
+! will occur.
+! On NEC, tri should not be passed (except for routine substi_1dd)
+! because this causes very bad performance.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, nnyh, nx, ny, omp_get_thread_num, tn
+
+ REAL :: ddx2, ddy2
+
+ REAL, DIMENSION(0:nx,1:nz) :: ar
+ REAL, DIMENSION(0:nx,0:nz-1) :: ar1
+ REAL, DIMENSION(5,0:nx,0:nz-1) :: tri
+
+
+ nnyh = ( ny + 1 ) / 2
+
+!
+!-- Define constant elements of the tridiagonal matrix.
+!-- The compiler on SX6 does loop exchange. If 0:nx is a high power of 2,
+!-- the exchanged loops create bank conflicts. The following directive
+!-- prohibits loop exchange and the loops perform much better.
+! tn = omp_get_thread_num()
+! WRITE( 120+tn, * ) '+++ id=',myid,' nx=',nx,' thread=', omp_get_thread_num()
+! CALL local_flush( 120+tn )
+!CDIR NOLOOPCHG
+ DO k = 0, nz-1
+ DO i = 0,nx
+ tri(2,i,k) = ddzu(k+1) * ddzw(k+1)
+ tri(3,i,k) = ddzu(k+2) * ddzw(k+1)
+ ENDDO
+ ENDDO
+! WRITE( 120+tn, * ) '+++ id=',myid,' end of first tridia loop thread=', omp_get_thread_num()
+! CALL local_flush( 120+tn )
+
+ IF ( j <= nnyh ) THEN
+#if defined( __lcmuk )
+ CALL maketri_1dd( j, tri )
+#else
+ CALL maketri_1dd( j )
+#endif
+ ELSE
+#if defined( __lcmuk )
+ CALL maketri_1dd( ny+1-j, tri )
+#else
+ CALL maketri_1dd( ny+1-j )
+#endif
+ ENDIF
+#if defined( __lcmuk )
+ CALL split_1dd( tri )
+#else
+ CALL split_1dd
+#endif
+ CALL substi_1dd( ar, tri )
+
+ CONTAINS
+
+#if defined( __lcmuk )
+ SUBROUTINE maketri_1dd( j, tri )
+#else
+ SUBROUTINE maketri_1dd( j )
+#endif
+
+!------------------------------------------------------------------------------!
+! computes the i- and j-dependent component of the matrix
+!------------------------------------------------------------------------------!
+
+ USE constants
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, nnxh
+ REAL :: a, c
+
+ REAL, DIMENSION(0:nx) :: l
+
+#if defined( __lcmuk )
+ REAL, DIMENSION(5,0:nx,0:nz-1) :: tri
+#endif
+
+
+ nnxh = ( nx + 1 ) / 2
+!
+!-- Provide the tridiagonal matrix for solution of the Poisson equation in
+!-- Fourier space. The coefficients are computed following the method of
+!-- Schmidt et al. (DFVLR-Mitteilung 84-15), which departs from Stephan
+!-- Siano's original version by discretizing the Poisson equation,
+!-- before it is Fourier-transformed
+ DO i = 0, nx
+ IF ( i >= 0 .AND. i <= nnxh ) THEN
+ l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * i ) / &
+ FLOAT( nx+1 ) ) ) * ddx2 + &
+ 2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+ FLOAT( ny+1 ) ) ) * ddy2
+ ELSE
+ l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( nx+1-i ) ) / &
+ FLOAT( nx+1 ) ) ) * ddx2 + &
+ 2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+ FLOAT( ny+1 ) ) ) * ddy2
+ ENDIF
+ ENDDO
+
+ DO k = 0, nz-1
+ DO i = 0, nx
+ a = -1.0 * ddzu(k+2) * ddzw(k+1)
+ c = -1.0 * ddzu(k+1) * ddzw(k+1)
+ tri(1,i,k) = a + c - l(i)
+ ENDDO
+ ENDDO
+ IF ( ibc_p_b == 1 .OR. ibc_p_b == 2 ) THEN
+ DO i = 0, nx
+ tri(1,i,0) = tri(1,i,0) + tri(2,i,0)
+ ENDDO
+ ENDIF
+ IF ( ibc_p_t == 1 ) THEN
+ DO i = 0, nx
+ tri(1,i,nz-1) = tri(1,i,nz-1) + tri(3,i,nz-1)
+ ENDDO
+ ENDIF
+
+ END SUBROUTINE maketri_1dd
+
+
+#if defined( __lcmuk )
+ SUBROUTINE split_1dd( tri )
+#else
+ SUBROUTINE split_1dd
+#endif
+
+!------------------------------------------------------------------------------!
+! Splitting of the tridiagonal matrix (Thomas algorithm)
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ INTEGER :: i, k
+
+#if defined( __lcmuk )
+ REAL, DIMENSION(5,0:nx,0:nz-1) :: tri
+#endif
+
+
+!
+!-- Splitting
+ DO i = 0, nx
+ tri(4,i,0) = tri(1,i,0)
+ ENDDO
+ DO k = 1, nz-1
+ DO i = 0, nx
+ tri(5,i,k) = tri(2,i,k) / tri(4,i,k-1)
+ tri(4,i,k) = tri(1,i,k) - tri(3,i,k-1) * tri(5,i,k)
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE split_1dd
+
+
+ SUBROUTINE substi_1dd( ar, tri )
+
+!------------------------------------------------------------------------------!
+! Substitution (Forward and Backward) (Thomas algorithm)
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ INTEGER :: i, k
+
+ REAL, DIMENSION(0:nx,nz) :: ar
+ REAL, DIMENSION(0:nx,0:nz-1) :: ar1
+ REAL, DIMENSION(5,0:nx,0:nz-1) :: tri
+
+!
+!-- Forward substitution
+ DO i = 0, nx
+ ar1(i,0) = ar(i,1)
+ ENDDO
+ DO k = 1, nz-1
+ DO i = 0, nx
+ ar1(i,k) = ar(i,k+1) - tri(5,i,k) * ar1(i,k-1)
+ ENDDO
+ ENDDO
+
+!
+!-- Backward substitution
+ DO i = 0, nx
+ ar(i,nz) = ar1(i,nz-1) / tri(4,i,nz-1)
+ ENDDO
+ DO k = nz-2, 0, -1
+ DO i = 0, nx
+ ar(i,k+1) = ( ar1(i,k) - tri(3,i,k) * ar(i,k+2) ) &
+ / tri(4,i,k)
+ ENDDO
+ ENDDO
+
+!
+!-- Indices i=0, j=0 correspond to horizontally averaged pressure.
+!-- The respective values of ar should be zero at all k-levels if
+!-- acceleration of horizontally averaged vertical velocity is zero.
+ IF ( ibc_p_b == 1 .AND. ibc_p_t == 1 ) THEN
+ IF ( j == 0 ) THEN
+ DO k = 1, nz
+ ar(0,k) = 0.0
+ ENDDO
+ ENDIF
+ ENDIF
+
+ END SUBROUTINE substi_1dd
+
+ END SUBROUTINE tridia_1dd
+
+#endif
+
+ END MODULE poisfft_mod
Index: /palm/tags/release-3.4a/SOURCE/poisfft_hybrid.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/poisfft_hybrid.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/poisfft_hybrid.f90 (revision 141)
@@ -0,0 +1,1048 @@
+ MODULE poisfft_hybrid_mod
+!------------------------------------------------------------------------------
+!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.11 2004/04/30 12:43:14 raasch
+! Renaming of fft routines, additional argument in calls of fft_y_m
+!
+! Revision 1.2 2002/12/19 16:08:31 raasch
+! Preprocessor directive KKMP introduced (OMP does NOT work),
+! array tri will be a shared array in OpenMP loop, to get better cache
+! utilization, the i index (x-direction) will be executed in stride
+! "istride" as outer loop and in a shorter inner loop,
+! overlapping of computation and communication realized by new routine
+! poisfft_hybrid_nodes, name of old routine poisfft_hybrid changed to
+! poisfft_hybrid_omp, STOP statement replaced by call of subroutine local_stop
+!
+!
+! Description:
+! ------------
+! Solution of the Poisson equation with a 2D spectral method.
+! Hybrid version for parallel computers using a 1D domain decomposition,
+! realized with MPI, along x and parallelization with OPEN-MP along y
+! (routine poisfft_hybrid_omp). In a second version (poisfft_hybrid_nodes),
+! optimization is realized by overlapping of computation and communication
+! and by simultaneously executing as many communication calls as switches
+! per logical partition (LPAR) are available. This version comes into
+! effect if more than one node is used and if the environment variable
+! tasks_per_node is set in a way that it can be devided by switch_per_lpar
+! without any rest.
+!
+! WARNING: In case of OpenMP, there are problems with allocating large
+! arrays in parallel regions.
+!
+! Copyright Klaus Ketelsen / Siegfried Raasch May 2002
+!------------------------------------------------------------------------------!
+
+ USE fft_xy
+ USE indices
+ USE pegrid
+
+ IMPLICIT NONE
+
+ PRIVATE
+ PUBLIC poisfft_hybrid, poisfft_hybrid_ini
+
+ INTEGER, PARAMETER :: switch_per_lpar = 2
+
+ INTEGER, SAVE :: nxl_a, nxr_a, & ! total x dimension
+ nxl_p, nxr_p, & ! partial x dimension
+ nys_a, nyn_a, & ! total y dimension
+ nys_p, nyn_p, & ! partial y dimension
+
+ npe_s, & ! total number of PEs for solver
+ nwords, & ! number of points to be exchanged
+ ! with MPI_ALLTOALL
+ n_omp_threads ! number of OpenMP threads
+
+!
+!-- Variables for multi node version (cluster version) using routine
+!-- poisfft_hybrid_nodes
+ INTEGER, SAVE :: comm_nodes, & ! communicater nodes
+ comm_node_all, & ! communicater all PEs node version
+ comm_tasks, & ! communicater tasks
+ me, me_node, me_task,& ! identity of this PE
+ nodes, & ! number of nodes
+ tasks_per_logical_node = -1 ! default no cluster
+
+
+!
+!-- Public interfaces
+ INTERFACE poisfft_hybrid_ini
+ MODULE PROCEDURE poisfft_hybrid_ini
+ END INTERFACE poisfft_hybrid_ini
+
+ INTERFACE poisfft_hybrid
+ MODULE PROCEDURE poisfft_hybrid
+ END INTERFACE poisfft_hybrid
+
+!
+!-- Private interfaces
+ INTERFACE poisfft_hybrid_omp
+ MODULE PROCEDURE poisfft_hybrid_omp
+ END INTERFACE poisfft_hybrid_omp
+
+ INTERFACE poisfft_hybrid_omp_vec
+ MODULE PROCEDURE poisfft_hybrid_omp_vec
+ END INTERFACE poisfft_hybrid_omp_vec
+
+ INTERFACE poisfft_hybrid_nodes
+ MODULE PROCEDURE poisfft_hybrid_nodes
+ END INTERFACE poisfft_hybrid_nodes
+
+ INTERFACE tridia_hybrid
+ MODULE PROCEDURE tridia_hybrid
+ END INTERFACE tridia_hybrid
+
+ INTERFACE cascade
+ MODULE PROCEDURE cascade
+ END INTERFACE cascade
+
+ CONTAINS
+
+
+ SUBROUTINE poisfft_hybrid_ini
+
+ USE control_parameters
+ USE pegrid
+
+ IMPLICIT NONE
+
+ CHARACTER(LEN=8) :: cdummy
+ INTEGER :: idummy, istat
+ INTEGER, DIMENSION(2) :: coords, dims
+
+ LOGICAL, DIMENSION(2) :: period = .false., re_dims
+
+
+!
+!-- Set the internal index values for the hybrid solver
+#if defined( __parallel )
+ npe_s = pdims(1)
+#else
+ npe_s = 1
+#endif
+ nxl_a = 0
+ nxr_a = nx
+ nxl_p = 0
+ nxr_p = ( ( nx+1 ) / npe_s ) - 1
+ nys_a = nys
+ nyn_a = nyn
+ nys_p = 0
+ nyn_p = ( ( ny+1 ) / npe_s ) - 1
+
+ nwords = ( nxr_p-nxl_p+1 ) * nz * ( nyn_p-nys_p+1 )
+
+#if defined( __KKMP )
+ CALL LOCAL_GETENV( 'OMP_NUM_THREADS', 15, cdummy, idummy )
+ READ ( cdummy, '(I8)' ) n_omp_threads
+ IF ( myid == 0 .AND. n_omp_threads > 1 ) THEN
+ PRINT*, '*** poisfft_hybrid_ini: Number of OpenMP threads = ', &
+ n_omp_threads
+ ENDIF
+#else
+ n_omp_threads = 1
+#endif
+!
+!-- Initialize the one-dimensional FFT routines
+ CALL fft_init
+
+!
+!-- Setup for multi node version (poisfft_hybrid_nodes)
+ IF ( n_omp_threads == 1 .AND. &
+ ( host(1:4) == 'ibmh' .OR. host(1:4) == 'ibmb' ) ) THEN
+
+ IF ( tasks_per_node /= -9999 ) THEN
+!
+!-- Multi node version requires that the available number of
+!-- switches per logical partition must be an integral divisor
+!-- of the chosen number of tasks per node
+ IF ( MOD( tasks_per_node, switch_per_lpar ) == 0 ) THEN
+!
+!-- Set the switch which decides about usage of the multi node
+!-- version
+ IF ( tasks_per_node / switch_per_lpar > 1 .AND. &
+ numprocs > tasks_per_node ) THEN
+ tasks_per_logical_node = tasks_per_node / switch_per_lpar
+ ENDIF
+
+ IF ( myid == 0 .AND. tasks_per_logical_node > -1 ) THEN
+ PRINT*, '*** poisfft_hybrid_ini: running optimized ', &
+ 'multinode version'
+ PRINT*, ' switch_per_lpar = ', switch_per_lpar
+ PRINT*, ' tasks_per_lpar = ', tasks_per_node
+ PRINT*, ' tasks_per_logical_node = ', &
+ tasks_per_logical_node
+ ENDIF
+
+ ENDIF
+ ENDIF
+ ENDIF
+
+!
+!-- Determine sub-topologies for multi node version
+ IF ( tasks_per_logical_node >= 2 ) THEN
+
+#if defined( __parallel )
+ nodes = ( numprocs + tasks_per_logical_node - 1 ) / &
+ tasks_per_logical_node
+ dims(1) = nodes
+ dims(2) = tasks_per_logical_node
+
+ CALL MPI_CART_CREATE( comm2d, 2, dims, period, .FALSE., &
+ comm_node_all, istat )
+ CALL MPI_COMM_RANK( comm_node_all, me, istat )
+
+ re_dims(1) = .TRUE.
+ re_dims(2) = .FALSE.
+ CALL MPI_CART_SUB( comm_node_all, re_dims, comm_nodes, istat )
+ CALL MPI_COMM_RANK( comm_nodes, me_node, istat )
+
+ re_dims(1) = .FALSE.
+ re_dims(2) = .TRUE.
+ CALL MPI_CART_SUB( comm_node_all, re_dims, comm_tasks, istat )
+ CALL MPI_COMM_RANK( comm_tasks, me_task, istat )
+
+! write(0,*) 'who am i',myid,me,me_node,me_task,nodes,&
+! tasks_per_logical_node
+#else
+ PRINT*, '+++ poisfft_hybrid_ini: parallel environment (MPI) required'
+ CALL local_stop
+#endif
+ ENDIF
+
+ END SUBROUTINE poisfft_hybrid_ini
+
+
+ SUBROUTINE poisfft_hybrid( ar )
+
+ USE control_parameters
+ USE interfaces
+
+ IMPLICIT NONE
+
+ REAL, DIMENSION(1:nz,nys:nyn,nxl:nxr) :: ar
+
+ IF ( host(1:3) == 'nec' ) THEN
+ CALL poisfft_hybrid_omp_vec( ar )
+ ELSE
+ IF ( tasks_per_logical_node == -1 ) THEN
+ CALL poisfft_hybrid_omp( ar )
+ ELSE
+ CALL poisfft_hybrid_nodes( ar )
+ ENDIF
+ ENDIF
+
+ END SUBROUTINE poisfft_hybrid
+
+
+ SUBROUTINE poisfft_hybrid_omp ( ar )
+
+ USE cpulog
+ USE interfaces
+
+ IMPLICIT NONE
+
+ INTEGER, PARAMETER :: istride = 4 ! stride of i loop
+ INTEGER :: i, ii, ir, iei, iouter, istat, j, jj, k, m, n, jthread
+
+ REAL, DIMENSION(1:nz,nys:nyn,nxl:nxr) :: ar
+
+ REAL, DIMENSION(0:nx) :: fftx_ar
+ REAL, DIMENSION(0:ny,istride) :: ffty_ar
+
+ REAL, DIMENSION(0:nx,nz) :: tri_ar
+
+ REAL, DIMENSION(nxl_p:nxr_p,nz,nys_p:nyn_p,npe_s) :: work1, work2
+#if defined( __KKMP )
+ INTEGER :: omp_get_thread_num
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: tri
+ ALLOCATE( tri(5,0:nx,0:nz-1,n_omp_threads ) )
+#else
+ REAL, DIMENSION(5,0:nx,0:nz-1,1) :: tri
+#endif
+
+
+ CALL cpu_log( log_point_s(30), 'poisfft_hybrid_omp', 'start' )
+
+ CALL cpu_log( log_point_s(7), 'fft_y', 'start' )
+
+!$OMP PARALLEL PRIVATE (i,iouter,ii,ir,iei,j,k,m,n,ffty_ar)
+!$OMP DO
+!
+!-- Store grid points to be transformed on a 1d-array, do the fft
+!-- and sample the results on a 4d-array
+ DO iouter = nxl_p, nxr_p, istride ! stride loop, better cache
+ iei = MIN( iouter+istride-1, nxr_p )
+ DO k = 1, nz
+
+ DO i = iouter, iei
+ ii = nxl + i
+ ir = i - iouter + 1
+
+ DO j = nys_a, nyn_a
+ ffty_ar(j,ir) = ar(k,j,ii)
+ ENDDO
+
+ CALL fft_y( ffty_ar(:,ir), 'forward' )
+ ENDDO
+
+ m = nys_a
+ DO n = 1, npe_s
+ DO j = nys_p, nyn_p
+ DO i = iouter, iei
+ ir = i - iouter + 1
+ work1(i,k,j,n) = ffty_ar(m,ir)
+ ENDDO
+ m = m+1
+ ENDDO
+ ENDDO
+
+ ENDDO
+ ENDDO
+!$OMP END PARALLEL
+
+ CALL cpu_log( log_point_s(7), 'fft_y', 'pause' )
+
+#if defined( __parallel )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+
+ CALL MPI_ALLTOALL( work1(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+ work2(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+ comm2d, istat )
+
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+#else
+ work2 = work1
+#endif
+
+ CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'start' )
+
+#if defined( __KKMP )
+!$OMP PARALLEL PRIVATE (i,j,jj,k,m,n,fftx_ar,tri_ar,jthread)
+!$OMP DO
+ DO j = nys_p, nyn_p
+ jthread = omp_get_thread_num() + 1
+#else
+ DO j = nys_p, nyn_p
+ jthread = 1
+#endif
+ DO k = 1, nz
+
+ m = nxl_a
+ DO n = 1, npe_s
+ DO i = nxl_p, nxr_p
+ fftx_ar(m) = work2(i,k,j,n)
+ m = m+1
+ ENDDO
+ ENDDO
+
+ CALL fft_x( fftx_ar, 'forward' )
+
+ DO i = nxl_a, nxr_a
+ tri_ar(i,k) = fftx_ar(i)
+ ENDDO
+
+ ENDDO
+
+ jj = myid * (nyn_p-nys_p+1) + j
+ CALL tridia_hybrid( jj, tri_ar, tri(:,:,:,jthread))
+
+ DO k = 1, nz
+ DO i = nxl_a, nxr_a
+ fftx_ar(i) = tri_ar (i,k)
+ ENDDO
+
+ CALL fft_x( fftx_ar, 'backward' )
+
+ m = nxl_a
+ DO n = 1, npe_s
+ DO i = nxl_p, nxr_p
+ work2(i,k,j,n) = fftx_ar(m)
+ m = m+1
+ ENDDO
+ ENDDO
+
+ ENDDO
+ ENDDO
+#if defined( __KKMP )
+!$OMP END PARALLEL
+#endif
+
+ CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'stop' )
+
+#if defined( __parallel )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+ nwords = (nxr_p-nxl_p+1) * nz * (nyn_p-nys_p+1)
+
+ CALL MPI_ALLTOALL( work2(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+ work1(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+ comm2d, istat )
+
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+#else
+ work1 = work2
+#endif
+
+ CALL cpu_log( log_point_s(7), 'fft_y', 'continue' )
+
+!$OMP PARALLEL PRIVATE (i,iouter,ii,ir,iei,j,k,m,n,ffty_ar)
+!$OMP DO
+ DO iouter = nxl_p, nxr_p, istride
+ iei = MIN( iouter+istride-1, nxr_p )
+ DO k = 1, nz
+
+ m = nys_a
+ DO n = 1, npe_s
+ DO j = nys_p, nyn_p
+ DO i = iouter, iei
+ ir = i - iouter + 1
+ ffty_ar(m,ir) = work1 (i,k,j,n)
+ ENDDO
+ m = m+1
+ ENDDO
+ ENDDO
+
+ DO i = iouter, iei
+ ii = nxl + i
+ ir = i - iouter + 1
+ CALL fft_y( ffty_ar(:,ir), 'backward' )
+
+ DO j = nys_a, nyn_a
+ ar(k,j,ii) = ffty_ar(j,ir)
+ ENDDO
+ ENDDO
+
+ ENDDO
+ ENDDO
+!$OMP END PARALLEL
+
+ CALL cpu_log( log_point_s(7), 'fft_y', 'stop' )
+
+ CALL cpu_log( log_point_s(30), 'poisfft_hybrid_omp', 'stop' )
+
+#if defined( __KKMP )
+ DEALLOCATE( tri )
+#endif
+
+ END SUBROUTINE poisfft_hybrid_omp
+
+
+ SUBROUTINE poisfft_hybrid_omp_vec ( ar )
+
+ USE cpulog
+ USE interfaces
+
+ IMPLICIT NONE
+
+ INTEGER, PARAMETER :: istride = 4 ! stride of i loop
+ INTEGER :: i, ii, ir, iei, iouter, istat, j, jj, k, m, n, jthread
+
+ REAL, DIMENSION(0:nx,nz) :: tri_ar
+
+ REAL, DIMENSION(1:nz,nys:nyn,nxl:nxr) :: ar
+
+ REAL, DIMENSION(0:ny+3,nz,nxl_p:nxr_p) :: ffty_ar3
+ REAL, DIMENSION(0:nx+3,nz,nys_p:nyn_p) :: fftx_ar3
+
+ REAL, DIMENSION(nxl_p:nxr_p,nz,nys_p:nyn_p,npe_s) :: work1, work2
+#if defined( __KKMP )
+ INTEGER :: omp_get_thread_num
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: tri
+ ALLOCATE( tri(5,0:nx,0:nz-1,n_omp_threads ) )
+#else
+ REAL, DIMENSION(5,0:nx,0:nz-1,1) :: tri
+#endif
+
+
+ CALL cpu_log( log_point_s(30), 'poisfft_hybrid_vec', 'start' )
+
+ CALL cpu_log( log_point_s(7), 'fft_y_m', 'start' )
+
+!$OMP PARALLEL PRIVATE (i,j,k,m,n)
+!$OMP DO
+!
+!-- Store grid points to be transformed on a 1d-array, do the fft
+!-- and sample the results on a 4d-array
+ DO i = nxl_p, nxr_p
+
+ DO j = nys_a, nyn_a
+ DO k = 1, nz
+ ffty_ar3(j,k,i) = ar(k,j,i+nxl)
+ ENDDO
+ ENDDO
+
+ CALL fft_y_m( ffty_ar3(:,:,i), ny+3, 'forward' )
+ ENDDO
+
+!$OMP DO
+ DO k = 1, nz
+ m = nys_a
+ DO n = 1, npe_s
+ DO j = nys_p, nyn_p
+ DO i = nxl_p, nxr_p
+ work1(i,k,j,n) = ffty_ar3(m,k,i)
+ ENDDO
+ m = m+1
+ ENDDO
+ ENDDO
+ ENDDO
+!$OMP END PARALLEL
+
+ CALL cpu_log( log_point_s(7), 'fft_y_m', 'pause' )
+
+#if defined( __parallel )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+ CALL MPI_ALLTOALL( work1(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+ work2(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+ comm2d, istat )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+#else
+ work2 = work1
+#endif
+
+ CALL cpu_log( log_point_s(33), 'fft_x_m + tridia', 'start' )
+
+#if defined( __KKMP )
+!$OMP PARALLEL PRIVATE (i,j,jj,k,m,n,tri_ar,jthread)
+!$OMP DO
+ DO j = nys_p, nyn_p
+ jthread = omp_get_thread_num() + 1
+#else
+ DO j = nys_p, nyn_p
+ jthread = 1
+#endif
+ DO k = 1, nz
+
+ m = nxl_a
+ DO n = 1, npe_s
+ DO i = nxl_p, nxr_p
+ fftx_ar3(m,k,j) = work2(i,k,j,n)
+ m = m+1
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CALL fft_x_m( fftx_ar3(:,:,j), 'forward' )
+
+ DO k = 1, nz
+ DO i = nxl_a, nxr_a
+ tri_ar(i,k) = fftx_ar3(i,k,j)
+ ENDDO
+ ENDDO
+
+ jj = myid * (nyn_p-nys_p+1) + j
+ CALL tridia_hybrid( jj, tri_ar, tri(:,:,:,jthread))
+
+ DO k = 1, nz
+ DO i = nxl_a, nxr_a
+ fftx_ar3(i,k,j) = tri_ar (i,k)
+ ENDDO
+ ENDDO
+
+ CALL fft_x_m( fftx_ar3(:,:,j), 'backward' )
+
+ DO k = 1, nz
+ m = nxl_a
+ DO n = 1, npe_s
+ DO i = nxl_p, nxr_p
+ work2(i,k,j,n) = fftx_ar3(m,k,j)
+ m = m+1
+ ENDDO
+ ENDDO
+ ENDDO
+
+ ENDDO
+#if defined( __KKMP )
+!$OMP END PARALLEL
+#endif
+
+ CALL cpu_log( log_point_s(33), 'fft_x_m + tridia', 'stop' )
+
+#if defined( __parallel )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+ nwords = (nxr_p-nxl_p+1) * nz * (nyn_p-nys_p+1)
+ CALL MPI_ALLTOALL( work2(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+ work1(nxl_p,1,nys_p,1), nwords, MPI_REAL, &
+ comm2d, istat )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+#else
+ work1 = work2
+#endif
+
+ CALL cpu_log( log_point_s(7), 'fft_y_m', 'continue' )
+
+!$OMP PARALLEL PRIVATE (i,iouter,ii,ir,iei,j,k,m,n)
+!$OMP DO
+ DO k = 1, nz
+ m = nys_a
+ DO n = 1, npe_s
+ DO j = nys_p, nyn_p
+ DO i = nxl_p, nxr_p
+ ffty_ar3(m,k,i) = work1(i,k,j,n)
+ ENDDO
+ m = m+1
+ ENDDO
+ ENDDO
+ ENDDO
+
+!$OMP DO
+ DO i = nxl_p, nxr_p
+ CALL fft_y_m( ffty_ar3(:,:,i), ny+3, 'backward' )
+ DO j = nys_a, nyn_a
+ DO k = 1, nz
+ ar(k,j,i+nxl) = ffty_ar3(j,k,i)
+ ENDDO
+ ENDDO
+ ENDDO
+!$OMP END PARALLEL
+
+ CALL cpu_log( log_point_s(7), 'fft_y_m', 'stop' )
+
+ CALL cpu_log( log_point_s(30), 'poisfft_hybrid_vec', 'stop' )
+
+#if defined( __KKMP )
+ DEALLOCATE( tri )
+#endif
+
+ END SUBROUTINE poisfft_hybrid_omp_vec
+
+
+ SUBROUTINE poisfft_hybrid_nodes ( ar )
+
+ USE cpulog
+ USE interfaces
+
+ IMPLICIT NONE
+
+ INTEGER, PARAMETER :: istride = 4 ! stride of i loop
+ INTEGER :: i, iei, ii, iouter, ir, istat, j, jj, k, m, &
+ n, nn, nt, nw1, nw2
+
+ REAL, DIMENSION(1:nz,nys:nyn,nxl:nxr) :: ar
+
+ REAL, DIMENSION(0:nx) :: fftx_ar
+ REAL, DIMENSION(0:ny,istride) :: ffty_ar
+
+ REAL, DIMENSION(0:nx,nz) :: tri_ar
+
+ REAL, DIMENSION(nxl_p:nxr_p,nz,tasks_per_logical_node, &
+ nodes,nys_p:nyn_p) :: work1,work2
+ REAL, DIMENSION(5,0:nx,0:nz-1) :: tri
+
+
+ CALL cpu_log( log_point_s(30), 'poisfft_hybrid_nodes', 'start' )
+
+ CALL cpu_log( log_point_s(7), 'fft_y', 'start' )
+
+!
+!-- Store grid points to be transformed on a 1d-array, do the fft
+!-- and sample the results on a 4d-array
+ DO iouter = nxl_p, nxr_p, istride ! stride loop, better cache
+ iei = MIN( iouter+istride-1, nxr_p )
+ DO k = 1, nz
+
+ DO i = iouter, iei
+ ii = nxl + i
+ ir = i - iouter + 1
+
+ DO j = nys_a, nyn_a
+ ffty_ar(j,ir) = ar(k,j,ii)
+ ENDDO
+
+ CALL fft_y( ffty_ar(:,ir), 'forward' )
+ ENDDO
+
+ m = nys_a
+ DO nn = 1, nodes
+ DO nt = 1, tasks_per_logical_node
+ DO j = nys_p, nyn_p
+ DO i = iouter, iei
+ ir = i - iouter + 1
+ work1(i,k,nt,nn,j) = ffty_ar(m,ir)
+ ENDDO
+ m = m+1
+ ENDDO
+ ENDDO
+ ENDDO
+
+ ENDDO
+ ENDDO
+
+ CALL cpu_log( log_point_s(7), 'fft_y', 'pause' )
+
+ CALL cpu_log( log_point_s(32), 'alltoall_task', 'start' )
+ nw1 = SIZE( work1, 1 ) * SIZE( work1, 2 )
+ DO nn = 1, nodes
+ DO j = nys_p, nyn_p
+#if defined( __parallel )
+ CALL MPI_ALLTOALL( work1(nxl_p,1,1,nn,j), nw1, MPI_REAL, &
+ work2(nxl_p,1,1,nn,j), nw1, MPI_REAL, &
+ comm_tasks, istat )
+#endif
+ ENDDO
+ ENDDO
+ CALL cpu_log( log_point_s(32), 'alltoall_task', 'stop' )
+
+
+ DO j = nys_p, nyn_p
+
+ CALL cascade( 1, j, nys_p, nyn_p )
+ nw2 = nw1 * SIZE( work1, 3 )
+ CALL cpu_log( log_point_s(37), 'alltoall_node', 'start' )
+#if defined( __parallel )
+ CALL MPI_ALLTOALL( work2(nxl_p,1,1,1,j), nw2, MPI_REAL, &
+ work1(nxl_p,1,1,1,j), nw2, MPI_REAL, &
+ comm_nodes, istat )
+#endif
+ CALL cpu_log( log_point_s(37), 'alltoall_node', 'pause' )
+ CALL cascade( 2, j, nys_p, nyn_p )
+
+ CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'start' )
+ DO k = 1, nz
+
+ m = nxl_a
+ DO nn = 1, nodes
+ DO nt = 1, tasks_per_logical_node
+ DO i = nxl_p, nxr_p
+ fftx_ar(m) = work1(i,k,nt,nn,j)
+ m = m+1
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CALL fft_x( fftx_ar, 'forward' )
+
+ DO i = nxl_a, nxr_a
+ tri_ar(i,k) = fftx_ar(i)
+ ENDDO
+
+ ENDDO
+
+ jj = myid * (nyn_p-nys_p+1) + j
+ CALL tridia_hybrid( jj, tri_ar, tri(:,:,:) )
+
+ DO k = 1, nz
+ DO i = nxl_a, nxr_a
+ fftx_ar(i) = tri_ar(i,k)
+ ENDDO
+
+ CALL fft_x( fftx_ar, 'backward' )
+
+ m = nxl_a
+ DO nn = 1, nodes
+ DO nt = 1, tasks_per_logical_node
+ DO i = nxl_p, nxr_p
+ work1(i,k,nt,nn,j) = fftx_ar(m)
+ m = m+1
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CALL cpu_log( log_point_s(33), 'fft_x + tridia', 'stop' )
+ nw2 = nw1 * SIZE( work1, 3 )
+ CALL cpu_log( log_point_s(37), 'alltoall_node', 'continue' )
+#if defined( __parallel )
+ CALL MPI_ALLTOALL( work1(nxl_p,1,1,1,j), nw2, MPI_REAL, &
+ work2(nxl_p,1,1,1,j), nw2, MPI_REAL, &
+ comm_nodes, istat )
+#endif
+ CALL cpu_log( log_point_s(37), 'alltoall_node', 'stop' )
+
+ ENDDO
+
+ CALL cpu_log( log_point_s(32), 'alltoall_task', 'start' )
+ DO nn = 1, nodes
+ DO j = nys_p, nyn_p
+#if defined( __parallel )
+ CALL MPI_ALLTOALL( work2(nxl_p,1,1,nn,j), nw1, MPI_REAL, &
+ work1(nxl_p,1,1,nn,j), nw1, MPI_REAL, &
+ comm_tasks, istat )
+#endif
+ ENDDO
+ ENDDO
+ CALL cpu_log( log_point_s(32), 'alltoall_task', 'stop' )
+
+ CALL cpu_log( log_point_s(7), 'fft_y', 'continue' )
+
+ DO iouter = nxl_p, nxr_p, istride
+ iei = MIN( iouter+istride-1, nxr_p )
+ DO k = 1, nz
+
+ m = nys_a
+ DO nn = 1, nodes
+ DO nt = 1, tasks_per_logical_node
+ DO j = nys_p, nyn_p
+ DO i = iouter, iei
+ ir = i - iouter + 1
+ ffty_ar(m,ir) = work1(i,k,nt,nn,j)
+ ENDDO
+ m = m+1
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO i = iouter, iei
+ ii = nxl + i
+ ir = i - iouter + 1
+ CALL fft_y( ffty_ar(:,ir), 'backward' )
+
+ DO j = nys_a, nyn_a
+ ar(k,j,ii) = ffty_ar(j,ir)
+ ENDDO
+ ENDDO
+
+ ENDDO
+ ENDDO
+
+ CALL cpu_log( log_point_s(7), 'fft_y', 'stop' )
+
+ CALL cpu_log( log_point_s(30), 'poisfft_hybrid_nodes', 'stop' )
+
+ END SUBROUTINE poisfft_hybrid_nodes
+
+
+
+ SUBROUTINE tridia_hybrid( j, ar, tri )
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, nnyh
+ REAL, DIMENSION(0:nx,nz) :: ar
+ REAL, DIMENSION(0:nx,0:nz-1) :: ar1
+ REAL, DIMENSION(5,0:nx,0:nz-1) :: tri
+
+ nnyh = (ny+1) / 2
+
+ tri = 0.0
+!
+!-- Define constant elements of the tridiagonal matrix.
+ DO k = 0, nz-1
+ DO i = 0,nx
+ tri(2,i,k) = ddzu(k+1) * ddzw(k+1)
+ tri(3,i,k) = ddzu(k+2) * ddzw(k+1)
+ ENDDO
+ ENDDO
+
+ IF ( j <= nnyh ) THEN
+ CALL maketri_hybrid( j )
+ ELSE
+ CALL maketri_hybrid( ny+1-j)
+ ENDIF
+ CALL zerleg_hybrid
+ CALL substi_hybrid( ar, tri )
+
+ CONTAINS
+
+ SUBROUTINE maketri_hybrid( j )
+
+!----------------------------------------------------------------------!
+! maketri !
+! !
+! computes the i- and j-dependent component of the matrix !
+!----------------------------------------------------------------------!
+
+ USE constants
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, nnxh
+ REAL :: a, c
+
+ REAL, DIMENSION(0:nx) :: l
+
+
+ nnxh = (nx+1) / 2
+!
+!-- Provide the tridiagonal matrix for solution of the Poisson equation
+!-- in Fourier space. The coefficients are computed following the method
+!-- of Schmidt et al. (DFVLR-Mitteilung 84-15) --> departs from Stephan
+!-- Siano's original version.
+ DO i = 0,nx
+ IF ( i >= 0 .AND. i < nnxh ) THEN
+ l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * i ) / &
+ FLOAT( nx+1 ) ) ) / ( dx * dx ) + &
+ 2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+ FLOAT( ny+1 ) ) ) / ( dy * dy )
+ ELSEIF ( i == nnxh ) THEN
+ l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( nx+1-i ) ) / &
+ FLOAT( nx+1 ) ) ) / ( dx * dx ) + &
+ 2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+ FLOAT(ny+1) ) ) / ( dy * dy )
+ ELSE
+ l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( nx+1-i ) ) / &
+ FLOAT( nx+1 ) ) ) / ( dx * dx ) + &
+ 2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / &
+ FLOAT( ny+1 ) ) ) / ( dy * dy )
+ ENDIF
+ ENDDO
+
+ DO k = 0,nz-1
+ DO i = 0, nx
+ a = -1.0 * ddzu(k+2) * ddzw(k+1)
+ c = -1.0 * ddzu(k+1) * ddzw(k+1)
+ tri(1,i,k) = a + c - l(i)
+ ENDDO
+ ENDDO
+ IF ( ibc_p_b == 1 .OR. ibc_p_b == 2 ) THEN
+ DO i = 0,nx
+ tri(1,i,0) = tri(1,i,0) + tri(2,i,0)
+ ENDDO
+ ENDIF
+ IF ( ibc_p_t == 1 ) THEN
+ DO i = 0,nx
+ tri(1,i,nz-1) = tri(1,i,nz-1) + tri(3,i,nz-1)
+ ENDDO
+ ENDIF
+
+ END SUBROUTINE maketri_hybrid
+
+
+ SUBROUTINE zerleg_hybrid
+
+!----------------------------------------------------------------------!
+! zerleg !
+! !
+! Splitting of the tridiagonal matrix (Thomas algorithm) !
+!----------------------------------------------------------------------!
+
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, k
+
+!
+!-- Splitting
+ DO i = 0, nx
+ tri(4,i,0) = tri(1,i,0)
+ ENDDO
+ DO k = 1, nz-1
+ DO i = 0,nx
+ tri(5,i,k) = tri(2,i,k) / tri(4,i,k-1)
+ tri(4,i,k) = tri(1,i,k) - tri(3,i,k-1) * tri(5,i,k)
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE zerleg_hybrid
+
+ SUBROUTINE substi_hybrid( ar, tri )
+
+!----------------------------------------------------------------------!
+! substi !
+! !
+! Substitution (Forward and Backward) (Thomas algorithm) !
+!----------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL, DIMENSION(0:nx,nz) :: ar
+ REAL, DIMENSION(0:nx,0:nz-1) :: ar1
+ REAL, DIMENSION(5,0:nx,0:nz-1) :: tri
+
+!
+!-- Forward substitution
+ DO i = 0, nx
+ ar1(i,0) = ar(i,1)
+ ENDDO
+ DO k = 1, nz - 1
+ DO i = 0,nx
+ ar1(i,k) = ar(i,k+1) - tri(5,i,k) * ar1(i,k-1)
+ ENDDO
+ ENDDO
+
+!
+!-- Backward substitution
+ DO i = 0,nx
+ ar(i,nz) = ar1(i,nz-1) / tri(4,i,nz-1)
+ ENDDO
+ DO k = nz-2, 0, -1
+ DO i = 0,nx
+ ar(i,k+1) = ( ar1(i,k) - tri(3,i,k) * ar(i,k+2) ) &
+ / tri(4,i,k)
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE substi_hybrid
+
+ END SUBROUTINE tridia_hybrid
+
+
+ SUBROUTINE cascade( loca, j, nys_p, nyn_p )
+
+ USE cpulog
+
+ IMPLICIT NONE
+
+ INTEGER :: ier, j, loca, nyn_p, nys_p, req, reqa(1)
+ INTEGER, SAVE :: tag = 10
+#if defined( __parallel )
+ INTEGER, DIMENSION(MPI_STATUS_SIZE) :: stat
+#endif
+
+ REAL :: buf, buf1
+
+
+ buf = 1.0
+ buf1 = 1.1
+ IF ( me_node == 0 ) THEN ! first node only
+
+ SELECT CASE ( loca )
+
+ CASE ( 1 ) ! before alltoall
+
+ IF( me_task > 0 ) THEN ! first task does not wait
+#if defined( __parallel )
+ CALL MPI_SENDRECV( buf, 1, MPI_REAL, me_task-1, 0, &
+ buf1, 1, MPI_REAL, me_task-1, 0, &
+ comm_tasks, stat,ierr )
+#endif
+ ELSEIF ( j > nys_p ) THEN
+ req = 0
+ tag = MOD( tag-10, 10 ) + 10
+#if defined( __parallel )
+ CALL MPI_IRECV( buf, 1, MPI_REAL, tasks_per_logical_node-1,&
+ tag, comm_tasks, req, ierr )
+ reqa = req
+ CALL MPI_WAITALL( 1, reqa, stat, ierr )
+#endif
+ ENDIF
+
+ CASE ( 2 ) ! after alltoall
+
+ IF ( me_task < tasks_per_logical_node-1 ) THEN ! last task
+#if defined( __parallel )
+ CALL MPI_SENDRECV( buf, 1, MPI_REAL, me_task+1, 0, &
+ buf1, 1, MPI_REAL, me_task+1, 0, &
+ comm_tasks, stat, ierr)
+#endif
+ ELSEIF ( j < nyn_p ) THEN
+ req = 0
+ tag = MOD( tag-10, 10 ) + 10
+#if defined( __parallel )
+ CALL MPI_ISEND( buf, 1, MPI_REAL, 0, tag, comm_tasks, req, &
+ ierr )
+#endif
+ ENDIF
+
+ END SELECT
+
+ ENDIF
+
+ END SUBROUTINE cascade
+
+ END MODULE poisfft_hybrid_mod
Index: /palm/tags/release-3.4a/SOURCE/poismg.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/poismg.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/poismg.f90 (revision 141)
@@ -0,0 +1,1365 @@
+ SUBROUTINE poismg( r )
+
+!------------------------------------------------------------------------------!
+! Attention: Loop unrolling and cache optimization in SOR-Red/Black method
+! still does not bring the expected speedup on ibm! Further work
+! is required.
+!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 114 2007-10-10 00:03:15Z raasch
+! Boundary conditions at walls are implicitly set using flag arrays. Only
+! Neumann BC is allowed. Upper walls are still not realized.
+! Bottom and top BCs for array f_mg in restrict removed because boundary
+! values are not needed (right hand side of SOR iteration).
+!
+! 75 2007-03-22 09:54:05Z raasch
+! 2nd+3rd argument removed from exchange horiz
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.6 2005/03/26 20:55:54 raasch
+! Implementation of non-cyclic (Neumann) horizontal boundary conditions,
+! routine prolong simplified (one call of exchange_horiz spared)
+!
+! Revision 1.1 2001/07/20 13:10:51 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Solves the Poisson equation for the perturbation pressure with a multigrid
+! V- or W-Cycle scheme.
+!
+! This multigrid method was originally developed for PALM by Joerg Uhlenbrock,
+! September 2000 - July 2001.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE pegrid
+
+ IMPLICIT NONE
+
+ REAL :: maxerror, maximum_mgcycles, residual_norm
+
+ REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) :: r
+
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: p3
+
+
+ CALL cpu_log( log_point_s(29), 'poismg', 'start' )
+
+
+!
+!-- Initialize arrays and variables used in this subroutine
+ ALLOCATE ( p3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+
+
+!
+!-- Some boundaries have to be added to divergence array
+ CALL exchange_horiz( d )
+ d(nzb,:,:) = d(nzb+1,:,:)
+
+!
+!-- Initiation of the multigrid scheme. Does n cycles until the
+!-- residual is smaller than the given limit. The accuracy of the solution
+!-- of the poisson equation will increase with the number of cycles.
+!-- If the number of cycles is preset by the user, this number will be
+!-- carried out regardless of the accuracy.
+ grid_level_count = 0
+ mgcycles = 0
+ IF ( mg_cycles == -1 ) THEN
+ maximum_mgcycles = 0
+ residual_norm = 1.0
+ ELSE
+ maximum_mgcycles = mg_cycles
+ residual_norm = 0.0
+ ENDIF
+
+ DO WHILE ( residual_norm > residual_limit .OR. &
+ mgcycles < maximum_mgcycles )
+
+ CALL next_mg_level( d, p, p3, r)
+
+!
+!-- Calculate the residual if the user has not preset the number of
+!-- cycles to be performed
+ IF ( maximum_mgcycles == 0 ) THEN
+ CALL resid( d, p, r )
+ maxerror = SUM( r(nzb+1:nzt,nys:nyn,nxl:nxr)**2 )
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( maxerror, residual_norm, 1, MPI_REAL, MPI_SUM, &
+ comm2d, ierr)
+#else
+ residual_norm = maxerror
+#endif
+ residual_norm = SQRT( residual_norm )
+ ENDIF
+
+ mgcycles = mgcycles + 1
+
+!
+!-- If the user has not limited the number of cycles, stop the run in case
+!-- of insufficient convergence
+ IF ( mgcycles > 1000 .AND. mg_cycles == -1 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ poismg: no sufficient convergence within 1000 cycles'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ ENDDO
+
+ DEALLOCATE( p3 )
+
+ CALL cpu_log( log_point_s(29), 'poismg', 'stop' )
+
+ END SUBROUTINE poismg
+
+
+
+ SUBROUTINE resid( f_mg, p_mg, r )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Computes the residual of the perturbation pressure.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, l
+
+ REAL, DIMENSION(nzb:nzt_mg(grid_level)+1, &
+ nys_mg(grid_level)-1:nyn_mg(grid_level)+1, &
+ nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg, p_mg, r
+
+!
+!-- Calculate the residual
+ l = grid_level
+
+!
+!-- Choose flag array of this level
+ SELECT CASE ( l )
+ CASE ( 1 )
+ flags => wall_flags_1
+ CASE ( 2 )
+ flags => wall_flags_2
+ CASE ( 3 )
+ flags => wall_flags_3
+ CASE ( 4 )
+ flags => wall_flags_4
+ CASE ( 5 )
+ flags => wall_flags_5
+ CASE ( 6 )
+ flags => wall_flags_6
+ CASE ( 7 )
+ flags => wall_flags_7
+ CASE ( 8 )
+ flags => wall_flags_8
+ CASE ( 9 )
+ flags => wall_flags_9
+ CASE ( 10 )
+ flags => wall_flags_10
+ END SELECT
+
+!$OMP PARALLEL PRIVATE (i,j,k)
+!$OMP DO
+ DO i = nxl_mg(l), nxr_mg(l)
+ DO j = nys_mg(l), nyn_mg(l)
+ DO k = nzb+1, nzt_mg(l)
+ r(k,j,i) = f_mg(k,j,i) &
+ - ddx2_mg(l) * &
+ ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i+1) ) + &
+ p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i-1) ) ) &
+ - ddy2_mg(l) * &
+ ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j+1,i) ) + &
+ p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j-1,i) ) ) &
+ - f2_mg(k,l) * p_mg(k+1,j,i) &
+ - f3_mg(k,l) * &
+ ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k-1,j,i) ) ) &
+ + f1_mg(k,l) * p_mg(k,j,i)
+!
+!-- Residual within topography should be zero
+ r(k,j,i) = r(k,j,i) * ( 1.0 - IBITS( flags(k,j,i), 6, 1 ) )
+ ENDDO
+ ENDDO
+ ENDDO
+!$OMP END PARALLEL
+
+!
+!-- Horizontal boundary conditions
+ CALL exchange_horiz( r )
+
+ IF ( bc_lr /= 'cyclic' ) THEN
+ IF ( inflow_l .OR. outflow_l ) r(:,:,nxl_mg(l)-1) = r(:,:,nxl_mg(l))
+ IF ( inflow_r .OR. outflow_r ) r(:,:,nxr_mg(l)+1) = r(:,:,nxr_mg(l))
+ ENDIF
+
+ IF ( bc_ns /= 'cyclic' ) THEN
+ IF ( inflow_n .OR. outflow_n ) r(:,nyn_mg(l)+1,:) = r(:,nyn_mg(l),:)
+ IF ( inflow_s .OR. outflow_s ) r(:,nys_mg(l)-1,:) = r(:,nys_mg(l),:)
+ ENDIF
+
+!
+!-- Top boundary condition
+!-- A Neumann boundary condition for r is implicitly set in routine restrict
+ IF ( ibc_p_t == 1 ) THEN
+ r(nzt_mg(l)+1,:,: ) = r(nzt_mg(l),:,:)
+ ELSE
+ r(nzt_mg(l)+1,:,: ) = 0.0
+ ENDIF
+
+
+ END SUBROUTINE resid
+
+
+
+ SUBROUTINE restrict( f_mg, r )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Interpolates the residual on the next coarser grid with "full weighting"
+! scheme
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: i, ic, j, jc, k, kc, l
+
+ REAL :: rkjim, rkjip, rkjmi, rkjmim, rkjmip, rkjpi, rkjpim, rkjpip, &
+ rkmji, rkmjim, rkmjip, rkmjmi, rkmjmim, rkmjmip, rkmjpi, rkmjpim, &
+ rkmjpip
+
+ REAL, DIMENSION(nzb:nzt_mg(grid_level)+1, &
+ nys_mg(grid_level)-1:nyn_mg(grid_level)+1, &
+ nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg
+
+ REAL, DIMENSION(nzb:nzt_mg(grid_level+1)+1, &
+ nys_mg(grid_level+1)-1:nyn_mg(grid_level+1)+1, &
+ nxl_mg(grid_level+1)-1:nxr_mg(grid_level+1)+1) :: r
+
+!
+!-- Interpolate the residual
+ l = grid_level
+
+!
+!-- Choose flag array of the upper level
+ SELECT CASE ( l )
+ CASE ( 1 )
+ flags => wall_flags_1
+ CASE ( 2 )
+ flags => wall_flags_2
+ CASE ( 3 )
+ flags => wall_flags_3
+ CASE ( 4 )
+ flags => wall_flags_4
+ CASE ( 5 )
+ flags => wall_flags_5
+ CASE ( 6 )
+ flags => wall_flags_6
+ CASE ( 7 )
+ flags => wall_flags_7
+ CASE ( 8 )
+ flags => wall_flags_8
+ CASE ( 9 )
+ flags => wall_flags_9
+ CASE ( 10 )
+ flags => wall_flags_10
+ END SELECT
+
+!$OMP PARALLEL PRIVATE (i,j,k,ic,jc,kc)
+!$OMP DO
+ DO ic = nxl_mg(l), nxr_mg(l)
+ i = 2*ic
+ DO jc = nys_mg(l), nyn_mg(l)
+ j = 2*jc
+ DO kc = nzb+1, nzt_mg(l)
+ k = 2*kc-1
+!
+!-- Use implicit Neumann BCs if the respective gridpoint is inside
+!-- the building
+ rkjim = r(k,j,i-1) + IBITS( flags(k,j,i-1), 6, 1 ) * &
+ ( r(k,j,i) - r(k,j,i-1) )
+ rkjip = r(k,j,i+1) + IBITS( flags(k,j,i+1), 6, 1 ) * &
+ ( r(k,j,i) - r(k,j,i+1) )
+ rkjpi = r(k,j+1,i) + IBITS( flags(k,j+1,i), 6, 1 ) * &
+ ( r(k,j,i) - r(k,j+1,i) )
+ rkjmi = r(k,j-1,i) + IBITS( flags(k,j-1,i), 6, 1 ) * &
+ ( r(k,j,i) - r(k,j-1,i) )
+ rkjmim = r(k,j-1,i-1) + IBITS( flags(k,j-1,i-1), 6, 1 ) * &
+ ( r(k,j,i) - r(k,j-1,i-1) )
+ rkjpim = r(k,j+1,i-1) + IBITS( flags(k,j+1,i-1), 6, 1 ) * &
+ ( r(k,j,i) - r(k,j+1,i-1) )
+ rkjmip = r(k,j-1,i+1) + IBITS( flags(k,j-1,i+1), 6, 1 ) * &
+ ( r(k,j,i) - r(k,j-1,i+1) )
+ rkjpip = r(k,j+1,i+1) + IBITS( flags(k,j+1,i+1), 6, 1 ) * &
+ ( r(k,j,i) - r(k,j+1,i+1) )
+ rkmji = r(k-1,j,i) + IBITS( flags(k-1,j,i), 6, 1 ) * &
+ ( r(k,j,i) - r(k-1,j,i) )
+ rkmjim = r(k-1,j,i-1) + IBITS( flags(k-1,j,i-1), 6, 1 ) * &
+ ( r(k,j,i) - r(k-1,j,i-1) )
+ rkmjip = r(k-1,j,i+1) + IBITS( flags(k-1,j,i+1), 6, 1 ) * &
+ ( r(k,j,i) - r(k-1,j,i+1) )
+ rkmjpi = r(k-1,j+1,i) + IBITS( flags(k-1,j+1,i), 6, 1 ) * &
+ ( r(k,j,i) - r(k-1,j+1,i) )
+ rkmjmi = r(k-1,j-1,i) + IBITS( flags(k-1,j-1,i), 6, 1 ) * &
+ ( r(k,j,i) - r(k-1,j-1,i) )
+ rkmjmim = r(k-1,j-1,i-1) + IBITS( flags(k-1,j-1,i-1), 6, 1 ) * &
+ ( r(k,j,i) - r(k-1,j-1,i-1) )
+ rkmjpim = r(k-1,j+1,i-1) + IBITS( flags(k-1,j+1,i-1), 6, 1 ) * &
+ ( r(k,j,i) - r(k-1,j+1,i-1) )
+ rkmjmip = r(k-1,j-1,i+1) + IBITS( flags(k-1,j-1,i+1), 6, 1 ) * &
+ ( r(k,j,i) - r(k-1,j-1,i+1) )
+ rkmjpip = r(k-1,j+1,i+1) + IBITS( flags(k-1,j+1,i+1), 6, 1 ) * &
+ ( r(k,j,i) - r(k-1,j+1,i+1) )
+
+ f_mg(kc,jc,ic) = 1.0 / 64.0 * ( &
+ 8.0 * r(k,j,i) &
+ + 4.0 * ( rkjim + rkjip + &
+ rkjpi + rkjmi ) &
+ + 2.0 * ( rkjmim + rkjpim + &
+ rkjmip + rkjpip ) &
+ + 4.0 * rkmji &
+ + 2.0 * ( rkmjim + rkmjim + &
+ rkmjpi + rkmjmi ) &
+ + ( rkmjmim + rkmjpim + &
+ rkmjmip + rkmjpip ) &
+ + 4.0 * r(k+1,j,i) &
+ + 2.0 * ( r(k+1,j,i-1) + r(k+1,j,i+1) + &
+ r(k+1,j+1,i) + r(k+1,j-1,i) ) &
+ + ( r(k+1,j-1,i-1) + r(k+1,j+1,i-1) + &
+ r(k+1,j-1,i+1) + r(k+1,j+1,i+1) ) &
+ )
+
+! f_mg(kc,jc,ic) = 1.0 / 64.0 * ( &
+! 8.0 * r(k,j,i) &
+! + 4.0 * ( r(k,j,i-1) + r(k,j,i+1) + &
+! r(k,j+1,i) + r(k,j-1,i) ) &
+! + 2.0 * ( r(k,j-1,i-1) + r(k,j+1,i-1) + &
+! r(k,j-1,i+1) + r(k,j+1,i+1) ) &
+! + 4.0 * r(k-1,j,i) &
+! + 2.0 * ( r(k-1,j,i-1) + r(k-1,j,i+1) + &
+! r(k-1,j+1,i) + r(k-1,j-1,i) ) &
+! + ( r(k-1,j-1,i-1) + r(k-1,j+1,i-1) + &
+! r(k-1,j-1,i+1) + r(k-1,j+1,i+1) ) &
+! + 4.0 * r(k+1,j,i) &
+! + 2.0 * ( r(k+1,j,i-1) + r(k+1,j,i+1) + &
+! r(k+1,j+1,i) + r(k+1,j-1,i) ) &
+! + ( r(k+1,j-1,i-1) + r(k+1,j+1,i-1) + &
+! r(k+1,j-1,i+1) + r(k+1,j+1,i+1) ) &
+! )
+ ENDDO
+ ENDDO
+ ENDDO
+!$OMP END PARALLEL
+
+!
+!-- Horizontal boundary conditions
+ CALL exchange_horiz( f_mg )
+
+ IF ( bc_lr /= 'cyclic' ) THEN
+ IF (inflow_l .OR. outflow_l) f_mg(:,:,nxl_mg(l)-1) = f_mg(:,:,nxl_mg(l))
+ IF (inflow_r .OR. outflow_r) f_mg(:,:,nxr_mg(l)+1) = f_mg(:,:,nxr_mg(l))
+ ENDIF
+
+ IF ( bc_ns /= 'cyclic' ) THEN
+ IF (inflow_n .OR. outflow_n) f_mg(:,nyn_mg(l)+1,:) = f_mg(:,nyn_mg(l),:)
+ IF (inflow_s .OR. outflow_s) f_mg(:,nys_mg(l)-1,:) = f_mg(:,nys_mg(l),:)
+ ENDIF
+
+!
+!-- Bottom and top boundary conditions
+! IF ( ibc_p_b == 1 ) THEN
+! f_mg(nzb,:,: ) = f_mg(nzb+1,:,:)
+! ELSE
+! f_mg(nzb,:,: ) = 0.0
+! ENDIF
+!
+! IF ( ibc_p_t == 1 ) THEN
+! f_mg(nzt_mg(l)+1,:,: ) = f_mg(nzt_mg(l),:,:)
+! ELSE
+! f_mg(nzt_mg(l)+1,:,: ) = 0.0
+! ENDIF
+
+
+END SUBROUTINE restrict
+
+
+
+ SUBROUTINE prolong( p, temp )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Interpolates the correction of the perturbation pressure
+! to the next finer grid.
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE pegrid
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, l
+
+ REAL, DIMENSION(nzb:nzt_mg(grid_level-1)+1, &
+ nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1, &
+ nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1 ) :: p
+
+ REAL, DIMENSION(nzb:nzt_mg(grid_level)+1, &
+ nys_mg(grid_level)-1:nyn_mg(grid_level)+1, &
+ nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: temp
+
+
+!
+!-- First, store elements of the coarser grid on the next finer grid
+ l = grid_level
+
+!$OMP PARALLEL PRIVATE (i,j,k)
+!$OMP DO
+ DO i = nxl_mg(l-1), nxr_mg(l-1)
+ DO j = nys_mg(l-1), nyn_mg(l-1)
+!CDIR NODEP
+ DO k = nzb+1, nzt_mg(l-1)
+!
+!-- Points of the coarse grid are directly stored on the next finer
+!-- grid
+ temp(2*k-1,2*j,2*i) = p(k,j,i)
+!
+!-- Points between two coarse-grid points
+ temp(2*k-1,2*j,2*i+1) = 0.5 * ( p(k,j,i) + p(k,j,i+1) )
+ temp(2*k-1,2*j+1,2*i) = 0.5 * ( p(k,j,i) + p(k,j+1,i) )
+ temp(2*k,2*j,2*i) = 0.5 * ( p(k,j,i) + p(k+1,j,i) )
+!
+!-- Points in the center of the planes stretched by four points
+!-- of the coarse grid cube
+ temp(2*k-1,2*j+1,2*i+1) = 0.25 * ( p(k,j,i) + p(k,j,i+1) + &
+ p(k,j+1,i) + p(k,j+1,i+1) )
+ temp(2*k,2*j,2*i+1) = 0.25 * ( p(k,j,i) + p(k,j,i+1) + &
+ p(k+1,j,i) + p(k+1,j,i+1) )
+ temp(2*k,2*j+1,2*i) = 0.25 * ( p(k,j,i) + p(k,j+1,i) + &
+ p(k+1,j,i) + p(k+1,j+1,i) )
+!
+!-- Points in the middle of coarse grid cube
+ temp(2*k,2*j+1,2*i+1) = 0.125 * ( p(k,j,i) + p(k,j,i+1) + &
+ p(k,j+1,i) + p(k,j+1,i+1) + &
+ p(k+1,j,i) + p(k+1,j,i+1) + &
+ p(k+1,j+1,i) + p(k+1,j+1,i+1) )
+ ENDDO
+ ENDDO
+ ENDDO
+!$OMP END PARALLEL
+
+!
+!-- Horizontal boundary conditions
+ CALL exchange_horiz( temp )
+
+ IF ( bc_lr /= 'cyclic' ) THEN
+ IF (inflow_l .OR. outflow_l) temp(:,:,nxl_mg(l)-1) = temp(:,:,nxl_mg(l))
+ IF (inflow_r .OR. outflow_r) temp(:,:,nxr_mg(l)+1) = temp(:,:,nxr_mg(l))
+ ENDIF
+
+ IF ( bc_ns /= 'cyclic' ) THEN
+ IF (inflow_n .OR. outflow_n) temp(:,nyn_mg(l)+1,:) = temp(:,nyn_mg(l),:)
+ IF (inflow_s .OR. outflow_s) temp(:,nys_mg(l)-1,:) = temp(:,nys_mg(l),:)
+ ENDIF
+
+!
+!-- Bottom and top boundary conditions
+ IF ( ibc_p_b == 1 ) THEN
+ temp(nzb,:,: ) = temp(nzb+1,:,:)
+ ELSE
+ temp(nzb,:,: ) = 0.0
+ ENDIF
+
+ IF ( ibc_p_t == 1 ) THEN
+ temp(nzt_mg(l)+1,:,: ) = temp(nzt_mg(l),:,:)
+ ELSE
+ temp(nzt_mg(l)+1,:,: ) = 0.0
+ ENDIF
+
+
+ END SUBROUTINE prolong
+
+
+ SUBROUTINE redblack( f_mg, p_mg )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Relaxation method for the multigrid scheme. A Gauss-Seidel iteration with
+! 3D-Red-Black decomposition (GS-RB) is used.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: colour, i, ic, j, jc, jj, k, l, n
+
+ LOGICAL :: unroll
+
+ REAL :: wall_left, wall_north, wall_right, wall_south, wall_total, wall_top
+
+ REAL, DIMENSION(nzb:nzt_mg(grid_level)+1, &
+ nys_mg(grid_level)-1:nyn_mg(grid_level)+1, &
+ nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg, p_mg
+
+
+ l = grid_level
+
+!
+!-- Choose flag array of this level
+ SELECT CASE ( l )
+ CASE ( 1 )
+ flags => wall_flags_1
+ CASE ( 2 )
+ flags => wall_flags_2
+ CASE ( 3 )
+ flags => wall_flags_3
+ CASE ( 4 )
+ flags => wall_flags_4
+ CASE ( 5 )
+ flags => wall_flags_5
+ CASE ( 6 )
+ flags => wall_flags_6
+ CASE ( 7 )
+ flags => wall_flags_7
+ CASE ( 8 )
+ flags => wall_flags_8
+ CASE ( 9 )
+ flags => wall_flags_9
+ CASE ( 10 )
+ flags => wall_flags_10
+ END SELECT
+
+ unroll = ( MOD( nyn_mg(l)-nys_mg(l)+1, 4 ) == 0 .AND. &
+ MOD( nxr_mg(l)-nxl_mg(l)+1, 2 ) == 0 )
+
+ DO n = 1, ngsrb
+
+ DO colour = 1, 2
+
+ IF ( .NOT. unroll ) THEN
+ CALL cpu_log( log_point_s(36), 'redblack_no_unroll', 'start' )
+
+!
+!-- Without unrolling of loops, no cache optimization
+ DO i = nxl_mg(l), nxr_mg(l), 2
+ DO j = nys_mg(l) + 2 - colour, nyn_mg(l), 2
+ DO k = nzb+1, nzt_mg(l), 2
+! p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( &
+! ddx2_mg(l) * ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) &
+! + ddy2_mg(l) * ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) &
+! + f2_mg(k,l) * p_mg(k+1,j,i) &
+! + f3_mg(k,l) * p_mg(k-1,j,i) - f_mg(k,j,i) &
+! )
+
+ p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( &
+ ddx2_mg(l) * &
+ ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i+1) ) + &
+ p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i-1) ) ) &
+ + ddy2_mg(l) * &
+ ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j+1,i) ) + &
+ p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j-1,i) ) ) &
+ + f2_mg(k,l) * p_mg(k+1,j,i) &
+ + f3_mg(k,l) * &
+ ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k-1,j,i) ) ) &
+ - f_mg(k,j,i) )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO i = nxl_mg(l)+1, nxr_mg(l), 2
+ DO j = nys_mg(l) + (colour-1), nyn_mg(l), 2
+ DO k = nzb+1, nzt_mg(l), 2
+ p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( &
+ ddx2_mg(l) * &
+ ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i+1) ) + &
+ p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i-1) ) ) &
+ + ddy2_mg(l) * &
+ ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j+1,i) ) + &
+ p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j-1,i) ) ) &
+ + f2_mg(k,l) * p_mg(k+1,j,i) &
+ + f3_mg(k,l) * &
+ ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k-1,j,i) ) ) &
+ - f_mg(k,j,i) )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO i = nxl_mg(l), nxr_mg(l), 2
+ DO j = nys_mg(l) + (colour-1), nyn_mg(l), 2
+ DO k = nzb+2, nzt_mg(l), 2
+ p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( &
+ ddx2_mg(l) * &
+ ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i+1) ) + &
+ p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i-1) ) ) &
+ + ddy2_mg(l) * &
+ ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j+1,i) ) + &
+ p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j-1,i) ) ) &
+ + f2_mg(k,l) * p_mg(k+1,j,i) &
+ + f3_mg(k,l) * &
+ ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k-1,j,i) ) ) &
+ - f_mg(k,j,i) )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO i = nxl_mg(l)+1, nxr_mg(l), 2
+ DO j = nys_mg(l) + 2 - colour, nyn_mg(l), 2
+ DO k = nzb+2, nzt_mg(l), 2
+ p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( &
+ ddx2_mg(l) * &
+ ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i+1) ) + &
+ p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i-1) ) ) &
+ + ddy2_mg(l) * &
+ ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j+1,i) ) + &
+ p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j-1,i) ) ) &
+ + f2_mg(k,l) * p_mg(k+1,j,i) &
+ + f3_mg(k,l) * &
+ ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k-1,j,i) ) ) &
+ - f_mg(k,j,i) )
+ ENDDO
+ ENDDO
+ ENDDO
+ CALL cpu_log( log_point_s(36), 'redblack_no_unroll', 'stop' )
+
+ ELSE
+
+!
+!-- Loop unrolling along y, only one i loop for better cache use
+ CALL cpu_log( log_point_s(38), 'redblack_unroll', 'start' )
+ DO ic = nxl_mg(l), nxr_mg(l), 2
+ DO jc = nys_mg(l), nyn_mg(l), 4
+ i = ic
+ jj = jc+2-colour
+ DO k = nzb+1, nzt_mg(l), 2
+ j = jj
+ p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( &
+ ddx2_mg(l) * &
+ ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i+1) ) + &
+ p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i-1) ) ) &
+ + ddy2_mg(l) * &
+ ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j+1,i) ) + &
+ p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j-1,i) ) ) &
+ + f2_mg(k,l) * p_mg(k+1,j,i) &
+ + f3_mg(k,l) * &
+ ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k-1,j,i) ) ) &
+ - f_mg(k,j,i) )
+ j = jj+2
+ p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( &
+ ddx2_mg(l) * &
+ ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i+1) ) + &
+ p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i-1) ) ) &
+ + ddy2_mg(l) * &
+ ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j+1,i) ) + &
+ p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j-1,i) ) ) &
+ + f2_mg(k,l) * p_mg(k+1,j,i) &
+ + f3_mg(k,l) * &
+ ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k-1,j,i) ) ) &
+ - f_mg(k,j,i) )
+ ENDDO
+
+ i = ic+1
+ jj = jc+colour-1
+ DO k = nzb+1, nzt_mg(l), 2
+ j =jj
+ p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( &
+ ddx2_mg(l) * &
+ ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i+1) ) + &
+ p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i-1) ) ) &
+ + ddy2_mg(l) * &
+ ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j+1,i) ) + &
+ p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j-1,i) ) ) &
+ + f2_mg(k,l) * p_mg(k+1,j,i) &
+ + f3_mg(k,l) * &
+ ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k-1,j,i) ) ) &
+ - f_mg(k,j,i) )
+ j = jj+2
+ p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( &
+ ddx2_mg(l) * &
+ ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i+1) ) + &
+ p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i-1) ) ) &
+ + ddy2_mg(l) * &
+ ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j+1,i) ) + &
+ p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j-1,i) ) ) &
+ + f2_mg(k,l) * p_mg(k+1,j,i) &
+ + f3_mg(k,l) * &
+ ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k-1,j,i) ) ) &
+ - f_mg(k,j,i) )
+ ENDDO
+
+ i = ic
+ jj = jc+colour-1
+ DO k = nzb+2, nzt_mg(l), 2
+ j =jj
+ p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( &
+ ddx2_mg(l) * &
+ ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i+1) ) + &
+ p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i-1) ) ) &
+ + ddy2_mg(l) * &
+ ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j+1,i) ) + &
+ p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j-1,i) ) ) &
+ + f2_mg(k,l) * p_mg(k+1,j,i) &
+ + f3_mg(k,l) * &
+ ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k-1,j,i) ) ) &
+ - f_mg(k,j,i) )
+ j = jj+2
+ p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( &
+ ddx2_mg(l) * &
+ ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i+1) ) + &
+ p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i-1) ) ) &
+ + ddy2_mg(l) * &
+ ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j+1,i) ) + &
+ p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j-1,i) ) ) &
+ + f2_mg(k,l) * p_mg(k+1,j,i) &
+ + f3_mg(k,l) * &
+ ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k-1,j,i) ) ) &
+ - f_mg(k,j,i) )
+ ENDDO
+
+ i = ic+1
+ jj = jc+2-colour
+ DO k = nzb+2, nzt_mg(l), 2
+ j =jj
+ p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( &
+ ddx2_mg(l) * &
+ ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i+1) ) + &
+ p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i-1) ) ) &
+ + ddy2_mg(l) * &
+ ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j+1,i) ) + &
+ p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j-1,i) ) ) &
+ + f2_mg(k,l) * p_mg(k+1,j,i) &
+ + f3_mg(k,l) * &
+ ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k-1,j,i) ) ) &
+ - f_mg(k,j,i) )
+ j = jj+2
+ p_mg(k,j,i) = 1.0 / f1_mg(k,l) * ( &
+ ddx2_mg(l) * &
+ ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i+1) ) + &
+ p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j,i-1) ) ) &
+ + ddy2_mg(l) * &
+ ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j+1,i) ) + &
+ p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k,j-1,i) ) ) &
+ + f2_mg(k,l) * p_mg(k+1,j,i) &
+ + f3_mg(k,l) * &
+ ( p_mg(k-1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
+ ( p_mg(k,j,i) - p_mg(k-1,j,i) ) ) &
+ - f_mg(k,j,i) )
+ ENDDO
+
+ ENDDO
+ ENDDO
+ CALL cpu_log( log_point_s(38), 'redblack_unroll', 'stop' )
+
+ ENDIF
+
+!
+!-- Horizontal boundary conditions
+ CALL exchange_horiz( p_mg )
+
+ IF ( bc_lr /= 'cyclic' ) THEN
+ IF ( inflow_l .OR. outflow_l ) THEN
+ p_mg(:,:,nxl_mg(l)-1) = p_mg(:,:,nxl_mg(l))
+ ENDIF
+ IF ( inflow_r .OR. outflow_r ) THEN
+ p_mg(:,:,nxr_mg(l)+1) = p_mg(:,:,nxr_mg(l))
+ ENDIF
+ ENDIF
+
+ IF ( bc_ns /= 'cyclic' ) THEN
+ IF ( inflow_n .OR. outflow_n ) THEN
+ p_mg(:,nyn_mg(l)+1,:) = p_mg(:,nyn_mg(l),:)
+ ENDIF
+ IF ( inflow_s .OR. outflow_s ) THEN
+ p_mg(:,nys_mg(l)-1,:) = p_mg(:,nys_mg(l),:)
+ ENDIF
+ ENDIF
+
+!
+!-- Bottom and top boundary conditions
+ IF ( ibc_p_b == 1 ) THEN
+ p_mg(nzb,:,: ) = p_mg(nzb+1,:,:)
+ ELSE
+ p_mg(nzb,:,: ) = 0.0
+ ENDIF
+
+ IF ( ibc_p_t == 1 ) THEN
+ p_mg(nzt_mg(l)+1,:,: ) = p_mg(nzt_mg(l),:,:)
+ ELSE
+ p_mg(nzt_mg(l)+1,:,: ) = 0.0
+ ENDIF
+
+ ENDDO
+
+ ENDDO
+
+!
+!-- Set pressure within topography and at the topography surfaces
+!$OMP PARALLEL PRIVATE (i,j,k,wall_left,wall_north,wall_right,wall_south,wall_top,wall_total)
+!$OMP DO
+ DO i = nxl_mg(l), nxr_mg(l)
+ DO j = nys_mg(l), nyn_mg(l)
+ DO k = nzb, nzt_mg(l)
+!
+!-- First, set pressure inside topography to zero
+ p_mg(k,j,i) = p_mg(k,j,i) * ( 1.0 - IBITS( flags(k,j,i), 6, 1 ) )
+!
+!-- Second, determine if the gridpoint inside topography is adjacent
+!-- to a wall and set its value to a value given by the average of
+!-- those values obtained from Neumann boundary condition
+ wall_left = IBITS( flags(k,j,i-1), 5, 1 )
+ wall_right = IBITS( flags(k,j,i+1), 4, 1 )
+ wall_south = IBITS( flags(k,j-1,i), 3, 1 )
+ wall_north = IBITS( flags(k,j+1,i), 2, 1 )
+ wall_top = IBITS( flags(k+1,j,i), 0, 1 )
+ wall_total = wall_left + wall_right + wall_south + wall_north + &
+ wall_top
+
+ IF ( wall_total > 0.0 ) THEN
+ p_mg(k,j,i) = 1.0 / wall_total * &
+ ( wall_left * p_mg(k,j,i-1) + &
+ wall_right * p_mg(k,j,i+1) + &
+ wall_south * p_mg(k,j-1,i) + &
+ wall_north * p_mg(k,j+1,i) + &
+ wall_top * p_mg(k+1,j,i) )
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+!$OMP END PARALLEL
+
+!
+!-- One more time horizontal boundary conditions
+ CALL exchange_horiz( p_mg )
+
+ END SUBROUTINE redblack
+
+
+
+ SUBROUTINE mg_gather( f2, f2_sub )
+
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: n, nwords, sender
+
+ REAL, DIMENSION(nzb:nzt_mg(grid_level)+1, &
+ nys_mg(grid_level)-1:nyn_mg(grid_level)+1, &
+ nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f2
+
+ REAL, DIMENSION(nzb:mg_loc_ind(5,myid)+1, &
+ mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1, &
+ mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) :: f2_sub
+
+!
+!-- Find out the number of array elements of the subdomain array
+ nwords = SIZE( f2_sub )
+
+#if defined( __parallel )
+ CALL cpu_log( log_point_s(34), 'mg_gather', 'start' )
+
+ IF ( myid == 0 ) THEN
+!
+!-- Store the local subdomain array on the total array
+ f2(:,mg_loc_ind(3,0)-1:mg_loc_ind(4,0)+1, &
+ mg_loc_ind(1,0)-1:mg_loc_ind(2,0)+1) = f2_sub
+
+!
+!-- Receive the subdomain arrays from all other PEs and store them on the
+!-- total array
+ DO n = 1, numprocs-1
+!
+!-- Receive the arrays in arbitrary order from the PEs.
+ CALL MPI_RECV( f2_sub(nzb,mg_loc_ind(3,0)-1,mg_loc_ind(1,0)-1), &
+ nwords, MPI_REAL, MPI_ANY_SOURCE, 1, comm2d, status, &
+ ierr )
+ sender = status(MPI_SOURCE)
+ f2(:,mg_loc_ind(3,sender)-1:mg_loc_ind(4,sender)+1, &
+ mg_loc_ind(1,sender)-1:mg_loc_ind(2,sender)+1) = f2_sub
+ ENDDO
+
+ ELSE
+!
+!-- Send subdomain array to PE0
+ CALL MPI_SEND( f2_sub(nzb,mg_loc_ind(3,myid)-1,mg_loc_ind(1,myid)-1), &
+ nwords, MPI_REAL, 0, 1, comm2d, ierr )
+ ENDIF
+
+ CALL cpu_log( log_point_s(34), 'mg_gather', 'stop' )
+#endif
+
+ END SUBROUTINE mg_gather
+
+
+
+ SUBROUTINE mg_scatter( p2, p2_sub )
+!
+!-- TODO: It may be possible to improve the speed of this routine by using
+!-- non-blocking communication
+
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: n, nwords, sender
+
+ REAL, DIMENSION(nzb:nzt_mg(grid_level-1)+1, &
+ nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1, &
+ nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1) :: p2
+
+ REAL, DIMENSION(nzb:mg_loc_ind(5,myid)+1, &
+ mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1, &
+ mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) :: p2_sub
+
+!
+!-- Find out the number of array elements of the subdomain array
+ nwords = SIZE( p2_sub )
+
+#if defined( __parallel )
+ CALL cpu_log( log_point_s(35), 'mg_scatter', 'start' )
+
+ IF ( myid == 0 ) THEN
+!
+!-- Scatter the subdomain arrays to the other PEs by blocking
+!-- communication
+ DO n = 1, numprocs-1
+
+ p2_sub = p2(:,mg_loc_ind(3,n)-1:mg_loc_ind(4,n)+1, &
+ mg_loc_ind(1,n)-1:mg_loc_ind(2,n)+1)
+
+ CALL MPI_SEND( p2_sub(nzb,mg_loc_ind(3,0)-1,mg_loc_ind(1,0)-1), &
+ nwords, MPI_REAL, n, 1, comm2d, ierr )
+
+ ENDDO
+
+!
+!-- Store data from the total array to the local subdomain array
+ p2_sub = p2(:,mg_loc_ind(3,0)-1:mg_loc_ind(4,0)+1, &
+ mg_loc_ind(1,0)-1:mg_loc_ind(2,0)+1)
+
+ ELSE
+!
+!-- Receive subdomain array from PE0
+ CALL MPI_RECV( p2_sub(nzb,mg_loc_ind(3,myid)-1,mg_loc_ind(1,myid)-1), &
+ nwords, MPI_REAL, 0, 1, comm2d, status, ierr )
+
+ ENDIF
+
+ CALL cpu_log( log_point_s(35), 'mg_scatter', 'stop' )
+#endif
+
+ END SUBROUTINE mg_scatter
+
+
+
+ RECURSIVE SUBROUTINE next_mg_level( f_mg, p_mg, p3, r )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! This is where the multigrid technique takes place. V- and W- Cycle are
+! implemented and steered by the parameter "gamma". Parameter "nue" determines
+! the convergence of the multigrid iterative solution. There are nue times
+! RB-GS iterations. It should be set to "1" or "2", considering the time effort
+! one would like to invest. Last choice shows a very good converging factor,
+! but leads to an increase in computing time.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, nxl_mg_save, nxr_mg_save, nyn_mg_save, nys_mg_save, &
+ nzt_mg_save
+
+ LOGICAL :: restore_boundary_lr_on_pe0, restore_boundary_ns_on_pe0
+
+ REAL, DIMENSION(nzb:nzt_mg(grid_level)+1, &
+ nys_mg(grid_level)-1:nyn_mg(grid_level)+1, &
+ nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: f_mg, p_mg, p3, r
+
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: f2, f2_sub, p2, p2_sub
+
+!
+!-- Restriction to the coarsest grid
+ 10 IF ( grid_level == 1 ) THEN
+
+!
+!-- Solution on the coarsest grid. Double the number of Gauss-Seidel
+!-- iterations in order to get a more accurate solution.
+ ngsrb = 2 * ngsrb
+ CALL redblack( f_mg, p_mg )
+ ngsrb = ngsrb / 2
+
+ ELSEIF ( grid_level /= 1 ) THEN
+
+ grid_level_count(grid_level) = grid_level_count(grid_level) + 1
+
+!
+!-- Solution on the actual grid level
+ CALL redblack( f_mg, p_mg )
+
+!
+!-- Determination of the actual residual
+ CALL resid( f_mg, p_mg, r )
+
+!
+!-- Restriction of the residual (finer grid values!) to the next coarser
+!-- grid. Therefore, the grid level has to be decremented now. nxl..nzt have
+!-- to be set to the coarse grid values, because these variables are needed
+!-- for the exchange of ghost points in routine exchange_horiz
+ grid_level = grid_level - 1
+ nxl = nxl_mg(grid_level)
+ nxr = nxr_mg(grid_level)
+ nys = nys_mg(grid_level)
+ nyn = nyn_mg(grid_level)
+ nzt = nzt_mg(grid_level)
+
+ ALLOCATE( f2(nzb:nzt_mg(grid_level)+1, &
+ nys_mg(grid_level)-1:nyn_mg(grid_level)+1, &
+ nxl_mg(grid_level)-1:nxr_mg(grid_level)+1), &
+ p2(nzb:nzt_mg(grid_level)+1, &
+ nys_mg(grid_level)-1:nyn_mg(grid_level)+1, &
+ nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) )
+
+ IF ( grid_level == mg_switch_to_pe0_level ) THEN
+! print*, 'myid=',myid, ' restrict and switch to PE0. level=', grid_level
+!
+!-- From this level on, calculations are done on PE0 only.
+!-- First, carry out restriction on the subdomain.
+!-- Therefore, indices of the level have to be changed to subdomain values
+!-- in between (otherwise, the restrict routine would expect
+!-- the gathered array)
+ nxl_mg_save = nxl_mg(grid_level)
+ nxr_mg_save = nxr_mg(grid_level)
+ nys_mg_save = nys_mg(grid_level)
+ nyn_mg_save = nyn_mg(grid_level)
+ nzt_mg_save = nzt_mg(grid_level)
+ nxl_mg(grid_level) = mg_loc_ind(1,myid)
+ nxr_mg(grid_level) = mg_loc_ind(2,myid)
+ nys_mg(grid_level) = mg_loc_ind(3,myid)
+ nyn_mg(grid_level) = mg_loc_ind(4,myid)
+ nzt_mg(grid_level) = mg_loc_ind(5,myid)
+ nxl = mg_loc_ind(1,myid)
+ nxr = mg_loc_ind(2,myid)
+ nys = mg_loc_ind(3,myid)
+ nyn = mg_loc_ind(4,myid)
+ nzt = mg_loc_ind(5,myid)
+
+ ALLOCATE( f2_sub(nzb:nzt_mg(grid_level)+1, &
+ nys_mg(grid_level)-1:nyn_mg(grid_level)+1, &
+ nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) )
+
+ CALL restrict( f2_sub, r )
+
+!
+!-- Restore the correct indices of this level
+ nxl_mg(grid_level) = nxl_mg_save
+ nxr_mg(grid_level) = nxr_mg_save
+ nys_mg(grid_level) = nys_mg_save
+ nyn_mg(grid_level) = nyn_mg_save
+ nzt_mg(grid_level) = nzt_mg_save
+ nxl = nxl_mg(grid_level)
+ nxr = nxr_mg(grid_level)
+ nys = nys_mg(grid_level)
+ nyn = nyn_mg(grid_level)
+ nzt = nzt_mg(grid_level)
+
+!
+!-- Gather all arrays from the subdomains on PE0
+ CALL mg_gather( f2, f2_sub )
+
+!
+!-- Set switch for routine exchange_horiz, that no ghostpoint exchange
+!-- has to be carried out from now on
+ mg_switch_to_pe0 = .TRUE.
+
+!
+!-- In case of non-cyclic lateral boundary conditions, both in- and
+!-- outflow conditions have to be used on PE0 after the switch, because
+!-- it then contains the total domain. Due to the virtual processor
+!-- grid, before the switch, PE0 can have in-/outflow at the left
+!-- and south wall only (or on opposite walls in case of a 1d
+!-- decomposition).
+ restore_boundary_lr_on_pe0 = .FALSE.
+ restore_boundary_ns_on_pe0 = .FALSE.
+ IF ( myid == 0 ) THEN
+ IF ( inflow_l .AND. .NOT. outflow_r ) THEN
+ outflow_r = .TRUE.
+ restore_boundary_lr_on_pe0 = .TRUE.
+ ENDIF
+ IF ( outflow_l .AND. .NOT. inflow_r ) THEN
+ inflow_r = .TRUE.
+ restore_boundary_lr_on_pe0 = .TRUE.
+ ENDIF
+ IF ( inflow_s .AND. .NOT. outflow_n ) THEN
+ outflow_n = .TRUE.
+ restore_boundary_ns_on_pe0 = .TRUE.
+ ENDIF
+ IF ( outflow_s .AND. .NOT. inflow_n ) THEN
+ inflow_n = .TRUE.
+ restore_boundary_ns_on_pe0 = .TRUE.
+ ENDIF
+ ENDIF
+
+ DEALLOCATE( f2_sub )
+
+ ELSE
+
+ CALL restrict( f2, r )
+
+ ENDIF
+ p2 = 0.0
+
+!
+!-- Repeat the same procedure till the coarsest grid is reached
+ IF ( myid == 0 .OR. grid_level > mg_switch_to_pe0_level ) THEN
+ CALL next_mg_level( f2, p2, p3, r )
+ ENDIF
+
+ ENDIF
+
+!
+!-- Now follows the prolongation
+ IF ( grid_level >= 2 ) THEN
+
+!
+!-- Grid level has to be incremented on the PEs where next_mg_level
+!-- has not been called before (normally it is incremented at the end
+!-- of next_mg_level)
+ IF ( myid /= 0 .AND. grid_level == mg_switch_to_pe0_level ) THEN
+ grid_level = grid_level + 1
+ nxl = nxl_mg(grid_level)
+ nxr = nxr_mg(grid_level)
+ nys = nys_mg(grid_level)
+ nyn = nyn_mg(grid_level)
+ nzt = nzt_mg(grid_level)
+ ENDIF
+
+!
+!-- Prolongation of the new residual. The values are transferred
+!-- from the coarse to the next finer grid.
+ IF ( grid_level == mg_switch_to_pe0_level+1 ) THEN
+!
+!-- At this level, the new residual first has to be scattered from
+!-- PE0 to the other PEs
+ ALLOCATE( p2_sub(nzb:mg_loc_ind(5,myid)+1, &
+ mg_loc_ind(3,myid)-1:mg_loc_ind(4,myid)+1, &
+ mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) )
+
+ CALL mg_scatter( p2, p2_sub )
+
+!
+!-- Therefore, indices of the previous level have to be changed to
+!-- subdomain values in between (otherwise, the prolong routine would
+!-- expect the gathered array)
+ nxl_mg_save = nxl_mg(grid_level-1)
+ nxr_mg_save = nxr_mg(grid_level-1)
+ nys_mg_save = nys_mg(grid_level-1)
+ nyn_mg_save = nyn_mg(grid_level-1)
+ nzt_mg_save = nzt_mg(grid_level-1)
+ nxl_mg(grid_level-1) = mg_loc_ind(1,myid)
+ nxr_mg(grid_level-1) = mg_loc_ind(2,myid)
+ nys_mg(grid_level-1) = mg_loc_ind(3,myid)
+ nyn_mg(grid_level-1) = mg_loc_ind(4,myid)
+ nzt_mg(grid_level-1) = mg_loc_ind(5,myid)
+
+!
+!-- Set switch for routine exchange_horiz, that ghostpoint exchange
+!-- has to be carried again out from now on
+ mg_switch_to_pe0 = .FALSE.
+
+!
+!-- In case of non-cyclic lateral boundary conditions, restore the
+!-- in-/outflow conditions on PE0
+ IF ( myid == 0 ) THEN
+ IF ( restore_boundary_lr_on_pe0 ) THEN
+ IF ( inflow_l ) outflow_r = .FALSE.
+ IF ( outflow_l ) inflow_r = .FALSE.
+ ENDIF
+ IF ( restore_boundary_ns_on_pe0 ) THEN
+ IF ( inflow_s ) outflow_n = .FALSE.
+ IF ( outflow_s ) inflow_n = .FALSE.
+ ENDIF
+ ENDIF
+
+ CALL prolong( p2_sub, p3 )
+
+!
+!-- Restore the correct indices of the previous level
+ nxl_mg(grid_level-1) = nxl_mg_save
+ nxr_mg(grid_level-1) = nxr_mg_save
+ nys_mg(grid_level-1) = nys_mg_save
+ nyn_mg(grid_level-1) = nyn_mg_save
+ nzt_mg(grid_level-1) = nzt_mg_save
+
+ DEALLOCATE( p2_sub )
+
+ ELSE
+
+ CALL prolong( p2, p3 )
+
+ ENDIF
+
+!
+!-- Temporary arrays for the actual grid are not needed any more
+ DEALLOCATE( p2, f2 )
+
+!
+!-- Computation of the new pressure correction. Therefore,
+!-- values from prior grids are added up automatically stage by stage.
+ DO i = nxl_mg(grid_level)-1, nxr_mg(grid_level)+1
+ DO j = nys_mg(grid_level)-1, nyn_mg(grid_level)+1
+ DO k = nzb, nzt_mg(grid_level)+1
+ p_mg(k,j,i) = p_mg(k,j,i) + p3(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Relaxation of the new solution
+ CALL redblack( f_mg, p_mg )
+
+ ENDIF
+
+!
+!-- The following few lines serve the steering of the multigrid scheme
+ IF ( grid_level == maximum_grid_level ) THEN
+
+ GOTO 20
+
+ ELSEIF ( grid_level /= maximum_grid_level .AND. grid_level /= 1 .AND. &
+ grid_level_count(grid_level) /= gamma_mg ) THEN
+
+ GOTO 10
+
+ ENDIF
+
+!
+!-- Reset counter for the next call of poismg
+ grid_level_count(grid_level) = 0
+
+!
+!-- Continue with the next finer level. nxl..nzt have to be
+!-- set to the finer grid values, because these variables are needed for the
+!-- exchange of ghost points in routine exchange_horiz
+ grid_level = grid_level + 1
+ nxl = nxl_mg(grid_level)
+ nxr = nxr_mg(grid_level)
+ nys = nys_mg(grid_level)
+ nyn = nyn_mg(grid_level)
+ nzt = nzt_mg(grid_level)
+
+ 20 CONTINUE
+
+ END SUBROUTINE next_mg_level
Index: /palm/tags/release-3.4a/SOURCE/prandtl_fluxes.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/prandtl_fluxes.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/prandtl_fluxes.f90 (revision 141)
@@ -0,0 +1,388 @@
+ SUBROUTINE prandtl_fluxes
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 108 2007-08-24 15:10:38Z letzel
+! assume saturation at k=nzb_s_inner(j,i) for atmosphere coupled to ocean
+!
+! 75 2007-03-22 09:54:05Z raasch
+! moisture renamed humidity
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.19 2006/04/26 12:24:35 raasch
+! +OpenMP directives and optimization (array assignments replaced by DO loops)
+!
+! Revision 1.1 1998/01/23 10:06:06 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Diagnostic computation of vertical fluxes in the Prandtl layer from the
+! values of the variables at grid point k=1
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+ REAL :: a, b, e_q, rifm, uv_total, z_p
+
+!
+!-- Compute theta*
+ IF ( constant_heatflux ) THEN
+!
+!-- For a given heat flux in the Prandtl layer:
+!-- for u* use the value from the previous time step
+ !$OMP PARALLEL DO
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ ts(j,i) = -shf(j,i) / ( us(j,i) + 1E-30 )
+!
+!-- ts must be limited, because otherwise overflow may occur in case of
+!-- us=0 when computing rif further below
+ IF ( ts(j,i) < -1.05E5 ) ts = -1.0E5
+ IF ( ts(j,i) > 1.0E5 ) ts = 1.0E5
+ ENDDO
+ ENDDO
+
+ ELSE
+!
+!-- For a given surface temperature:
+!-- (the Richardson number is still the one from the previous time step)
+ !$OMP PARALLEL DO PRIVATE( a, b, k, z_p )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+
+ k = nzb_s_inner(j,i)
+ z_p = zu(k+1) - zw(k)
+
+ IF ( rif(j,i) >= 0.0 ) THEN
+!
+!-- Stable stratification
+ ts(j,i) = kappa * ( pt(k+1,j,i) - pt(k,j,i) ) / ( &
+ LOG( z_p / z0(j,i) ) + &
+ 5.0 * rif(j,i) * ( z_p - z0(j,i) ) / z_p &
+ )
+ ELSE
+!
+!-- Unstable stratification
+ a = SQRT( 1.0 - 16.0 * rif(j,i) )
+ b = SQRT( 1.0 - 16.0 * rif(j,i) / z_p * z0(j,i) )
+!
+!-- If a borderline case occurs, the formula for stable
+!-- stratification must be used anyway, or else a zero division
+!-- would occur in the argument of the logarithm
+ IF ( a == 1.0 .OR. b == 1.0 ) THEN
+ ts(j,i) = kappa * ( pt(k+1,j,i) - pt(k,j,i) ) / ( &
+ LOG( z_p / z0(j,i) ) + &
+ 5.0 * rif(j,i) * ( z_p - z0(j,i) ) / z_p &
+ )
+ ELSE
+ ts(j,i) = kappa * ( pt(k+1,j,i) - pt(k,j,i) ) / ( &
+ LOG( (1.0+b) / (1.0-b) * (1.0-a) / (1.0+a) ) &
+ )
+ ENDIF
+ ENDIF
+
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Compute z_p/L (corresponds to the Richardson-flux number)
+ IF ( .NOT. humidity ) THEN
+ !$OMP PARALLEL DO PRIVATE( k, z_p )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ k = nzb_s_inner(j,i)
+ z_p = zu(k+1) - zw(k)
+ rif(j,i) = z_p * kappa * g * ts(j,i) / &
+ ( pt(k+1,j,i) * ( us(j,i)**2 + 1E-30 ) )
+!
+!-- Limit the value range of the Richardson numbers.
+!-- This is necessary for very small velocities (u,v --> 0), because
+!-- the absolute value of rif can then become very large, which in
+!-- consequence would result in very large shear stresses and very
+!-- small momentum fluxes (both are generally unrealistic).
+ IF ( rif(j,i) < rif_min ) rif(j,i) = rif_min
+ IF ( rif(j,i) > rif_max ) rif(j,i) = rif_max
+ ENDDO
+ ENDDO
+ ELSE
+ !$OMP PARALLEL DO PRIVATE( k, z_p )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ k = nzb_s_inner(j,i)
+ z_p = zu(k+1) - zw(k)
+ rif(j,i) = z_p * kappa * g * &
+ ( ts(j,i) + 0.61 * pt(k+1,j,i) * qs(j,i) ) / &
+ ( vpt(k+1,j,i) * ( us(j,i)**2 + 1E-30 ) )
+!
+!-- Limit the value range of the Richardson numbers.
+!-- This is necessary for very small velocities (u,v --> 0), because
+!-- the absolute value of rif can then become very large, which in
+!-- consequence would result in very large shear stresses and very
+!-- small momentum fluxes (both are generally unrealistic).
+ IF ( rif(j,i) < rif_min ) rif(j,i) = rif_min
+ IF ( rif(j,i) > rif_max ) rif(j,i) = rif_max
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Compute u* at the scalars' grid points
+ !$OMP PARALLEL DO PRIVATE( a, b, k, uv_total, z_p )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+
+ k = nzb_s_inner(j,i)
+ z_p = zu(k+1) - zw(k)
+
+!
+!-- Compute the absolute value of the horizontal velocity
+ uv_total = SQRT( ( 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) ) )**2 + &
+ ( 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) ) )**2 &
+ )
+
+ IF ( rif(j,i) >= 0.0 ) THEN
+!
+!-- Stable stratification
+ us(j,i) = kappa * uv_total / ( &
+ LOG( z_p / z0(j,i) ) + &
+ 5.0 * rif(j,i) * ( z_p - z0(j,i) ) / z_p &
+ )
+ ELSE
+!
+!-- Unstable stratification
+ a = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif(j,i) ) )
+ b = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rif(j,i) / z_p * z0(j,i) ) )
+!
+!-- If a borderline case occurs, the formula for stable stratification
+!-- must be used anyway, or else a zero division would occur in the
+!-- argument of the logarithm.
+ IF ( a == 1.0 .OR. b == 1.0 ) THEN
+ us(j,i) = kappa * uv_total / ( &
+ LOG( z_p / z0(j,i) ) + &
+ 5.0 * rif(j,i) * ( z_p - z0(j,i) ) / z_p &
+ )
+ ELSE
+ us(j,i) = kappa * uv_total / ( &
+ LOG( (1.0+b) / (1.0-b) * (1.0-a) / (1.0+a) ) + &
+ 2.0 * ( ATAN( b ) - ATAN( a ) ) &
+ )
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+
+!
+!-- Compute u'w' for the total model domain.
+!-- First compute the corresponding component of u* and square it.
+ !$OMP PARALLEL DO PRIVATE( a, b, k, rifm, z_p )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+
+ k = nzb_u_inner(j,i)
+ z_p = zu(k+1) - zw(k)
+
+!
+!-- Compute Richardson-flux number for this point
+ rifm = 0.5 * ( rif(j,i-1) + rif(j,i) )
+ IF ( rifm >= 0.0 ) THEN
+!
+!-- Stable stratification
+ usws(j,i) = kappa * u(k+1,j,i) / ( &
+ LOG( z_p / z0(j,i) ) + &
+ 5.0 * rifm * ( z_p - z0(j,i) ) / z_p &
+ )
+ ELSE
+!
+!-- Unstable stratification
+ a = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifm ) )
+ b = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifm / z_p * z0(j,i) ) )
+!
+!-- If a borderline case occurs, the formula for stable stratification
+!-- must be used anyway, or else a zero division would occur in the
+!-- argument of the logarithm.
+ IF ( a == 1.0 .OR. B == 1.0 ) THEN
+ usws(j,i) = kappa * u(k+1,j,i) / ( &
+ LOG( z_p / z0(j,i) ) + &
+ 5.0 * rifm * ( z_p - z0(j,i) ) / z_p &
+ )
+ ELSE
+ usws(j,i) = kappa * u(k+1,j,i) / ( &
+ LOG( (1.0+b) / (1.0-b) * (1.0-a) / (1.0+a) ) + &
+ 2.0 * ( ATAN( b ) - ATAN( a ) ) &
+ )
+ ENDIF
+ ENDIF
+ usws(j,i) = -usws(j,i) * ABS( usws(j,i) )
+ ENDDO
+ ENDDO
+
+!
+!-- Compute v'w' for the total model domain.
+!-- First compute the corresponding component of u* and square it.
+ !$OMP PARALLEL DO PRIVATE( a, b, k, rifm, z_p )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+
+ k = nzb_v_inner(j,i)
+ z_p = zu(k+1) - zw(k)
+
+!
+!-- Compute Richardson-flux number for this point
+ rifm = 0.5 * ( rif(j-1,i) + rif(j,i) )
+ IF ( rifm >= 0.0 ) THEN
+!
+!-- Stable stratification
+ vsws(j,i) = kappa * v(k+1,j,i) / ( &
+ LOG( z_p / z0(j,i) ) + &
+ 5.0 * rifm * ( z_p - z0(j,i) ) / z_p &
+ )
+ ELSE
+!
+!-- Unstable stratification
+ a = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifm ) )
+ b = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifm / z_p * z0(j,i) ) )
+!
+!-- If a borderline case occurs, the formula for stable stratification
+!-- must be used anyway, or else a zero division would occur in the
+!-- argument of the logarithm.
+ IF ( a == 1.0 .OR. b == 1.0 ) THEN
+ vsws(j,i) = kappa * v(k+1,j,i) / ( &
+ LOG( z_p / z0(j,i) ) + &
+ 5.0 * rifm * ( z_p - z0(j,i) ) / z_p &
+ )
+ ELSE
+ vsws(j,i) = kappa * v(k+1,j,i) / ( &
+ LOG( (1.0+b) / (1.0-b) * (1.0-a) / (1.0+a) ) + &
+ 2.0 * ( ATAN( b ) - ATAN( a ) ) &
+ )
+ ENDIF
+ ENDIF
+ vsws(j,i) = -vsws(j,i) * ABS( vsws(j,i) )
+ ENDDO
+ ENDDO
+
+!
+!-- If required compute q*
+ IF ( humidity .OR. passive_scalar ) THEN
+ IF ( constant_waterflux ) THEN
+!
+!-- For a given water flux in the Prandtl layer:
+ !$OMP PARALLEL DO
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ qs(j,i) = -qsws(j,i) / ( us(j,i) + 1E-30 )
+ ENDDO
+ ENDDO
+
+ ELSE
+ !$OMP PARALLEL DO PRIVATE( a, b, k, z_p )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+
+ k = nzb_s_inner(j,i)
+ z_p = zu(k+1) - zw(k)
+
+!
+!-- assume saturation for atmosphere coupled to ocean
+ IF ( coupling_mode == 'atmosphere_to_ocean' ) THEN
+ e_q = 6.1 * &
+ EXP( 0.07 * ( MIN(pt(0,j,i),pt(1,j,i)) - 273.15 ) )
+ q(k,j,i) = 0.622 * e_q / ( surface_pressure - e_q )
+ ENDIF
+ IF ( rif(j,i) >= 0.0 ) THEN
+!
+!-- Stable stratification
+ qs(j,i) = kappa * ( q(k+1,j,i) - q(k,j,i) ) / ( &
+ LOG( z_p / z0(j,i) ) + &
+ 5.0 * rif(j,i) * ( z_p - z0(j,i) ) / z_p &
+ )
+ ELSE
+!
+!-- Unstable stratification
+ a = SQRT( 1.0 - 16.0 * rif(j,i) )
+ b = SQRT( 1.0 - 16.0 * rif(j,i) / z_p * z0(j,i) )
+!
+!-- If a borderline case occurs, the formula for stable
+!-- stratification must be used anyway, or else a zero division
+!-- would occur in the argument of the logarithm.
+ IF ( a == 1.0 .OR. b == 1.0 ) THEN
+ qs(j,i) = kappa * ( q(k+1,j,i) - q(k,j,i) ) / ( &
+ LOG( z_p / z0(j,i) ) + &
+ 5.0 * rif(j,i) * ( z_p - z0(j,i) ) / z_p &
+ )
+ ELSE
+ qs(j,i) = kappa * ( q(k+1,j,i) - q(k,j,i) ) / ( &
+ LOG( (1.0+b) / (1.0-b) * (1.0-a) / (1.0+a) ) &
+ )
+ ENDIF
+ ENDIF
+
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+
+!
+!-- Exchange the boundaries for u* and the momentum fluxes (fluxes only for
+!-- completeness's sake).
+ CALL exchange_horiz_2d( us )
+ CALL exchange_horiz_2d( usws )
+ CALL exchange_horiz_2d( vsws )
+ IF ( humidity .OR. passive_scalar ) CALL exchange_horiz_2d( qsws )
+
+!
+!-- Compute the vertical kinematic heat flux
+ IF ( .NOT. constant_heatflux ) THEN
+ !$OMP PARALLEL DO
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ shf(j,i) = -ts(j,i) * us(j,i)
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Compute the vertical water/scalar flux
+ IF ( .NOT. constant_heatflux .AND. ( humidity .OR. passive_scalar ) ) THEN
+ !$OMP PARALLEL DO
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ qsws(j,i) = -qs(j,i) * us(j,i)
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Bottom boundary condition for the TKE
+ IF ( ibc_e_b == 2 ) THEN
+ !$OMP PARALLEL DO
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ e(nzb_s_inner(j,i)+1,j,i) = ( us(j,i) / 0.1 )**2
+!
+!-- As a test: cm = 0.4
+! e(nzb_s_inner(j,i)+1,j,i) = ( us(j,i) / 0.4 )**2
+ e(nzb_s_inner(j,i),j,i) = e(nzb_s_inner(j,i)+1,j,i)
+ ENDDO
+ ENDDO
+ ENDIF
+
+
+ END SUBROUTINE prandtl_fluxes
Index: /palm/tags/release-3.4a/SOURCE/pres.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/pres.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/pres.f90 (revision 141)
@@ -0,0 +1,629 @@
+ SUBROUTINE pres
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 106 2007-08-16 14:30:26Z raasch
+! Volume flow conservation added for the remaining three outflow boundaries
+!
+! 85 2007-05-11 09:35:14Z raasch
+! Division through dt_3d replaced by multiplication of the inverse.
+! For performance optimisation, this is done in the loop calculating the
+! divergence instead of using a seperate loop.
+!
+! 75 2007-03-22 09:54:05Z raasch
+! Volume flow control for non-cyclic boundary conditions added (currently only
+! for the north boundary!!), 2nd+3rd argument removed from exchange horiz,
+! mean vertical velocity is removed in case of Neumann boundary conditions
+! both at the bottom and the top
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.25 2006/04/26 13:26:12 raasch
+! OpenMP optimization (+localsum, threadsum)
+!
+! Revision 1.1 1997/07/24 11:24:44 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Compute the divergence of the provisional velocity field. Solve the Poisson
+! equation for the perturbation pressure. Compute the final velocities using
+! this perturbation pressure. Compute the remaining divergence.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE constants
+ USE control_parameters
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE poisfft_mod
+ USE poisfft_hybrid_mod
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, sr
+
+ REAL :: ddt_3d, localsum, threadsum
+
+ REAL, DIMENSION(1:2) :: volume_flow_l, volume_flow_offset
+ REAL, DIMENSION(1:nzt) :: w_l, w_l_l
+
+
+ CALL cpu_log( log_point(8), 'pres', 'start' )
+
+
+ ddt_3d = 1.0 / dt_3d
+
+!
+!-- Multigrid method needs additional grid points for the divergence array
+ IF ( psolver == 'multigrid' ) THEN
+ DEALLOCATE( d )
+ ALLOCATE( d(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+
+!
+!-- Conserve the volume flow at the outflow in case of non-cyclic lateral
+!-- boundary conditions
+!-- WARNING: so far, this conservation does not work at the left/south
+!-- boundary if the topography at the inflow differs from that at the
+!-- outflow! For this case, volume_flow_area needs adjustment!
+!
+!-- Left/right
+ IF ( conserve_volume_flow .AND. ( outflow_l .OR. outflow_r ) ) THEN
+
+ volume_flow(1) = 0.0
+ volume_flow_l(1) = 0.0
+
+ IF ( outflow_l ) THEN
+ i = 0
+ ELSEIF ( outflow_r ) THEN
+ i = nx+1
+ ENDIF
+
+ DO j = nys, nyn
+!
+!-- Sum up the volume flow through the south/north boundary
+ DO k = nzb_2d(j,i) + 1, nzt
+ volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzu(k)
+ ENDDO
+ ENDDO
+
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( volume_flow_l(1), volume_flow(1), 1, MPI_REAL, &
+ MPI_SUM, comm1dy, ierr )
+#else
+ volume_flow = volume_flow_l
+#endif
+ volume_flow_offset(1) = ( volume_flow_initial(1) - volume_flow(1) ) &
+ / volume_flow_area(1)
+
+ DO j = nys, nyn
+ DO k = nzb_v_inner(j,i) + 1, nzt
+ u(k,j,i) = u(k,j,i) + volume_flow_offset(1)
+ ENDDO
+ ENDDO
+
+ CALL exchange_horiz( u )
+
+ ENDIF
+
+!
+!-- South/north
+ IF ( conserve_volume_flow .AND. ( outflow_n .OR. outflow_s ) ) THEN
+
+ volume_flow(2) = 0.0
+ volume_flow_l(2) = 0.0
+
+ IF ( outflow_s ) THEN
+ j = 0
+ ELSEIF ( outflow_n ) THEN
+ j = ny+1
+ ENDIF
+
+ DO i = nxl, nxr
+!
+!-- Sum up the volume flow through the south/north boundary
+ DO k = nzb_2d(j,i) + 1, nzt
+ volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzu(k)
+ ENDDO
+ ENDDO
+
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( volume_flow_l(2), volume_flow(2), 1, MPI_REAL, &
+ MPI_SUM, comm1dx, ierr )
+#else
+ volume_flow = volume_flow_l
+#endif
+ volume_flow_offset(2) = ( volume_flow_initial(2) - volume_flow(2) ) &
+ / volume_flow_area(2)
+
+ DO i = nxl, nxr
+ DO k = nzb_v_inner(j,i) + 1, nzt
+ v(k,j,i) = v(k,j,i) + volume_flow_offset(2)
+ ENDDO
+ ENDDO
+
+ CALL exchange_horiz( v )
+
+ ENDIF
+
+!
+!-- Remove mean vertical velocity
+ IF ( ibc_p_b == 1 .AND. ibc_p_t == 1 ) THEN
+ IF ( simulated_time > 0.0 ) THEN ! otherwise nzb_w_inner is not yet known
+ w_l = 0.0; w_l_l = 0.0
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_w_inner(j,i)+1, nzt
+ w_l_l(k) = w_l_l(k) + w(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( w_l_l(1), w_l(1), nzt, MPI_REAL, MPI_SUM, comm2d, &
+ ierr )
+#else
+ w_l = w_l_l
+#endif
+ DO k = 1, nzt
+ w_l(k) = w_l(k) / ngp_2dh_outer(k,0)
+ ENDDO
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb_w_inner(j,i)+1, nzt
+ w(k,j,i) = w(k,j,i) - w_l(k)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+
+!
+!-- Compute the divergence of the provisional velocity field.
+ CALL cpu_log( log_point_s(1), 'divergence', 'start' )
+
+ IF ( psolver == 'multigrid' ) THEN
+ !$OMP PARALLEL DO SCHEDULE( STATIC )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ d(k,j,i) = 0.0
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSE
+ !$OMP PARALLEL DO SCHEDULE( STATIC )
+ DO i = nxl, nxra
+ DO j = nys, nyna
+ DO k = nzb+1, nzta
+ d(k,j,i) = 0.0
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+ localsum = 0.0
+ threadsum = 0.0
+
+#if defined( __ibm )
+ !$OMP PARALLEL PRIVATE (i,j,k) FIRSTPRIVATE(threadsum) REDUCTION(+:localsum)
+ !$OMP DO SCHEDULE( STATIC )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ d(k,j,i) = ( ( u(k,j,i+1) - u(k,j,i) ) * ddx + &
+ ( v(k,j+1,i) - v(k,j,i) ) * ddy + &
+ ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) ) * ddt_3d
+ ENDDO
+!
+!-- Additional pressure boundary condition at the bottom boundary for
+!-- inhomogeneous Prandtl layer heat fluxes and temperatures, respectively
+!-- dp/dz = -(dtau13/dx + dtau23/dy) + g*pt'/pt0.
+!-- This condition must not be applied at the start of a run, because then
+!-- flow_statistics has not yet been called and thus sums = 0.
+ IF ( ibc_p_b == 2 .AND. sums(nzb+1,4) /= 0.0 ) THEN
+ k = nzb_s_inner(j,i)
+ d(k+1,j,i) = d(k+1,j,i) + ( &
+ ( usws(j,i+1) - usws(j,i) ) * ddx &
+ + ( vsws(j+1,i) - vsws(j,i) ) * ddy &
+ - g * ( pt(k+1,j,i) - sums(k+1,4) ) / &
+ sums(k+1,4) &
+ ) * ddzw(k+1) * ddt_3d
+ ENDIF
+
+!
+!-- Compute possible PE-sum of divergences for flow_statistics
+ DO k = nzb_s_inner(j,i)+1, nzt
+ threadsum = threadsum + ABS( d(k,j,i) )
+ ENDDO
+
+ ENDDO
+ ENDDO
+
+ localsum = ( localsum + threadsum ) * dt_3d
+ !$OMP END PARALLEL
+#else
+ IF ( ibc_p_b == 2 .AND. sums(nzb+1,4) /= 0.0 ) THEN
+ !$OMP PARALLEL PRIVATE (i,j,k)
+ !$OMP DO SCHEDULE( STATIC )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ d(k,j,i) = ( ( u(k,j,i+1) - u(k,j,i) ) * ddx + &
+ ( v(k,j+1,i) - v(k,j,i) ) * ddy + &
+ ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) ) * ddt_3d
+ ENDDO
+ ENDDO
+!
+!-- Additional pressure boundary condition at the bottom boundary for
+!-- inhomogeneous Prandtl layer heat fluxes and temperatures, respectively
+!-- dp/dz = -(dtau13/dx + dtau23/dy) + g*pt'/pt0.
+!-- This condition must not be applied at the start of a run, because then
+!-- flow_statistics has not yet been called and thus sums = 0.
+ DO j = nys, nyn
+ k = nzb_s_inner(j,i)
+ d(k+1,j,i) = d(k+1,j,i) + ( &
+ ( usws(j,i+1) - usws(j,i) ) * ddx &
+ + ( vsws(j+1,i) - vsws(j,i) ) * ddy &
+ - g * ( pt(k+1,j,i) - sums(k+1,4) ) / &
+ sums(k+1,4) &
+ ) * ddzw(k+1) * ddt_3d
+ ENDDO
+ ENDDO
+ !$OMP END PARALLEL
+
+ ELSE
+
+ !$OMP PARALLEL PRIVATE (i,j,k)
+ !$OMP DO SCHEDULE( STATIC )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ d(k,j,i) = ( ( u(k,j,i+1) - u(k,j,i) ) * ddx + &
+ ( v(k,j+1,i) - v(k,j,i) ) * ddy + &
+ ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) ) * ddt_3d
+ ENDDO
+ ENDDO
+ ENDDO
+ !$OMP END PARALLEL
+
+ ENDIF
+
+!
+!-- Compute possible PE-sum of divergences for flow_statistics
+ !$OMP PARALLEL PRIVATE (i,j,k) FIRSTPRIVATE(threadsum) REDUCTION(+:localsum)
+ !$OMP DO SCHEDULE( STATIC )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ threadsum = threadsum + ABS( d(k,j,i) )
+ ENDDO
+ ENDDO
+ ENDDO
+ localsum = ( localsum + threadsum ) * dt_3d
+ !$OMP END PARALLEL
+#endif
+
+!
+!-- For completeness, set the divergence sum of all statistic regions to those
+!-- of the total domain
+ sums_divold_l(0:statistic_regions) = localsum
+
+!
+!-- Determine absolute minimum/maximum (only for test cases, therefore as
+!-- comment line)
+! CALL global_min_max( nzb+1, nzt, nys, nyn, nxl, nxr, d, 'abs', divmax, &
+! divmax_ijk )
+
+ CALL cpu_log( log_point_s(1), 'divergence', 'stop' )
+
+!
+!-- Compute the pressure perturbation solving the Poisson equation
+ IF ( psolver(1:7) == 'poisfft' ) THEN
+
+!
+!-- Enlarge the size of tend, used as a working array for the transpositions
+ IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN
+ DEALLOCATE( tend )
+ ALLOCATE( tend(1:nza,nys:nyna,nxl:nxra) )
+ ENDIF
+
+!
+!-- Solve Poisson equation via FFT and solution of tridiagonal matrices
+ IF ( psolver == 'poisfft' ) THEN
+!
+!-- Solver for 2d-decomposition
+ CALL poisfft( d, tend )
+ ELSEIF ( psolver == 'poisfft_hybrid' ) THEN
+!
+!-- Solver for 1d-decomposition (using MPI and OpenMP).
+!-- The old hybrid-solver is still included here, as long as there
+!-- are some optimization problems in poisfft
+ CALL poisfft_hybrid( d )
+ ENDIF
+
+!
+!-- Resize tend to its normal size
+ IF ( nxra > nxr .OR. nyna > nyn .OR. nza > nz ) THEN
+ DEALLOCATE( tend )
+ ALLOCATE( tend(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+
+!
+!-- Store computed perturbation pressure and set boundary condition in
+!-- z-direction
+ !$OMP PARALLEL DO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ tend(k,j,i) = d(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Bottom boundary:
+!-- This condition is only required for internal output. The pressure
+!-- gradient (dp(nzb+1)-dp(nzb))/dz is not used anywhere else.
+ IF ( ibc_p_b == 1 ) THEN
+!
+!-- Neumann (dp/dz = 0)
+ !$OMP PARALLEL DO
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ tend(nzb_s_inner(j,i),j,i) = tend(nzb_s_inner(j,i)+1,j,i)
+ ENDDO
+ ENDDO
+
+ ELSEIF ( ibc_p_b == 2 ) THEN
+!
+!-- Neumann condition for inhomogeneous surfaces,
+!-- here currently still in the form of a zero gradient. Actually
+!-- dp/dz = -(dtau13/dx + dtau23/dy) + g*pt'/pt0 would have to be used for
+!-- the computation (cf. above: computation of divergences).
+ !$OMP PARALLEL DO
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ tend(nzb_s_inner(j,i),j,i) = tend(nzb_s_inner(j,i)+1,j,i)
+ ENDDO
+ ENDDO
+
+ ELSE
+!
+!-- Dirichlet
+ !$OMP PARALLEL DO
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ tend(nzb_s_inner(j,i),j,i) = 0.0
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+!
+!-- Top boundary
+ IF ( ibc_p_t == 1 ) THEN
+!
+!-- Neumann
+ !$OMP PARALLEL DO
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ tend(nzt+1,j,i) = tend(nzt,j,i)
+ ENDDO
+ ENDDO
+
+ ELSE
+!
+!-- Dirichlet
+ !$OMP PARALLEL DO
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ tend(nzt+1,j,i) = 0.0
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+!
+!-- Exchange boundaries for p
+ CALL exchange_horiz( tend )
+
+ ELSEIF ( psolver == 'sor' ) THEN
+
+!
+!-- Solve Poisson equation for perturbation pressure using SOR-Red/Black
+!-- scheme
+ CALL sor( d, ddzu, ddzw, p )
+ tend = p
+
+ ELSEIF ( psolver == 'multigrid' ) THEN
+
+!
+!-- Solve Poisson equation for perturbation pressure using Multigrid scheme,
+!-- array tend is used to store the residuals
+ CALL poismg( tend )
+
+!
+!-- Restore perturbation pressure on tend because this array is used
+!-- further below to correct the velocity fields
+ tend = p
+
+ ENDIF
+
+!
+!-- Store perturbation pressure on array p, used in the momentum equations
+ IF ( psolver(1:7) == 'poisfft' ) THEN
+!
+!-- Here, only the values from the left and right boundaries are copied
+!-- The remaining values are copied in the following loop due to speed
+!-- optimization
+ !$OMP PARALLEL DO
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ p(k,j,nxl-1) = tend(k,j,nxl-1)
+ p(k,j,nxr+1) = tend(k,j,nxr+1)
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Correction of the provisional velocities with the current perturbation
+!-- pressure just computed
+ IF ( conserve_volume_flow .AND. &
+ ( bc_lr == 'cyclic' .OR. bc_ns == 'cyclic' ) ) THEN
+ volume_flow_l(1) = 0.0
+ volume_flow_l(2) = 0.0
+ ENDIF
+ !$OMP PARALLEL PRIVATE (i,j,k)
+ !$OMP DO
+ DO i = nxl, nxr
+ IF ( psolver(1:7) == 'poisfft' ) THEN
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ p(k,j,i) = tend(k,j,i)
+ ENDDO
+ ENDDO
+ ENDIF
+ DO j = nys, nyn
+ DO k = nzb_w_inner(j,i)+1, nzt
+ w(k,j,i) = w(k,j,i) - dt_3d * &
+ ( tend(k+1,j,i) - tend(k,j,i) ) * ddzu(k+1)
+ ENDDO
+ DO k = nzb_u_inner(j,i)+1, nzt
+ u(k,j,i) = u(k,j,i) - dt_3d * ( tend(k,j,i) - tend(k,j,i-1) ) * ddx
+ ENDDO
+ DO k = nzb_v_inner(j,i)+1, nzt
+ v(k,j,i) = v(k,j,i) - dt_3d * ( tend(k,j,i) - tend(k,j-1,i) ) * ddy
+ ENDDO
+
+!
+!-- Sum up the volume flow through the right and north boundary
+ IF ( conserve_volume_flow .AND. bc_lr == 'cyclic' .AND. &
+ i == nx ) THEN
+ !$OMP CRITICAL
+ DO k = nzb_2d(j,i) + 1, nzt
+ volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzu(k)
+ ENDDO
+ !$OMP END CRITICAL
+ ENDIF
+ IF ( conserve_volume_flow .AND. bc_ns == 'cyclic' .AND. &
+ j == ny ) THEN
+ !$OMP CRITICAL
+ DO k = nzb_2d(j,i) + 1, nzt
+ volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzu(k)
+ ENDDO
+ !$OMP END CRITICAL
+ ENDIF
+
+ ENDDO
+ ENDDO
+ !$OMP END PARALLEL
+
+!
+!-- Conserve the volume flow
+ IF ( conserve_volume_flow .AND. &
+ ( bc_lr == 'cyclic' .OR. bc_ns == 'cyclic' ) ) THEN
+
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( volume_flow_l(1), volume_flow(1), 2, MPI_REAL, &
+ MPI_SUM, comm2d, ierr )
+#else
+ volume_flow = volume_flow_l
+#endif
+
+ volume_flow_offset = ( volume_flow_initial - volume_flow ) / &
+ volume_flow_area
+
+ !$OMP PARALLEL PRIVATE (i,j,k)
+ !$OMP DO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ IF ( bc_lr == 'cyclic' ) THEN
+ DO k = nzb_u_inner(j,i) + 1, nzt
+ u(k,j,i) = u(k,j,i) + volume_flow_offset(1)
+ ENDDO
+ ENDIF
+ IF ( bc_ns == 'cyclic' ) THEN
+ DO k = nzb_v_inner(j,i) + 1, nzt
+ v(k,j,i) = v(k,j,i) + volume_flow_offset(2)
+ ENDDO
+ ENDIF
+ ENDDO
+ ENDDO
+ !$OMP END PARALLEL
+
+ ENDIF
+
+!
+!-- Exchange of boundaries for the velocities
+ CALL exchange_horiz( u )
+ CALL exchange_horiz( v )
+ CALL exchange_horiz( w )
+
+!
+!-- Compute the divergence of the corrected velocity field,
+!-- a possible PE-sum is computed in flow_statistics
+ CALL cpu_log( log_point_s(1), 'divergence', 'start' )
+ sums_divnew_l = 0.0
+
+!
+!-- d must be reset to zero because it can contain nonzero values below the
+!-- topography
+ IF ( topography /= 'flat' ) d = 0.0
+
+ localsum = 0.0
+ threadsum = 0.0
+
+ !$OMP PARALLEL PRIVATE (i,j,k) FIRSTPRIVATE(threadsum) REDUCTION(+:localsum)
+ !$OMP DO SCHEDULE( STATIC )
+#if defined( __ibm )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ d(k,j,i) = ( u(k,j,i+1) - u(k,j,i) ) * ddx + &
+ ( v(k,j+1,i) - v(k,j,i) ) * ddy + &
+ ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+ ENDDO
+ DO k = nzb+1, nzt
+ threadsum = threadsum + ABS( d(k,j,i) )
+ ENDDO
+ ENDDO
+ ENDDO
+#else
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ d(k,j,i) = ( u(k,j,i+1) - u(k,j,i) ) * ddx + &
+ ( v(k,j+1,i) - v(k,j,i) ) * ddy + &
+ ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+ threadsum = threadsum + ABS( d(k,j,i) )
+ ENDDO
+ ENDDO
+ ENDDO
+#endif
+ localsum = localsum + threadsum
+ !$OMP END PARALLEL
+
+!
+!-- For completeness, set the divergence sum of all statistic regions to those
+!-- of the total domain
+ sums_divnew_l(0:statistic_regions) = localsum
+
+ CALL cpu_log( log_point_s(1), 'divergence', 'stop' )
+
+ CALL cpu_log( log_point(8), 'pres', 'stop' )
+
+
+ END SUBROUTINE pres
Index: /palm/tags/release-3.4a/SOURCE/print_1d.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/print_1d.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/print_1d.f90 (revision 141)
@@ -0,0 +1,138 @@
+ SUBROUTINE print_1d
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.11 2006/02/23 12:50:43 raasch
+! Preliminary no output of time-averaged data
+!
+! Revision 1.1 1997/09/19 07:45:22 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! List output of 1D-profiles.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE statistics
+
+ IMPLICIT NONE
+
+
+ CHARACTER (LEN=20) :: period_chr
+ INTEGER :: k, sr
+
+
+!
+!-- If required, compute statistics.
+ IF ( .NOT. flow_statistics_called ) CALL flow_statistics
+
+!
+!-- Flow_statistics has its own cpu-time measuring.
+ CALL cpu_log( log_point(18), 'print_1d', 'start' )
+
+ IF ( myid == 0 ) THEN
+!
+!-- Open file for list output of profiles.
+ CALL check_open( 16 )
+
+!
+!-- Prepare header.
+ period_chr = ' no time-average!'
+
+!
+!-- Output for the total domain (and each subregion, if applicable).
+ DO sr = 0, statistic_regions
+!
+!-- Write header.
+ WRITE ( 16, 112 )
+ WRITE ( 16, 100 ) TRIM( run_description_header ) // ' ' // &
+ TRIM( region( sr ) ), TRIM( period_chr ), 'uv'
+ WRITE ( 16, 105 ) TRIM( simulated_time_chr )
+! ELSE
+! WRITE ( 16, 106 ) TRIM( simulated_time_chr ), &
+! averaging_interval_pr, average_count_pr
+! ENDIF
+ WRITE ( 16, 111 )
+
+!
+!-- Output of values on the scalar levels.
+ WRITE ( 16, 120 )
+ WRITE ( 16, 111 )
+ DO k = nzt+1, nzb, -1
+ WRITE ( 16, 121) k, zu(k), hom(k,1,1,sr), &
+ hom(k,1,1,sr) - hom(k,1,5,sr), &
+ hom(k,1,2,sr), &
+ hom(k,1,2,sr) - hom(k,1,6,sr), &
+ hom(k,1,4,sr), &
+ hom(k,1,4,sr) - hom(k,1,7,sr), &
+ hom(k,1,8,sr), hom(k,1,9,sr), &
+ hom(k,1,10,sr), hom(k,1,11,sr), zu(k), k
+ ENDDO
+ WRITE ( 16, 111 )
+ WRITE ( 16, 120 )
+ WRITE ( 16, 111 )
+
+!
+!-- Output of values on the w-levels.
+ WRITE ( 16, 112 )
+ WRITE ( 16, 100 ) TRIM( run_description_header ) // ' ' // &
+ TRIM( region( sr ) ), TRIM( period_chr ), 'w'
+ WRITE ( 16, 105 ) TRIM( simulated_time_chr )
+! ELSE
+! WRITE ( 16, 106 ) TRIM( simulated_time_chr ), &
+! averaging_interval_pr, average_count_pr
+! ENDIF
+ WRITE ( 16, 111 )
+
+ WRITE ( 16, 130 )
+ WRITE ( 16, 111 )
+ DO k = nzt+1, nzb, -1
+ WRITE ( 16, 131) k, zw(k), hom(k,1,16,sr), &
+ hom(k,1,18,sr), hom(k,1,12,sr), &
+ hom(k,1,19,sr), hom(k,1,14,sr), &
+ hom(k,1,20,sr), zw(k), k
+ ENDDO
+ WRITE ( 16, 111 )
+ WRITE ( 16, 130 )
+ WRITE ( 16, 111 )
+
+ ENDDO
+
+ ENDIF
+
+ CALL cpu_log( log_point(18), 'print_1d','stop', 'nobarrier' )
+
+!
+!-- Formats.
+100 FORMAT (1X,A/1X,10('-')/ &
+ ' Horizontally',A,' averaged profiles on the ',A,'-level')
+105 FORMAT (' Time: ',A)
+106 FORMAT (' Time: ',A,18X,'averaged over',F7.1,' s (',I4, &
+ ' Single times)')
+111 FORMAT (1X,131('-'))
+112 FORMAT (/)
+120 FORMAT (' k zu u du v dv pt dpt ', &
+ 'e Km Kh l zu k')
+121 FORMAT (1X,I4,1X,F7.1,1X,F6.2,1X,F5.2,1X,F6.2,1X,F5.2,2X,F6.2,1X,F5.2, &
+ 1X,F6.4,1X,F5.2,1X,F5.2,1X,F6.2,1X,F7.1,2X,I4)
+130 FORMAT (' k zw w''pt'' wpt w''u'' wu ', &
+ ' w''v'' wv zw k')
+131 FORMAT (1X,I4,1X,F7.1,6(1X,E9.3),1X,F7.1,2X,I4)
+
+
+ END SUBROUTINE print_1d
Index: /palm/tags/release-3.4a/SOURCE/production_e.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/production_e.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/production_e.f90 (revision 141)
@@ -0,0 +1,1023 @@
+ MODULE production_e_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 124 2007-10-19 15:47:46Z raasch
+! Bugfix: calculation of density flux in the ocean now starts from nzb+1
+!
+! 108 2007-08-24 15:10:38Z letzel
+! Bugfix: wrong sign removed from the buoyancy production term in the case
+! use_reference = .T.,
+! u_0 and v_0 are calculated for nxr+1, nyn+1 also (otherwise these values are
+! not available in case of non-cyclic boundary conditions)
+! Bugfix for ocean density flux at bottom
+!
+! 97 2007-06-21 08:23:15Z raasch
+! Energy production by density flux (in ocean) added
+! use_pt_reference renamed use_reference
+!
+! 75 2007-03-22 09:54:05Z raasch
+! Wall functions now include diabatic conditions, call of routine wall_fluxes_e,
+! reference temperature pt_reference can be used in buoyancy term,
+! moisture renamed humidity
+!
+! 37 2007-03-01 08:33:54Z raasch
+! Calculation extended for gridpoint nzt, extended for given temperature /
+! humidity fluxes at the top, wall-part is now executed in case that a
+! Prandtl-layer is switched on (instead of surfaces fluxes switched on)
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.21 2006/04/26 12:45:35 raasch
+! OpenMP parallelization of production_e_init
+!
+! Revision 1.1 1997/09/19 07:45:35 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Production terms (shear + buoyancy) of the TKE
+! WARNING: the case with prandtl_layer = F and use_surface_fluxes = T is
+! not considered well!
+!------------------------------------------------------------------------------!
+
+ USE wall_fluxes_mod
+
+ PRIVATE
+ PUBLIC production_e, production_e_init
+
+ LOGICAL, SAVE :: first_call = .TRUE.
+
+ REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: u_0, v_0
+
+ INTERFACE production_e
+ MODULE PROCEDURE production_e
+ MODULE PROCEDURE production_e_ij
+ END INTERFACE production_e
+
+ INTERFACE production_e_init
+ MODULE PROCEDURE production_e_init
+ END INTERFACE production_e_init
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE production_e
+
+ USE arrays_3d
+ USE cloud_parameters
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL :: def, dudx, dudy, dudz, dvdx, dvdy, dvdz, dwdx, dwdy, dwdz, &
+ k1, k2, theta, temp
+
+! REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: usvs, vsus, wsus, wsvs
+ REAL, DIMENSION(nzb:nzt+1) :: usvs, vsus, wsus, wsvs
+
+!
+!-- First calculate horizontal momentum flux u'v', w'v', v'u', w'u' at
+!-- vertical walls, if neccessary
+!-- So far, results are slightly different from the ij-Version.
+!-- Therefore, ij-Version is called further below within the ij-loops.
+! IF ( topography /= 'flat' ) THEN
+! CALL wall_fluxes_e( usvs, 1.0, 0.0, 0.0, 0.0, wall_e_y )
+! CALL wall_fluxes_e( wsvs, 0.0, 0.0, 1.0, 0.0, wall_e_y )
+! CALL wall_fluxes_e( vsus, 0.0, 1.0, 0.0, 0.0, wall_e_x )
+! CALL wall_fluxes_e( wsus, 0.0, 0.0, 0.0, 1.0, wall_e_x )
+! ENDIF
+
+!
+!-- Calculate TKE production by shear
+ DO i = nxl, nxr
+
+ DO j = nys, nyn
+ DO k = nzb_diff_s_outer(j,i), nzt
+
+ dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+ dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+ u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+ dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+ u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+ dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+ v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+ dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
+ dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+ v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+ dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+ w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+ dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+ w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+ dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+ def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) + &
+ dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+ dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+ IF ( def < 0.0 ) def = 0.0
+
+ tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+ ENDDO
+ ENDDO
+
+ IF ( prandtl_layer ) THEN
+
+!
+!-- Position beneath wall
+!-- (2) - Will allways be executed.
+!-- 'bottom and wall: use u_0,v_0 and wall functions'
+ DO j = nys, nyn
+
+ IF ( ( wall_e_x(j,i) /= 0.0 ) .OR. ( wall_e_y(j,i) /= 0.0 ) ) &
+ THEN
+
+ k = nzb_diff_s_inner(j,i) - 1
+ dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+ dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+ u_0(j,i) - u_0(j,i+1) ) * dd2zu(k)
+ dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
+ dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+ v_0(j,i) - v_0(j+1,i) ) * dd2zu(k)
+ dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+ IF ( wall_e_y(j,i) /= 0.0 ) THEN
+ CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+ usvs, 1.0, 0.0, 0.0, 0.0 )
+ dudy = wall_e_y(j,i) * usvs(k) / km(k,j,i)
+! dudy = wall_e_y(j,i) * usvs(k,j,i) / km(k,j,i)
+ CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+ wsvs, 0.0, 0.0, 1.0, 0.0 )
+ dwdy = wall_e_y(j,i) * wsvs(k) / km(k,j,i)
+! dwdy = wall_e_y(j,i) * wsvs(k,j,i) / km(k,j,i)
+ ELSE
+ dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+ u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+ dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+ w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+ ENDIF
+
+ IF ( wall_e_x(j,i) /= 0.0 ) THEN
+ CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+ vsus, 0.0, 1.0, 0.0, 0.0 )
+ dvdx = wall_e_x(j,i) * vsus(k) / km(k,j,i)
+! dvdx = wall_e_x(j,i) * vsus(k,j,i) / km(k,j,i)
+ CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+ wsus, 0.0, 0.0, 0.0, 1.0 )
+ dwdx = wall_e_x(j,i) * wsus(k) / km(k,j,i)
+! dwdx = wall_e_x(j,i) * wsus(k,j,i) / km(k,j,i)
+ ELSE
+ dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+ v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+ dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+ w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+ ENDIF
+
+ def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) + &
+ dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+ dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+ IF ( def < 0.0 ) def = 0.0
+
+ tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+
+!
+!-- (3) - will be executed only, if there is at least one level
+!-- between (2) and (4), i.e. the topography must have a
+!-- minimum height of 2 dz. Wall fluxes for this case have
+!-- already been calculated for (2).
+!-- 'wall only: use wall functions'
+
+ DO k = nzb_diff_s_inner(j,i), nzb_diff_s_outer(j,i)-2
+
+ dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+ dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+ u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+ dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
+ dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+ v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+ dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+ IF ( wall_e_y(j,i) /= 0.0 ) THEN
+ dudy = wall_e_y(j,i) * usvs(k) / km(k,j,i)
+! dudy = wall_e_y(j,i) * usvs(k,j,i) / km(k,j,i)
+ dwdy = wall_e_y(j,i) * wsvs(k) / km(k,j,i)
+! dwdy = wall_e_y(j,i) * wsvs(k,j,i) / km(k,j,i)
+ ELSE
+ dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+ u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+ dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+ w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+ ENDIF
+
+ IF ( wall_e_x(j,i) /= 0.0 ) THEN
+ dvdx = wall_e_x(j,i) * vsus(k) / km(k,j,i)
+! dvdx = wall_e_x(j,i) * vsus(k,j,i) / km(k,j,i)
+ dwdx = wall_e_x(j,i) * wsus(k) / km(k,j,i)
+! dwdx = wall_e_x(j,i) * wsus(k,j,i) / km(k,j,i)
+ ELSE
+ dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+ v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+ dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+ w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+ ENDIF
+
+ def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) + &
+ dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+ dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+ IF ( def < 0.0 ) def = 0.0
+
+ tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+ ENDDO
+
+ ENDIF
+
+ ENDDO
+
+!
+!-- (4) - will allways be executed.
+!-- 'special case: free atmosphere' (as for case (0))
+ DO j = nys, nyn
+
+ IF ( ( wall_e_x(j,i) /= 0.0 ) .OR. ( wall_e_y(j,i) /= 0.0 ) ) &
+ THEN
+
+ k = nzb_diff_s_outer(j,i)-1
+
+ dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+ dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+ u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+ dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+ u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+ dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+ v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+ dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
+ dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+ v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+ dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+ w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+ dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+ w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+ dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+ def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) + &
+ dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+ dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+ IF ( def < 0.0 ) def = 0.0
+
+ tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+ ENDIF
+
+ ENDDO
+
+!
+!-- Position without adjacent wall
+!-- (1) - will allways be executed.
+!-- 'bottom only: use u_0,v_0'
+ DO j = nys, nyn
+
+ IF ( ( wall_e_x(j,i) == 0.0 ) .AND. ( wall_e_y(j,i) == 0.0 ) ) &
+ THEN
+
+ k = nzb_diff_s_inner(j,i)-1
+
+ dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+ dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+ u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+ dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+ u_0(j,i) - u_0(j,i+1) ) * dd2zu(k)
+
+ dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+ v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+ dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
+ dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+ v_0(j,i) - v_0(j+1,i) ) * dd2zu(k)
+
+ dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+ w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+ dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+ w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+ dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+ def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) + &
+ dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+ dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+ IF ( def < 0.0 ) def = 0.0
+
+ tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+ ENDIF
+
+ ENDDO
+
+ ELSEIF ( use_surface_fluxes ) THEN
+
+ DO j = nys, nyn
+
+ k = nzb_diff_s_outer(j,i)-1
+
+ dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+ dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+ u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+ dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+ u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+ dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+ v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+ dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
+ dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+ v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+ dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+ w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+ dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+ w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+ dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+ def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) + &
+ dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+ dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+ IF ( def < 0.0 ) def = 0.0
+
+ tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+ ENDDO
+
+ ENDIF
+
+!
+!-- Calculate TKE production by buoyancy
+ IF ( .NOT. humidity ) THEN
+
+ IF ( use_reference ) THEN
+
+ IF ( ocean ) THEN
+!
+!-- So far in the ocean no special treatment of density flux in
+!-- the bottom and top surface layer
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) + &
+ kh(k,j,i) * g / prho_reference * &
+ ( rho(k+1,j,i)-rho(k-1,j,i) ) * dd2zu(k)
+ ENDDO
+ ENDDO
+
+ ELSE
+
+ DO j = nys, nyn
+ DO k = nzb_diff_s_inner(j,i), nzt_diff
+ tend(k,j,i) = tend(k,j,i) - &
+ kh(k,j,i) * g / pt_reference * &
+ ( pt(k+1,j,i) - pt(k-1,j,i) ) * dd2zu(k)
+ ENDDO
+
+ IF ( use_surface_fluxes ) THEN
+ k = nzb_diff_s_inner(j,i)-1
+ tend(k,j,i) = tend(k,j,i) + g / pt_reference * shf(j,i)
+ ENDIF
+
+ IF ( use_top_fluxes ) THEN
+ k = nzt
+ tend(k,j,i) = tend(k,j,i) + g / pt_reference * &
+ tswst(j,i)
+ ENDIF
+ ENDDO
+
+ ENDIF
+
+ ELSE
+
+ IF ( ocean ) THEN
+!
+!-- So far in the ocean no special treatment of density flux in
+!-- the bottom and top surface layer
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) - &
+ kh(k,j,i) * g / rho(k,j,i) * &
+ ( rho(k+1,j,i)-rho(k-1,j,i) ) * dd2zu(k)
+ ENDDO
+ ENDDO
+
+ ELSE
+
+ DO j = nys, nyn
+ DO k = nzb_diff_s_inner(j,i), nzt_diff
+ tend(k,j,i) = tend(k,j,i) - &
+ kh(k,j,i) * g / pt(k,j,i) * &
+ ( pt(k+1,j,i) - pt(k-1,j,i) ) * dd2zu(k)
+ ENDDO
+
+ IF ( use_surface_fluxes ) THEN
+ k = nzb_diff_s_inner(j,i)-1
+ tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * shf(j,i)
+ ENDIF
+
+ IF ( use_top_fluxes ) THEN
+ k = nzt
+ tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * tswst(j,i)
+ ENDIF
+ ENDDO
+
+ ENDIF
+
+ ENDIF
+
+ ELSE
+
+ DO j = nys, nyn
+
+ DO k = nzb_diff_s_inner(j,i), nzt_diff
+
+ IF ( .NOT. cloud_physics ) THEN
+ k1 = 1.0 + 0.61 * q(k,j,i)
+ k2 = 0.61 * pt(k,j,i)
+ ELSE
+ IF ( ql(k,j,i) == 0.0 ) THEN
+ k1 = 1.0 + 0.61 * q(k,j,i)
+ k2 = 0.61 * pt(k,j,i)
+ ELSE
+ theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+ temp = theta * t_d_pt(k)
+ k1 = ( 1.0 - q(k,j,i) + 1.61 * &
+ ( q(k,j,i) - ql(k,j,i) ) * &
+ ( 1.0 + 0.622 * l_d_r / temp ) ) / &
+ ( 1.0 + 0.622 * l_d_r * l_d_cp * &
+ ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+ k2 = theta * ( l_d_cp / temp * k1 - 1.0 )
+ ENDIF
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g / vpt(k,j,i) * &
+ ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) + &
+ k2 * ( q(k+1,j,i) - q(k-1,j,i) ) &
+ ) * dd2zu(k)
+ ENDDO
+
+ ENDDO
+
+ IF ( use_surface_fluxes ) THEN
+
+ DO j = nys, nyn
+
+ k = nzb_diff_s_inner(j,i)-1
+
+ IF ( .NOT. cloud_physics ) THEN
+ k1 = 1.0 + 0.61 * q(k,j,i)
+ k2 = 0.61 * pt(k,j,i)
+ ELSE
+ IF ( ql(k,j,i) == 0.0 ) THEN
+ k1 = 1.0 + 0.61 * q(k,j,i)
+ k2 = 0.61 * pt(k,j,i)
+ ELSE
+ theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+ temp = theta * t_d_pt(k)
+ k1 = ( 1.0 - q(k,j,i) + 1.61 * &
+ ( q(k,j,i) - ql(k,j,i) ) * &
+ ( 1.0 + 0.622 * l_d_r / temp ) ) / &
+ ( 1.0 + 0.622 * l_d_r * l_d_cp * &
+ ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+ k2 = theta * ( l_d_cp / temp * k1 - 1.0 )
+ ENDIF
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
+ ( k1* shf(j,i) + k2 * qsws(j,i) )
+ ENDDO
+
+ ENDIF
+
+ IF ( use_top_fluxes ) THEN
+
+ DO j = nys, nyn
+
+ k = nzt
+
+ IF ( .NOT. cloud_physics ) THEN
+ k1 = 1.0 + 0.61 * q(k,j,i)
+ k2 = 0.61 * pt(k,j,i)
+ ELSE
+ IF ( ql(k,j,i) == 0.0 ) THEN
+ k1 = 1.0 + 0.61 * q(k,j,i)
+ k2 = 0.61 * pt(k,j,i)
+ ELSE
+ theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+ temp = theta * t_d_pt(k)
+ k1 = ( 1.0 - q(k,j,i) + 1.61 * &
+ ( q(k,j,i) - ql(k,j,i) ) * &
+ ( 1.0 + 0.622 * l_d_r / temp ) ) / &
+ ( 1.0 + 0.622 * l_d_r * l_d_cp * &
+ ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+ k2 = theta * ( l_d_cp / temp * k1 - 1.0 )
+ ENDIF
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
+ ( k1* tswst(j,i) + k2 * qswst(j,i) )
+ ENDDO
+
+ ENDIF
+
+ ENDIF
+
+ ENDDO
+
+ END SUBROUTINE production_e
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE production_e_ij( i, j )
+
+ USE arrays_3d
+ USE cloud_parameters
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL :: def, dudx, dudy, dudz, dvdx, dvdy, dvdz, dwdx, dwdy, dwdz, &
+ k1, k2, theta, temp
+
+ REAL, DIMENSION(nzb:nzt+1) :: usvs, vsus, wsus, wsvs
+
+!
+!-- Calculate TKE production by shear
+ DO k = nzb_diff_s_outer(j,i), nzt
+
+ dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+ dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+ u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+ dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+ u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+ dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+ v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+ dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
+ dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+ v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+ dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+ w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+ dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+ w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+ dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+ def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) &
+ + dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + dvdz**2 &
+ + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+ IF ( def < 0.0 ) def = 0.0
+
+ tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+ ENDDO
+
+ IF ( prandtl_layer ) THEN
+
+ IF ( ( wall_e_x(j,i) /= 0.0 ) .OR. ( wall_e_y(j,i) /= 0.0 ) ) THEN
+
+!
+!-- Position beneath wall
+!-- (2) - Will allways be executed.
+!-- 'bottom and wall: use u_0,v_0 and wall functions'
+ k = nzb_diff_s_inner(j,i)-1
+
+ dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+ dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+ u_0(j,i) - u_0(j,i+1) ) * dd2zu(k)
+ dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
+ dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+ v_0(j,i) - v_0(j+1,i) ) * dd2zu(k)
+ dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+ IF ( wall_e_y(j,i) /= 0.0 ) THEN
+ CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+ usvs, 1.0, 0.0, 0.0, 0.0 )
+ dudy = wall_e_y(j,i) * usvs(k) / km(k,j,i)
+ CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+ wsvs, 0.0, 0.0, 1.0, 0.0 )
+ dwdy = wall_e_y(j,i) * wsvs(k) / km(k,j,i)
+ ELSE
+ dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+ u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+ dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+ w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+ ENDIF
+
+ IF ( wall_e_x(j,i) /= 0.0 ) THEN
+ CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+ vsus, 0.0, 1.0, 0.0, 0.0 )
+ dvdx = wall_e_x(j,i) * vsus(k) / km(k,j,i)
+ CALL wall_fluxes_e( i, j, k, nzb_diff_s_outer(j,i)-2, &
+ wsus, 0.0, 0.0, 0.0, 1.0 )
+ dwdx = wall_e_x(j,i) * wsus(k) / km(k,j,i)
+ ELSE
+ dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+ v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+ dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+ w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+ ENDIF
+
+ def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) + &
+ dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+ dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+ IF ( def < 0.0 ) def = 0.0
+
+ tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+!
+!-- (3) - will be executed only, if there is at least one level
+!-- between (2) and (4), i.e. the topography must have a
+!-- minimum height of 2 dz. Wall fluxes for this case have
+!-- already been calculated for (2).
+!-- 'wall only: use wall functions'
+ DO k = nzb_diff_s_inner(j,i), nzb_diff_s_outer(j,i)-2
+
+ dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+ dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+ u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+ dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
+ dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+ v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+ dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+ IF ( wall_e_y(j,i) /= 0.0 ) THEN
+ dudy = wall_e_y(j,i) * usvs(k) / km(k,j,i)
+ dwdy = wall_e_y(j,i) * wsvs(k) / km(k,j,i)
+ ELSE
+ dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+ u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+ dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+ w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+ ENDIF
+
+ IF ( wall_e_x(j,i) /= 0.0 ) THEN
+ dvdx = wall_e_x(j,i) * vsus(k) / km(k,j,i)
+ dwdx = wall_e_x(j,i) * wsus(k) / km(k,j,i)
+ ELSE
+ dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+ v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+ dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+ w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+ ENDIF
+
+ def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) + &
+ dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+ dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+ IF ( def < 0.0 ) def = 0.0
+
+ tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+ ENDDO
+
+!
+!-- (4) - will allways be executed.
+!-- 'special case: free atmosphere' (as for case (0))
+ k = nzb_diff_s_outer(j,i)-1
+
+ dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+ dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+ u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+ dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+ u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+ dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+ v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+ dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
+ dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+ v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+ dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+ w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+ dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+ w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+ dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+ def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) + &
+ dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+ dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+ IF ( def < 0.0 ) def = 0.0
+
+ tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+ ELSE
+
+!
+!-- Position without adjacent wall
+!-- (1) - will allways be executed.
+!-- 'bottom only: use u_0,v_0'
+ k = nzb_diff_s_inner(j,i)-1
+
+ dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+ dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+ u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+ dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+ u_0(j,i) - u_0(j,i+1) ) * dd2zu(k)
+
+ dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+ v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+ dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
+ dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+ v_0(j,i) - v_0(j+1,i) ) * dd2zu(k)
+
+ dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+ w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+ dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+ w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+ dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+ def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) &
+ + dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + dvdz**2 &
+ + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+ IF ( def < 0.0 ) def = 0.0
+
+ tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+ ENDIF
+
+ ELSEIF ( use_surface_fluxes ) THEN
+
+ k = nzb_diff_s_outer(j,i)-1
+
+ dudx = ( u(k,j,i+1) - u(k,j,i) ) * ddx
+ dudy = 0.25 * ( u(k,j+1,i) + u(k,j+1,i+1) - &
+ u(k,j-1,i) - u(k,j-1,i+1) ) * ddy
+ dudz = 0.5 * ( u(k+1,j,i) + u(k+1,j,i+1) - &
+ u(k-1,j,i) - u(k-1,j,i+1) ) * dd2zu(k)
+
+ dvdx = 0.25 * ( v(k,j,i+1) + v(k,j+1,i+1) - &
+ v(k,j,i-1) - v(k,j+1,i-1) ) * ddx
+ dvdy = ( v(k,j+1,i) - v(k,j,i) ) * ddy
+ dvdz = 0.5 * ( v(k+1,j,i) + v(k+1,j+1,i) - &
+ v(k-1,j,i) - v(k-1,j+1,i) ) * dd2zu(k)
+
+ dwdx = 0.25 * ( w(k,j,i+1) + w(k-1,j,i+1) - &
+ w(k,j,i-1) - w(k-1,j,i-1) ) * ddx
+ dwdy = 0.25 * ( w(k,j+1,i) + w(k-1,j+1,i) - &
+ w(k,j-1,i) - w(k-1,j-1,i) ) * ddy
+ dwdz = ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k)
+
+ def = 2.0 * ( dudx**2 + dvdy**2 + dwdz**2 ) + &
+ dudy**2 + dvdx**2 + dwdx**2 + dwdy**2 + dudz**2 + &
+ dvdz**2 + 2.0 * ( dvdx*dudy + dwdx*dudz + dwdy*dvdz )
+
+ IF ( def < 0.0 ) def = 0.0
+
+ tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def
+
+ ENDIF
+
+!
+!-- Calculate TKE production by buoyancy
+ IF ( .NOT. humidity ) THEN
+
+ IF ( use_reference ) THEN
+
+ IF ( ocean ) THEN
+!
+!-- So far in the ocean no special treatment of density flux in the
+!-- bottom and top surface layer
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) + kh(k,j,i) * g / prho_reference * &
+ ( rho(k+1,j,i) - rho(k-1,j,i) ) * dd2zu(k)
+ ENDDO
+
+ ELSE
+
+ DO k = nzb_diff_s_inner(j,i), nzt_diff
+ tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g / pt_reference * &
+ ( pt(k+1,j,i) - pt(k-1,j,i) ) * dd2zu(k)
+ ENDDO
+
+ IF ( use_surface_fluxes ) THEN
+ k = nzb_diff_s_inner(j,i)-1
+ tend(k,j,i) = tend(k,j,i) + g / pt_reference * shf(j,i)
+ ENDIF
+
+ IF ( use_top_fluxes ) THEN
+ k = nzt
+ tend(k,j,i) = tend(k,j,i) + g / pt_reference * tswst(j,i)
+ ENDIF
+
+ ENDIF
+
+ ELSE
+
+ IF ( ocean ) THEN
+!
+!-- So far in the ocean no special treatment of density flux in the
+!-- bottom and top surface layer
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tend(k,j,i) = tend(k,j,i) + kh(k,j,i) * g / rho(k,j,i) * &
+ ( rho(k+1,j,i) - rho(k-1,j,i) ) * dd2zu(k)
+ ENDDO
+
+ ELSE
+
+ DO k = nzb_diff_s_inner(j,i), nzt_diff
+ tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g / pt(k,j,i) * &
+ ( pt(k+1,j,i) - pt(k-1,j,i) ) * dd2zu(k)
+ ENDDO
+
+ IF ( use_surface_fluxes ) THEN
+ k = nzb_diff_s_inner(j,i)-1
+ tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * shf(j,i)
+ ENDIF
+
+ IF ( use_top_fluxes ) THEN
+ k = nzt
+ tend(k,j,i) = tend(k,j,i) + g / pt(k,j,i) * tswst(j,i)
+ ENDIF
+
+ ENDIF
+
+ ENDIF
+
+ ELSE
+
+ DO k = nzb_diff_s_inner(j,i), nzt_diff
+
+ IF ( .NOT. cloud_physics ) THEN
+ k1 = 1.0 + 0.61 * q(k,j,i)
+ k2 = 0.61 * pt(k,j,i)
+ ELSE
+ IF ( ql(k,j,i) == 0.0 ) THEN
+ k1 = 1.0 + 0.61 * q(k,j,i)
+ k2 = 0.61 * pt(k,j,i)
+ ELSE
+ theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+ temp = theta * t_d_pt(k)
+ k1 = ( 1.0 - q(k,j,i) + 1.61 * &
+ ( q(k,j,i) - ql(k,j,i) ) * &
+ ( 1.0 + 0.622 * l_d_r / temp ) ) / &
+ ( 1.0 + 0.622 * l_d_r * l_d_cp * &
+ ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+ k2 = theta * ( l_d_cp / temp * k1 - 1.0 )
+ ENDIF
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g / vpt(k,j,i) * &
+ ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) + &
+ k2 * ( q(k+1,j,i) - q(k-1,j,i) ) &
+ ) * dd2zu(k)
+ ENDDO
+
+ IF ( use_surface_fluxes ) THEN
+ k = nzb_diff_s_inner(j,i)-1
+
+ IF ( .NOT. cloud_physics ) THEN
+ k1 = 1.0 + 0.61 * q(k,j,i)
+ k2 = 0.61 * pt(k,j,i)
+ ELSE
+ IF ( ql(k,j,i) == 0.0 ) THEN
+ k1 = 1.0 + 0.61 * q(k,j,i)
+ k2 = 0.61 * pt(k,j,i)
+ ELSE
+ theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+ temp = theta * t_d_pt(k)
+ k1 = ( 1.0 - q(k,j,i) + 1.61 * &
+ ( q(k,j,i) - ql(k,j,i) ) * &
+ ( 1.0 + 0.622 * l_d_r / temp ) ) / &
+ ( 1.0 + 0.622 * l_d_r * l_d_cp * &
+ ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+ k2 = theta * ( l_d_cp / temp * k1 - 1.0 )
+ ENDIF
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
+ ( k1* shf(j,i) + k2 * qsws(j,i) )
+ ENDIF
+
+ IF ( use_top_fluxes ) THEN
+ k = nzt
+
+ IF ( .NOT. cloud_physics ) THEN
+ k1 = 1.0 + 0.61 * q(k,j,i)
+ k2 = 0.61 * pt(k,j,i)
+ ELSE
+ IF ( ql(k,j,i) == 0.0 ) THEN
+ k1 = 1.0 + 0.61 * q(k,j,i)
+ k2 = 0.61 * pt(k,j,i)
+ ELSE
+ theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+ temp = theta * t_d_pt(k)
+ k1 = ( 1.0 - q(k,j,i) + 1.61 * &
+ ( q(k,j,i) - ql(k,j,i) ) * &
+ ( 1.0 + 0.622 * l_d_r / temp ) ) / &
+ ( 1.0 + 0.622 * l_d_r * l_d_cp * &
+ ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+ k2 = theta * ( l_d_cp / temp * k1 - 1.0 )
+ ENDIF
+ ENDIF
+
+ tend(k,j,i) = tend(k,j,i) + g / vpt(k,j,i) * &
+ ( k1* tswst(j,i) + k2 * qswst(j,i) )
+ ENDIF
+
+ ENDIF
+
+ END SUBROUTINE production_e_ij
+
+
+ SUBROUTINE production_e_init
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, ku, kv
+
+ IF ( prandtl_layer ) THEN
+
+ IF ( first_call ) THEN
+ ALLOCATE( u_0(nys-1:nyn+1,nxl-1:nxr+1), &
+ v_0(nys-1:nyn+1,nxl-1:nxr+1) )
+ first_call = .FALSE.
+ ENDIF
+
+!
+!-- Calculate a virtual velocity at the surface in a way that the
+!-- vertical velocity gradient at k = 1 (u(k+1)-u_0) matches the
+!-- Prandtl law (-w'u'/km). This gradient is used in the TKE shear
+!-- production term at k=1 (see production_e_ij).
+!-- The velocity gradient has to be limited in case of too small km
+!-- (otherwise the timestep may be significantly reduced by large
+!-- surface winds).
+!-- Upper bounds are nxr+1 and nyn+1 because otherwise these values are
+!-- not available in case of non-cyclic boundary conditions.
+!-- WARNING: the exact analytical solution would require the determination
+!-- of the eddy diffusivity by km = u* * kappa * zp / phi_m.
+ !$OMP PARALLEL DO PRIVATE( ku, kv )
+ DO i = nxl, nxr+1
+ DO j = nys, nyn+1
+
+ ku = nzb_u_inner(j,i)+1
+ kv = nzb_v_inner(j,i)+1
+
+ u_0(j,i) = u(ku+1,j,i) + usws(j,i) * ( zu(ku+1) - zu(ku-1) ) / &
+ ( 0.5 * ( km(ku,j,i) + km(ku,j,i-1) ) + &
+ 1.0E-20 )
+! ( us(j,i) * kappa * zu(1) )
+ v_0(j,i) = v(kv+1,j,i) + vsws(j,i) * ( zu(kv+1) - zu(kv-1) ) / &
+ ( 0.5 * ( km(kv,j,i) + km(kv,j-1,i) ) + &
+ 1.0E-20 )
+! ( us(j,i) * kappa * zu(1) )
+
+ IF ( ABS( u(ku+1,j,i) - u_0(j,i) ) > &
+ ABS( u(ku+1,j,i) - u(ku-1,j,i) ) ) u_0(j,i) = u(ku-1,j,i)
+ IF ( ABS( v(kv+1,j,i) - v_0(j,i) ) > &
+ ABS( v(kv+1,j,i) - v(kv-1,j,i) ) ) v_0(j,i) = v(kv-1,j,i)
+
+ ENDDO
+ ENDDO
+
+ CALL exchange_horiz_2d( u_0 )
+ CALL exchange_horiz_2d( v_0 )
+
+ ENDIF
+
+ END SUBROUTINE production_e_init
+
+ END MODULE production_e_mod
Index: /palm/tags/release-3.4a/SOURCE/prognostic_equations.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/prognostic_equations.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/prognostic_equations.f90 (revision 141)
@@ -0,0 +1,1972 @@
+ MODULE prognostic_equations_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 138 2007-11-28 10:03:58Z letzel
+! add call of subroutines that evaluate the canopy drag terms,
+! add wall_*flux to parameter list of calls of diffusion_s
+!
+! 106 2007-08-16 14:30:26Z raasch
+! +uswst, vswst as arguments in calls of diffusion_u|v,
+! loops for u and v are starting from index nxlu, nysv, respectively (needed
+! for non-cyclic boundary conditions)
+!
+! 97 2007-06-21 08:23:15Z raasch
+! prognostic equation for salinity, density is calculated from equation of
+! state for seawater and is used for calculation of buoyancy,
+! +eqn_state_seawater_mod
+! diffusion_e is called with argument rho in case of ocean runs,
+! new argument zw in calls of diffusion_e, new argument pt_/prho_reference
+! in calls of buoyancy and diffusion_e, calc_mean_pt_profile renamed
+! calc_mean_profile
+!
+! 75 2007-03-22 09:54:05Z raasch
+! checking for negative q and limiting for positive values,
+! z0 removed from arguments in calls of diffusion_u/v/w, uxrp, vynp eliminated,
+! subroutine names changed to .._noopt, .._cache, and .._vector,
+! moisture renamed humidity, Bott-Chlond-scheme can be used in the
+! _vector-version
+!
+! 19 2007-02-23 04:53:48Z raasch
+! Calculation of e, q, and pt extended for gridpoint nzt,
+! handling of given temperature/humidity/scalar fluxes at top surface
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.21 2006/08/04 15:01:07 raasch
+! upstream scheme can be forced to be used for tke (use_upstream_for_tke)
+! regardless of the timestep scheme used for the other quantities,
+! new argument diss in call of diffusion_e
+!
+! Revision 1.1 2000/04/13 14:56:27 schroeter
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Solving the prognostic equations.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE cpulog
+ USE eqn_state_seawater_mod
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE pointer_interfaces
+ USE statistics
+
+ USE advec_s_pw_mod
+ USE advec_s_up_mod
+ USE advec_u_pw_mod
+ USE advec_u_up_mod
+ USE advec_v_pw_mod
+ USE advec_v_up_mod
+ USE advec_w_pw_mod
+ USE advec_w_up_mod
+ USE buoyancy_mod
+ USE calc_precipitation_mod
+ USE calc_radiation_mod
+ USE coriolis_mod
+ USE diffusion_e_mod
+ USE diffusion_s_mod
+ USE diffusion_u_mod
+ USE diffusion_v_mod
+ USE diffusion_w_mod
+ USE impact_of_latent_heat_mod
+ USE plant_canopy_model_mod
+ USE production_e_mod
+ USE user_actions_mod
+
+
+ PRIVATE
+ PUBLIC prognostic_equations_noopt, prognostic_equations_cache, &
+ prognostic_equations_vector
+
+ INTERFACE prognostic_equations_noopt
+ MODULE PROCEDURE prognostic_equations_noopt
+ END INTERFACE prognostic_equations_noopt
+
+ INTERFACE prognostic_equations_cache
+ MODULE PROCEDURE prognostic_equations_cache
+ END INTERFACE prognostic_equations_cache
+
+ INTERFACE prognostic_equations_vector
+ MODULE PROCEDURE prognostic_equations_vector
+ END INTERFACE prognostic_equations_vector
+
+
+ CONTAINS
+
+
+ SUBROUTINE prognostic_equations_noopt
+
+!------------------------------------------------------------------------------!
+! Version with single loop optimization
+!
+! (Optimized over each single prognostic equation.)
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=9) :: time_to_string
+ INTEGER :: i, j, k
+ REAL :: sat, sbt
+
+!
+!-- Calculate those variables needed in the tendency terms which need
+!-- global communication
+ CALL calc_mean_profile( pt, 4 )
+ IF ( ocean ) CALL calc_mean_profile( rho, 64 )
+ IF ( humidity ) CALL calc_mean_profile( vpt, 44 )
+
+!
+!-- u-velocity component
+ CALL cpu_log( log_point(5), 'u-equation', 'start' )
+
+!
+!-- u-tendency terms with communication
+ IF ( momentum_advec == 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_u_ups
+ ENDIF
+
+!
+!-- u-tendency terms with no communication
+ DO i = nxlu, nxr
+ DO j = nys, nyn
+!
+!-- Tendency terms
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ tend(:,j,i) = 0.0
+ CALL advec_u_pw( i, j )
+ ELSE
+ IF ( momentum_advec /= 'ups-scheme' ) THEN
+ tend(:,j,i) = 0.0
+ CALL advec_u_up( i, j )
+ ENDIF
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN
+ CALL diffusion_u( i, j, ddzu, ddzw, km_m, km_damp_y, tend, u_m, &
+ usws_m, uswst_m, v_m, w_m )
+ ELSE
+ CALL diffusion_u( i, j, ddzu, ddzw, km, km_damp_y, tend, u, usws, &
+ uswst, v, w )
+ ENDIF
+ CALL coriolis( i, j, 1 )
+ IF ( sloping_surface ) CALL buoyancy( i, j, pt, pt_reference, 1, 4 )
+
+!
+!-- Drag by plant canopy
+ IF ( plant_canopy ) CALL plant_canopy_model( i, j, 1 )
+ CALL user_actions( i, j, 'u-tendency' )
+
+!
+!-- Prognostic equation for u-velocity component
+ DO k = nzb_u_inner(j,i)+1, nzt
+ u_p(k,j,i) = ( 1.0-tsc(1) ) * u_m(k,j,i) + tsc(1) * u(k,j,i) + &
+ dt_3d * ( &
+ tsc(2) * tend(k,j,i) + tsc(3) * tu_m(k,j,i) &
+ - tsc(4) * ( p(k,j,i) - p(k,j,i-1) ) * ddx &
+ ) - &
+ tsc(5) * rdf(k) * ( u(k,j,i) - ug(k) )
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO k = nzb_u_inner(j,i)+1, nzt
+ tu_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO k = nzb_u_inner(j,i)+1, nzt
+ tu_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tu_m(k,j,i)
+ ENDDO
+ ENDIF
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+ CALL cpu_log( log_point(5), 'u-equation', 'stop' )
+
+!
+!-- v-velocity component
+ CALL cpu_log( log_point(6), 'v-equation', 'start' )
+
+!
+!-- v-tendency terms with communication
+ IF ( momentum_advec == 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_v_ups
+ ENDIF
+
+!
+!-- v-tendency terms with no communication
+ DO i = nxl, nxr
+ DO j = nysv, nyn
+!
+!-- Tendency terms
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ tend(:,j,i) = 0.0
+ CALL advec_v_pw( i, j )
+ ELSE
+ IF ( momentum_advec /= 'ups-scheme' ) THEN
+ tend(:,j,i) = 0.0
+ CALL advec_v_up( i, j )
+ ENDIF
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN
+ CALL diffusion_v( i, j, ddzu, ddzw, km_m, km_damp_x, tend, u_m, &
+ v_m, vsws_m, vswst_m, w_m )
+ ELSE
+ CALL diffusion_v( i, j, ddzu, ddzw, km, km_damp_x, tend, u, v, &
+ vsws, vswst, w )
+ ENDIF
+ CALL coriolis( i, j, 2 )
+
+!
+!-- Drag by plant canopy
+ IF ( plant_canopy ) CALL plant_canopy_model( i, j, 2 )
+
+ CALL user_actions( i, j, 'v-tendency' )
+
+!
+!-- Prognostic equation for v-velocity component
+ DO k = nzb_v_inner(j,i)+1, nzt
+ v_p(k,j,i) = ( 1.0-tsc(1) ) * v_m(k,j,i) + tsc(1) * v(k,j,i) + &
+ dt_3d * ( &
+ tsc(2) * tend(k,j,i) + tsc(3) * tv_m(k,j,i) &
+ - tsc(4) * ( p(k,j,i) - p(k,j-1,i) ) * ddy &
+ ) - &
+ tsc(5) * rdf(k) * ( v(k,j,i) - vg(k) )
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO k = nzb_v_inner(j,i)+1, nzt
+ tv_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO k = nzb_v_inner(j,i)+1, nzt
+ tv_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tv_m(k,j,i)
+ ENDDO
+ ENDIF
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+ CALL cpu_log( log_point(6), 'v-equation', 'stop' )
+
+!
+!-- w-velocity component
+ CALL cpu_log( log_point(7), 'w-equation', 'start' )
+
+!
+!-- w-tendency terms with communication
+ IF ( momentum_advec == 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_w_ups
+ ENDIF
+
+!
+!-- w-tendency terms with no communication
+ DO i = nxl, nxr
+ DO j = nys, nyn
+!
+!-- Tendency terms
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ tend(:,j,i) = 0.0
+ CALL advec_w_pw( i, j )
+ ELSE
+ IF ( momentum_advec /= 'ups-scheme' ) THEN
+ tend(:,j,i) = 0.0
+ CALL advec_w_up( i, j )
+ ENDIF
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN
+ CALL diffusion_w( i, j, ddzu, ddzw, km_m, km_damp_x, km_damp_y, &
+ tend, u_m, v_m, w_m )
+ ELSE
+ CALL diffusion_w( i, j, ddzu, ddzw, km, km_damp_x, km_damp_y, &
+ tend, u, v, w )
+ ENDIF
+ CALL coriolis( i, j, 3 )
+ IF ( ocean ) THEN
+ CALL buoyancy( i, j, rho, prho_reference, 3, 64 )
+ ELSE
+ IF ( .NOT. humidity ) THEN
+ CALL buoyancy( i, j, pt, pt_reference, 3, 4 )
+ ELSE
+ CALL buoyancy( i, j, vpt, pt_reference, 3, 44 )
+ ENDIF
+ ENDIF
+
+!
+!-- Drag by plant canopy
+ IF ( plant_canopy ) CALL plant_canopy_model( i, j, 3 )
+
+ CALL user_actions( i, j, 'w-tendency' )
+
+!
+!-- Prognostic equation for w-velocity component
+ DO k = nzb_w_inner(j,i)+1, nzt-1
+ w_p(k,j,i) = ( 1.0-tsc(1) ) * w_m(k,j,i) + tsc(1) * w(k,j,i) + &
+ dt_3d * ( &
+ tsc(2) * tend(k,j,i) + tsc(3) * tw_m(k,j,i) &
+ - tsc(4) * ( p(k+1,j,i) - p(k,j,i) ) * ddzu(k+1) &
+ ) - &
+ tsc(5) * rdf(k) * w(k,j,i)
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO k = nzb_w_inner(j,i)+1, nzt-1
+ tw_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO k = nzb_w_inner(j,i)+1, nzt-1
+ tw_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tw_m(k,j,i)
+ ENDDO
+ ENDIF
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+ CALL cpu_log( log_point(7), 'w-equation', 'stop' )
+
+!
+!-- potential temperature
+ CALL cpu_log( log_point(13), 'pt-equation', 'start' )
+
+!
+!-- pt-tendency terms with communication
+ sat = tsc(1)
+ sbt = tsc(2)
+ IF ( scalar_advec == 'bc-scheme' ) THEN
+
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+!
+!-- Bott-Chlond scheme always uses Euler time step when leapfrog is
+!-- switched on. Thus:
+ sat = 1.0
+ sbt = 1.0
+ ENDIF
+ tend = 0.0
+ CALL advec_s_bc( pt, 'pt' )
+ ELSE
+ IF ( tsc(2) /= 2.0 .AND. scalar_advec == 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_s_ups( pt, 'pt' )
+ ENDIF
+ ENDIF
+
+!
+!-- pt-tendency terms with no communication
+ DO i = nxl, nxr
+ DO j = nys, nyn
+!
+!-- Tendency terms
+ IF ( scalar_advec == 'bc-scheme' ) THEN
+ CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tswst, &
+ wall_heatflux, tend )
+ ELSE
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ tend(:,j,i) = 0.0
+ CALL advec_s_pw( i, j, pt )
+ ELSE
+ IF ( scalar_advec /= 'ups-scheme' ) THEN
+ tend(:,j,i) = 0.0
+ CALL advec_s_up( i, j, pt )
+ ENDIF
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) &
+ THEN
+ CALL diffusion_s( i, j, ddzu, ddzw, kh_m, pt_m, shf_m, &
+ tswst_m, wall_heatflux, tend )
+ ELSE
+ CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tswst, &
+ wall_heatflux, tend )
+ ENDIF
+ ENDIF
+
+!
+!-- If required compute heating/cooling due to long wave radiation
+!-- processes
+ IF ( radiation ) THEN
+ CALL calc_radiation( i, j )
+ ENDIF
+
+!
+!-- If required compute impact of latent heat due to precipitation
+ IF ( precipitation ) THEN
+ CALL impact_of_latent_heat( i, j )
+ ENDIF
+ CALL user_actions( i, j, 'pt-tendency' )
+
+!
+!-- Prognostic equation for potential temperature
+ DO k = nzb_s_inner(j,i)+1, nzt
+ pt_p(k,j,i) = ( 1 - sat ) * pt_m(k,j,i) + sat * pt(k,j,i) + &
+ dt_3d * ( &
+ sbt * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) &
+ ) - &
+ tsc(5) * rdf(k) * ( pt(k,j,i) - pt_init(k) )
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tpt_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tpt_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tpt_m(k,j,i)
+ ENDDO
+ ENDIF
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+ CALL cpu_log( log_point(13), 'pt-equation', 'stop' )
+
+!
+!-- If required, compute prognostic equation for salinity
+ IF ( ocean ) THEN
+
+ CALL cpu_log( log_point(37), 'sa-equation', 'start' )
+
+!
+!-- sa-tendency terms with communication
+ sat = tsc(1)
+ sbt = tsc(2)
+ IF ( scalar_advec == 'bc-scheme' ) THEN
+
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+!
+!-- Bott-Chlond scheme always uses Euler time step when leapfrog is
+!-- switched on. Thus:
+ sat = 1.0
+ sbt = 1.0
+ ENDIF
+ tend = 0.0
+ CALL advec_s_bc( sa, 'sa' )
+ ELSE
+ IF ( tsc(2) /= 2.0 ) THEN
+ IF ( scalar_advec == 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_s_ups( sa, 'sa' )
+ ENDIF
+ ENDIF
+ ENDIF
+
+!
+!-- sa terms with no communication
+ DO i = nxl, nxr
+ DO j = nys, nyn
+!
+!-- Tendency-terms
+ IF ( scalar_advec == 'bc-scheme' ) THEN
+ CALL diffusion_s( i, j, ddzu, ddzw, kh, sa, saswsb, saswst, &
+ wall_salinityflux, tend )
+ ELSE
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ tend(:,j,i) = 0.0
+ CALL advec_s_pw( i, j, sa )
+ ELSE
+ IF ( scalar_advec /= 'ups-scheme' ) THEN
+ tend(:,j,i) = 0.0
+ CALL advec_s_up( i, j, sa )
+ ENDIF
+ ENDIF
+ CALL diffusion_s( i, j, ddzu, ddzw, kh, sa, saswsb, saswst, &
+ wall_salinityflux, tend )
+ ENDIF
+
+ CALL user_actions( i, j, 'sa-tendency' )
+
+!
+!-- Prognostic equation for salinity
+ DO k = nzb_s_inner(j,i)+1, nzt
+ sa_p(k,j,i) = sat * sa(k,j,i) + &
+ dt_3d * ( &
+ sbt * tend(k,j,i) + tsc(3) * tsa_m(k,j,i) &
+ ) - &
+ tsc(5) * rdf(k) * ( sa(k,j,i) - sa_init(k) )
+ IF ( sa_p(k,j,i) < 0.0 ) sa_p(k,j,i) = 0.1 * sa(k,j,i)
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tsa_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tsa_m(k,j,i) = -9.5625 * tend(k,j,i) + &
+ 5.3125 * tsa_m(k,j,i)
+ ENDDO
+ ENDIF
+ ENDIF
+
+!
+!-- Calculate density by the equation of state for seawater
+ CALL eqn_state_seawater( i, j )
+
+ ENDDO
+ ENDDO
+
+ CALL cpu_log( log_point(37), 'sa-equation', 'stop' )
+
+ ENDIF
+
+!
+!-- If required, compute prognostic equation for total water content / scalar
+ IF ( humidity .OR. passive_scalar ) THEN
+
+ CALL cpu_log( log_point(29), 'q/s-equation', 'start' )
+
+!
+!-- Scalar/q-tendency terms with communication
+ sat = tsc(1)
+ sbt = tsc(2)
+ IF ( scalar_advec == 'bc-scheme' ) THEN
+
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+!
+!-- Bott-Chlond scheme always uses Euler time step when leapfrog is
+!-- switched on. Thus:
+ sat = 1.0
+ sbt = 1.0
+ ENDIF
+ tend = 0.0
+ CALL advec_s_bc( q, 'q' )
+ ELSE
+ IF ( tsc(2) /= 2.0 ) THEN
+ IF ( scalar_advec == 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_s_ups( q, 'q' )
+ ENDIF
+ ENDIF
+ ENDIF
+
+!
+!-- Scalar/q-tendency terms with no communication
+ DO i = nxl, nxr
+ DO j = nys, nyn
+!
+!-- Tendency-terms
+ IF ( scalar_advec == 'bc-scheme' ) THEN
+ CALL diffusion_s( i, j, ddzu, ddzw, kh, q, qsws, qswst, &
+ wall_qflux, tend )
+ ELSE
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ tend(:,j,i) = 0.0
+ CALL advec_s_pw( i, j, q )
+ ELSE
+ IF ( scalar_advec /= 'ups-scheme' ) THEN
+ tend(:,j,i) = 0.0
+ CALL advec_s_up( i, j, q )
+ ENDIF
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' )&
+ THEN
+ CALL diffusion_s( i, j, ddzu, ddzw, kh_m, q_m, qsws_m, &
+ qswst_m, wall_qflux, tend )
+ ELSE
+ CALL diffusion_s( i, j, ddzu, ddzw, kh, q, qsws, qswst, &
+ wall_qflux, tend )
+ ENDIF
+ ENDIF
+
+!
+!-- If required compute decrease of total water content due to
+!-- precipitation
+ IF ( precipitation ) THEN
+ CALL calc_precipitation( i, j )
+ ENDIF
+ CALL user_actions( i, j, 'q-tendency' )
+
+!
+!-- Prognostic equation for total water content / scalar
+ DO k = nzb_s_inner(j,i)+1, nzt
+ q_p(k,j,i) = ( 1 - sat ) * q_m(k,j,i) + sat * q(k,j,i) + &
+ dt_3d * ( &
+ sbt * tend(k,j,i) + tsc(3) * tq_m(k,j,i) &
+ ) - &
+ tsc(5) * rdf(k) * ( q(k,j,i) - q_init(k) )
+ IF ( q_p(k,j,i) < 0.0 ) q_p(k,j,i) = 0.1 * q(k,j,i)
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tq_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tq_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tq_m(k,j,i)
+ ENDDO
+ ENDIF
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+ CALL cpu_log( log_point(29), 'q/s-equation', 'stop' )
+
+ ENDIF
+
+!
+!-- If required, compute prognostic equation for turbulent kinetic
+!-- energy (TKE)
+ IF ( .NOT. constant_diffusion ) THEN
+
+ CALL cpu_log( log_point(16), 'tke-equation', 'start' )
+
+!
+!-- TKE-tendency terms with communication
+ CALL production_e_init
+
+ sat = tsc(1)
+ sbt = tsc(2)
+ IF ( .NOT. use_upstream_for_tke ) THEN
+ IF ( scalar_advec == 'bc-scheme' ) THEN
+
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+!
+!-- Bott-Chlond scheme always uses Euler time step when leapfrog is
+!-- switched on. Thus:
+ sat = 1.0
+ sbt = 1.0
+ ENDIF
+ tend = 0.0
+ CALL advec_s_bc( e, 'e' )
+ ELSE
+ IF ( tsc(2) /= 2.0 ) THEN
+ IF ( scalar_advec == 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_s_ups( e, 'e' )
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDIF
+
+!
+!-- TKE-tendency terms with no communication
+ DO i = nxl, nxr
+ DO j = nys, nyn
+!
+!-- Tendency-terms
+ IF ( scalar_advec == 'bc-scheme' .AND. &
+ .NOT. use_upstream_for_tke ) THEN
+ IF ( .NOT. humidity ) THEN
+ IF ( ocean ) THEN
+ CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
+ l_grid, rho, prho_reference, rif, tend, &
+ zu, zw )
+ ELSE
+ CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
+ l_grid, pt, pt_reference, rif, tend, &
+ zu, zw )
+ ENDIF
+ ELSE
+ CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
+ l_grid, vpt, pt_reference, rif, tend, zu, &
+ zw )
+ ENDIF
+ ELSE
+ IF ( use_upstream_for_tke ) THEN
+ tend(:,j,i) = 0.0
+ CALL advec_s_up( i, j, e )
+ ELSE
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) &
+ THEN
+ tend(:,j,i) = 0.0
+ CALL advec_s_pw( i, j, e )
+ ELSE
+ IF ( scalar_advec /= 'ups-scheme' ) THEN
+ tend(:,j,i) = 0.0
+ CALL advec_s_up( i, j, e )
+ ENDIF
+ ENDIF
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' )&
+ THEN
+ IF ( .NOT. humidity ) THEN
+ CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, &
+ km_m, l_grid, pt_m, pt_reference, &
+ rif_m, tend, zu, zw )
+ ELSE
+ CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, &
+ km_m, l_grid, vpt_m, pt_reference, &
+ rif_m, tend, zu, zw )
+ ENDIF
+ ELSE
+ IF ( .NOT. humidity ) THEN
+ IF ( ocean ) THEN
+ CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, &
+ km, l_grid, rho, prho_reference, &
+ rif, tend, zu, zw )
+ ELSE
+ CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, &
+ km, l_grid, pt, pt_reference, rif, &
+ tend, zu, zw )
+ ENDIF
+ ELSE
+ CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
+ l_grid, vpt, pt_reference, rif, tend, &
+ zu, zw )
+ ENDIF
+ ENDIF
+ ENDIF
+ CALL production_e( i, j )
+
+!
+!-- Additional sink term for flows through plant canopies
+ IF ( plant_canopy ) CALL plant_canopy_model( i, j, 4 )
+
+ CALL user_actions( i, j, 'e-tendency' )
+
+!
+!-- Prognostic equation for TKE.
+!-- Eliminate negative TKE values, which can occur due to numerical
+!-- reasons in the course of the integration. In such cases the old TKE
+!-- value is reduced by 90%.
+ DO k = nzb_s_inner(j,i)+1, nzt
+ e_p(k,j,i) = ( 1 - sat ) * e_m(k,j,i) + sat * e(k,j,i) + &
+ dt_3d * ( &
+ sbt * tend(k,j,i) + tsc(3) * te_m(k,j,i) &
+ )
+ IF ( e_p(k,j,i) < 0.0 ) e_p(k,j,i) = 0.1 * e(k,j,i)
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ te_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ te_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * te_m(k,j,i)
+ ENDDO
+ ENDIF
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+ CALL cpu_log( log_point(16), 'tke-equation', 'stop' )
+
+ ENDIF
+
+
+ END SUBROUTINE prognostic_equations_noopt
+
+
+ SUBROUTINE prognostic_equations_cache
+
+!------------------------------------------------------------------------------!
+! Version with one optimized loop over all equations. It is only allowed to
+! be called for the standard Piascek-Williams advection scheme.
+!
+! Here the calls of most subroutines are embedded in two DO loops over i and j,
+! so communication between CPUs is not allowed (does not make sense) within
+! these loops.
+!
+! (Optimized to avoid cache missings, i.e. for Power4/5-architectures.)
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=9) :: time_to_string
+ INTEGER :: i, j, k
+
+
+!
+!-- Time measurement can only be performed for the whole set of equations
+ CALL cpu_log( log_point(32), 'all progn.equations', 'start' )
+
+
+!
+!-- Calculate those variables needed in the tendency terms which need
+!-- global communication
+ CALL calc_mean_profile( pt, 4 )
+ IF ( ocean ) CALL calc_mean_profile( rho, 64 )
+ IF ( humidity ) CALL calc_mean_profile( vpt, 44 )
+ IF ( .NOT. constant_diffusion ) CALL production_e_init
+
+
+!
+!-- Loop over all prognostic equations
+!$OMP PARALLEL private (i,j,k)
+!$OMP DO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+!
+!-- Tendency terms for u-velocity component
+ IF ( .NOT. outflow_l .OR. i > nxl ) THEN
+
+ tend(:,j,i) = 0.0
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ CALL advec_u_pw( i, j )
+ ELSE
+ CALL advec_u_up( i, j )
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) &
+ THEN
+ CALL diffusion_u( i, j, ddzu, ddzw, km_m, km_damp_y, tend, &
+ u_m, usws_m, uswst_m, v_m, w_m )
+ ELSE
+ CALL diffusion_u( i, j, ddzu, ddzw, km, km_damp_y, tend, u, &
+ usws, uswst, v, w )
+ ENDIF
+ CALL coriolis( i, j, 1 )
+ IF ( sloping_surface ) CALL buoyancy( i, j, pt, pt_reference, 1, &
+ 4 )
+
+!
+!-- Drag by plant canopy
+ IF ( plant_canopy ) CALL plant_canopy_model( i, j, 1 )
+
+ CALL user_actions( i, j, 'u-tendency' )
+
+!
+!-- Prognostic equation for u-velocity component
+ DO k = nzb_u_inner(j,i)+1, nzt
+ u_p(k,j,i) = ( 1.0-tsc(1) ) * u_m(k,j,i) + tsc(1) * u(k,j,i) + &
+ dt_3d * ( &
+ tsc(2) * tend(k,j,i) + tsc(3) * tu_m(k,j,i) &
+ - tsc(4) * ( p(k,j,i) - p(k,j,i-1) ) * ddx &
+ ) - &
+ tsc(5) * rdf(k) * ( u(k,j,i) - ug(k) )
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO k = nzb_u_inner(j,i)+1, nzt
+ tu_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO k = nzb_u_inner(j,i)+1, nzt
+ tu_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tu_m(k,j,i)
+ ENDDO
+ ENDIF
+ ENDIF
+
+ ENDIF
+
+!
+!-- Tendency terms for v-velocity component
+ IF ( .NOT. outflow_s .OR. j > nys ) THEN
+
+ tend(:,j,i) = 0.0
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ CALL advec_v_pw( i, j )
+ ELSE
+ CALL advec_v_up( i, j )
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) &
+ THEN
+ CALL diffusion_v( i, j, ddzu, ddzw, km_m, km_damp_x, tend, &
+ u_m, v_m, vsws_m, vswst_m, w_m )
+ ELSE
+ CALL diffusion_v( i, j, ddzu, ddzw, km, km_damp_x, tend, u, v, &
+ vsws, vswst, w )
+ ENDIF
+ CALL coriolis( i, j, 2 )
+
+!
+!-- Drag by plant canopy
+ IF ( plant_canopy ) CALL plant_canopy_model( i, j, 2 )
+
+ CALL user_actions( i, j, 'v-tendency' )
+
+!
+!-- Prognostic equation for v-velocity component
+ DO k = nzb_v_inner(j,i)+1, nzt
+ v_p(k,j,i) = ( 1.0-tsc(1) ) * v_m(k,j,i) + tsc(1) * v(k,j,i) + &
+ dt_3d * ( &
+ tsc(2) * tend(k,j,i) + tsc(3) * tv_m(k,j,i) &
+ - tsc(4) * ( p(k,j,i) - p(k,j-1,i) ) * ddy &
+ ) - &
+ tsc(5) * rdf(k) * ( v(k,j,i) - vg(k) )
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO k = nzb_v_inner(j,i)+1, nzt
+ tv_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO k = nzb_v_inner(j,i)+1, nzt
+ tv_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tv_m(k,j,i)
+ ENDDO
+ ENDIF
+ ENDIF
+
+ ENDIF
+
+!
+!-- Tendency terms for w-velocity component
+ tend(:,j,i) = 0.0
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ CALL advec_w_pw( i, j )
+ ELSE
+ CALL advec_w_up( i, j )
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) &
+ THEN
+ CALL diffusion_w( i, j, ddzu, ddzw, km_m, km_damp_x, &
+ km_damp_y, tend, u_m, v_m, w_m )
+ ELSE
+ CALL diffusion_w( i, j, ddzu, ddzw, km, km_damp_x, km_damp_y, &
+ tend, u, v, w )
+ ENDIF
+ CALL coriolis( i, j, 3 )
+ IF ( ocean ) THEN
+ CALL buoyancy( i, j, rho, prho_reference, 3, 64 )
+ ELSE
+ IF ( .NOT. humidity ) THEN
+ CALL buoyancy( i, j, pt, pt_reference, 3, 4 )
+ ELSE
+ CALL buoyancy( i, j, vpt, pt_reference, 3, 44 )
+ ENDIF
+ ENDIF
+
+!
+!-- Drag by plant canopy
+ IF ( plant_canopy ) CALL plant_canopy_model( i, j, 3 )
+
+ CALL user_actions( i, j, 'w-tendency' )
+
+!
+!-- Prognostic equation for w-velocity component
+ DO k = nzb_w_inner(j,i)+1, nzt-1
+ w_p(k,j,i) = ( 1.0-tsc(1) ) * w_m(k,j,i) + tsc(1) * w(k,j,i) + &
+ dt_3d * ( &
+ tsc(2) * tend(k,j,i) + tsc(3) * tw_m(k,j,i) &
+ - tsc(4) * ( p(k+1,j,i) - p(k,j,i) ) * ddzu(k+1) &
+ ) - &
+ tsc(5) * rdf(k) * w(k,j,i)
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO k = nzb_w_inner(j,i)+1, nzt-1
+ tw_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO k = nzb_w_inner(j,i)+1, nzt-1
+ tw_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tw_m(k,j,i)
+ ENDDO
+ ENDIF
+ ENDIF
+
+!
+!-- Tendency terms for potential temperature
+ tend(:,j,i) = 0.0
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ CALL advec_s_pw( i, j, pt )
+ ELSE
+ CALL advec_s_up( i, j, pt )
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) &
+ THEN
+ CALL diffusion_s( i, j, ddzu, ddzw, kh_m, pt_m, shf_m, &
+ tswst_m, wall_heatflux, tend )
+ ELSE
+ CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tswst, &
+ wall_heatflux, tend )
+ ENDIF
+
+!
+!-- If required compute heating/cooling due to long wave radiation
+!-- processes
+ IF ( radiation ) THEN
+ CALL calc_radiation( i, j )
+ ENDIF
+
+!
+!-- If required compute impact of latent heat due to precipitation
+ IF ( precipitation ) THEN
+ CALL impact_of_latent_heat( i, j )
+ ENDIF
+ CALL user_actions( i, j, 'pt-tendency' )
+
+!
+!-- Prognostic equation for potential temperature
+ DO k = nzb_s_inner(j,i)+1, nzt
+ pt_p(k,j,i) = ( 1.0-tsc(1) ) * pt_m(k,j,i) + tsc(1)*pt(k,j,i) +&
+ dt_3d * ( &
+ tsc(2) * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) &
+ ) - &
+ tsc(5) * rdf(k) * ( pt(k,j,i) - pt_init(k) )
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tpt_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tpt_m(k,j,i) = -9.5625 * tend(k,j,i) + &
+ 5.3125 * tpt_m(k,j,i)
+ ENDDO
+ ENDIF
+ ENDIF
+
+!
+!-- If required, compute prognostic equation for salinity
+ IF ( ocean ) THEN
+
+!
+!-- Tendency-terms for salinity
+ tend(:,j,i) = 0.0
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) &
+ THEN
+ CALL advec_s_pw( i, j, sa )
+ ELSE
+ CALL advec_s_up( i, j, sa )
+ ENDIF
+ CALL diffusion_s( i, j, ddzu, ddzw, kh, sa, saswsb, saswst, &
+ wall_salinityflux, tend )
+
+ CALL user_actions( i, j, 'sa-tendency' )
+
+!
+!-- Prognostic equation for salinity
+ DO k = nzb_s_inner(j,i)+1, nzt
+ sa_p(k,j,i) = tsc(1) * sa(k,j,i) + &
+ dt_3d * ( &
+ tsc(2) * tend(k,j,i) + tsc(3) * tsa_m(k,j,i) &
+ ) - &
+ tsc(5) * rdf(k) * ( sa(k,j,i) - sa_init(k) )
+ IF ( sa_p(k,j,i) < 0.0 ) sa_p(k,j,i) = 0.1 * sa(k,j,i)
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tsa_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tsa_m(k,j,i) = -9.5625 * tend(k,j,i) + &
+ 5.3125 * tsa_m(k,j,i)
+ ENDDO
+ ENDIF
+ ENDIF
+
+!
+!-- Calculate density by the equation of state for seawater
+ CALL eqn_state_seawater( i, j )
+
+ ENDIF
+
+!
+!-- If required, compute prognostic equation for total water content /
+!-- scalar
+ IF ( humidity .OR. passive_scalar ) THEN
+
+!
+!-- Tendency-terms for total water content / scalar
+ tend(:,j,i) = 0.0
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) &
+ THEN
+ CALL advec_s_pw( i, j, q )
+ ELSE
+ CALL advec_s_up( i, j, q )
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' )&
+ THEN
+ CALL diffusion_s( i, j, ddzu, ddzw, kh_m, q_m, qsws_m, &
+ qswst_m, wall_qflux, tend )
+ ELSE
+ CALL diffusion_s( i, j, ddzu, ddzw, kh, q, qsws, qswst, &
+ wall_qflux, tend )
+ ENDIF
+
+!
+!-- If required compute decrease of total water content due to
+!-- precipitation
+ IF ( precipitation ) THEN
+ CALL calc_precipitation( i, j )
+ ENDIF
+ CALL user_actions( i, j, 'q-tendency' )
+
+!
+!-- Prognostic equation for total water content / scalar
+ DO k = nzb_s_inner(j,i)+1, nzt
+ q_p(k,j,i) = ( 1.0-tsc(1) ) * q_m(k,j,i) + tsc(1)*q(k,j,i) +&
+ dt_3d * ( &
+ tsc(2) * tend(k,j,i) + tsc(3) * tq_m(k,j,i) &
+ ) - &
+ tsc(5) * rdf(k) * ( q(k,j,i) - q_init(k) )
+ IF ( q_p(k,j,i) < 0.0 ) q_p(k,j,i) = 0.1 * q(k,j,i)
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tq_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tq_m(k,j,i) = -9.5625 * tend(k,j,i) + &
+ 5.3125 * tq_m(k,j,i)
+ ENDDO
+ ENDIF
+ ENDIF
+
+ ENDIF
+
+!
+!-- If required, compute prognostic equation for turbulent kinetic
+!-- energy (TKE)
+ IF ( .NOT. constant_diffusion ) THEN
+
+!
+!-- Tendency-terms for TKE
+ tend(:,j,i) = 0.0
+ IF ( ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) &
+ .AND. .NOT. use_upstream_for_tke ) THEN
+ CALL advec_s_pw( i, j, e )
+ ELSE
+ CALL advec_s_up( i, j, e )
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' )&
+ THEN
+ IF ( .NOT. humidity ) THEN
+ CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, &
+ km_m, l_grid, pt_m, pt_reference, &
+ rif_m, tend, zu, zw )
+ ELSE
+ CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, &
+ km_m, l_grid, vpt_m, pt_reference, &
+ rif_m, tend, zu, zw )
+ ENDIF
+ ELSE
+ IF ( .NOT. humidity ) THEN
+ IF ( ocean ) THEN
+ CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, &
+ km, l_grid, rho, prho_reference, &
+ rif, tend, zu, zw )
+ ELSE
+ CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, &
+ km, l_grid, pt, pt_reference, rif, &
+ tend, zu, zw )
+ ENDIF
+ ELSE
+ CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, &
+ l_grid, vpt, pt_reference, rif, tend, &
+ zu, zw )
+ ENDIF
+ ENDIF
+ CALL production_e( i, j )
+
+!
+!-- Additional sink term for flows through plant canopies
+ IF ( plant_canopy ) CALL plant_canopy_model( i, j, 4 )
+
+ CALL user_actions( i, j, 'e-tendency' )
+
+!
+!-- Prognostic equation for TKE.
+!-- Eliminate negative TKE values, which can occur due to numerical
+!-- reasons in the course of the integration. In such cases the old
+!-- TKE value is reduced by 90%.
+ DO k = nzb_s_inner(j,i)+1, nzt
+ e_p(k,j,i) = ( 1.0-tsc(1) ) * e_m(k,j,i) + tsc(1)*e(k,j,i) +&
+ dt_3d * ( &
+ tsc(2) * tend(k,j,i) + tsc(3) * te_m(k,j,i) &
+ )
+ IF ( e_p(k,j,i) < 0.0 ) e_p(k,j,i) = 0.1 * e(k,j,i)
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ te_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO k = nzb_s_inner(j,i)+1, nzt
+ te_m(k,j,i) = -9.5625 * tend(k,j,i) + &
+ 5.3125 * te_m(k,j,i)
+ ENDDO
+ ENDIF
+ ENDIF
+
+ ENDIF ! TKE equation
+
+ ENDDO
+ ENDDO
+!$OMP END PARALLEL
+
+ CALL cpu_log( log_point(32), 'all progn.equations', 'stop' )
+
+
+ END SUBROUTINE prognostic_equations_cache
+
+
+ SUBROUTINE prognostic_equations_vector
+
+!------------------------------------------------------------------------------!
+! Version for vector machines
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=9) :: time_to_string
+ INTEGER :: i, j, k
+ REAL :: sat, sbt
+
+!
+!-- Calculate those variables needed in the tendency terms which need
+!-- global communication
+ CALL calc_mean_profile( pt, 4 )
+ IF ( ocean ) CALL calc_mean_profile( rho, 64 )
+ IF ( humidity ) CALL calc_mean_profile( vpt, 44 )
+
+!
+!-- u-velocity component
+ CALL cpu_log( log_point(5), 'u-equation', 'start' )
+
+!
+!-- u-tendency terms with communication
+ IF ( momentum_advec == 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_u_ups
+ ENDIF
+
+!
+!-- u-tendency terms with no communication
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ tend = 0.0
+ CALL advec_u_pw
+ ELSE
+ IF ( momentum_advec /= 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_u_up
+ ENDIF
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN
+ CALL diffusion_u( ddzu, ddzw, km_m, km_damp_y, tend, u_m, usws_m, &
+ uswst_m, v_m, w_m )
+ ELSE
+ CALL diffusion_u( ddzu, ddzw, km, km_damp_y, tend, u, usws, uswst, v, w )
+ ENDIF
+ CALL coriolis( 1 )
+ IF ( sloping_surface ) CALL buoyancy( pt, pt_reference, 1, 4 )
+
+!
+!-- Drag by plant canopy
+ IF ( plant_canopy ) CALL plant_canopy_model( 1 )
+
+ CALL user_actions( 'u-tendency' )
+
+!
+!-- Prognostic equation for u-velocity component
+ DO i = nxlu, nxr
+ DO j = nys, nyn
+ DO k = nzb_u_inner(j,i)+1, nzt
+ u_p(k,j,i) = ( 1.0-tsc(1) ) * u_m(k,j,i) + tsc(1) * u(k,j,i) + &
+ dt_3d * ( &
+ tsc(2) * tend(k,j,i) + tsc(3) * tu_m(k,j,i) &
+ - tsc(4) * ( p(k,j,i) - p(k,j,i-1) ) * ddx &
+ ) - &
+ tsc(5) * rdf(k) * ( u(k,j,i) - ug(k) )
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO i = nxlu, nxr
+ DO j = nys, nyn
+ DO k = nzb_u_inner(j,i)+1, nzt
+ tu_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO i = nxlu, nxr
+ DO j = nys, nyn
+ DO k = nzb_u_inner(j,i)+1, nzt
+ tu_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tu_m(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+
+ CALL cpu_log( log_point(5), 'u-equation', 'stop' )
+
+!
+!-- v-velocity component
+ CALL cpu_log( log_point(6), 'v-equation', 'start' )
+
+!
+!-- v-tendency terms with communication
+ IF ( momentum_advec == 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_v_ups
+ ENDIF
+
+!
+!-- v-tendency terms with no communication
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ tend = 0.0
+ CALL advec_v_pw
+ ELSE
+ IF ( momentum_advec /= 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_v_up
+ ENDIF
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN
+ CALL diffusion_v( ddzu, ddzw, km_m, km_damp_x, tend, u_m, v_m, vsws_m, &
+ vswst_m, w_m )
+ ELSE
+ CALL diffusion_v( ddzu, ddzw, km, km_damp_x, tend, u, v, vsws, vswst, w )
+ ENDIF
+ CALL coriolis( 2 )
+
+!
+!-- Drag by plant canopy
+ IF ( plant_canopy ) CALL plant_canopy_model( 2 )
+ CALL user_actions( 'v-tendency' )
+
+!
+!-- Prognostic equation for v-velocity component
+ DO i = nxl, nxr
+ DO j = nysv, nyn
+ DO k = nzb_v_inner(j,i)+1, nzt
+ v_p(k,j,i) = ( 1.0-tsc(1) ) * v_m(k,j,i) + tsc(1) * v(k,j,i) + &
+ dt_3d * ( &
+ tsc(2) * tend(k,j,i) + tsc(3) * tv_m(k,j,i) &
+ - tsc(4) * ( p(k,j,i) - p(k,j-1,i) ) * ddy &
+ ) - &
+ tsc(5) * rdf(k) * ( v(k,j,i) - vg(k) )
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO i = nxl, nxr
+ DO j = nysv, nyn
+ DO k = nzb_v_inner(j,i)+1, nzt
+ tv_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO i = nxl, nxr
+ DO j = nysv, nyn
+ DO k = nzb_v_inner(j,i)+1, nzt
+ tv_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tv_m(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+
+ CALL cpu_log( log_point(6), 'v-equation', 'stop' )
+
+!
+!-- w-velocity component
+ CALL cpu_log( log_point(7), 'w-equation', 'start' )
+
+!
+!-- w-tendency terms with communication
+ IF ( momentum_advec == 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_w_ups
+ ENDIF
+
+!
+!-- w-tendency terms with no communication
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ tend = 0.0
+ CALL advec_w_pw
+ ELSE
+ IF ( momentum_advec /= 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_w_up
+ ENDIF
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN
+ CALL diffusion_w( ddzu, ddzw, km_m, km_damp_x, km_damp_y, tend, u_m, &
+ v_m, w_m )
+ ELSE
+ CALL diffusion_w( ddzu, ddzw, km, km_damp_x, km_damp_y, tend, u, v, w )
+ ENDIF
+ CALL coriolis( 3 )
+ IF ( ocean ) THEN
+ CALL buoyancy( rho, prho_reference, 3, 64 )
+ ELSE
+ IF ( .NOT. humidity ) THEN
+ CALL buoyancy( pt, pt_reference, 3, 4 )
+ ELSE
+ CALL buoyancy( vpt, pt_reference, 3, 44 )
+ ENDIF
+ ENDIF
+
+!
+!-- Drag by plant canopy
+ IF ( plant_canopy ) CALL plant_canopy_model( 3 )
+
+ CALL user_actions( 'w-tendency' )
+
+!
+!-- Prognostic equation for w-velocity component
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_w_inner(j,i)+1, nzt-1
+ w_p(k,j,i) = ( 1-tsc(1) ) * w_m(k,j,i) + tsc(1) * w(k,j,i) + &
+ dt_3d * ( &
+ tsc(2) * tend(k,j,i) + tsc(3) * tw_m(k,j,i) &
+ - tsc(4) * ( p(k+1,j,i) - p(k,j,i) ) * ddzu(k+1) &
+ ) - &
+ tsc(5) * rdf(k) * w(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_w_inner(j,i)+1, nzt-1
+ tw_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_w_inner(j,i)+1, nzt-1
+ tw_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tw_m(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+
+ CALL cpu_log( log_point(7), 'w-equation', 'stop' )
+
+!
+!-- potential temperature
+ CALL cpu_log( log_point(13), 'pt-equation', 'start' )
+
+!
+!-- pt-tendency terms with communication
+ sat = tsc(1)
+ sbt = tsc(2)
+ IF ( scalar_advec == 'bc-scheme' ) THEN
+
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+!
+!-- Bott-Chlond scheme always uses Euler time step when leapfrog is
+!-- switched on. Thus:
+ sat = 1.0
+ sbt = 1.0
+ ENDIF
+ tend = 0.0
+ CALL advec_s_bc( pt, 'pt' )
+ ELSE
+ IF ( tsc(2) /= 2.0 .AND. scalar_advec == 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_s_ups( pt, 'pt' )
+ ENDIF
+ ENDIF
+
+!
+!-- pt-tendency terms with no communication
+ IF ( scalar_advec == 'bc-scheme' ) THEN
+ CALL diffusion_s( ddzu, ddzw, kh, pt, shf, tswst, wall_heatflux, &
+ tend )
+ ELSE
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ tend = 0.0
+ CALL advec_s_pw( pt )
+ ELSE
+ IF ( scalar_advec /= 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_s_up( pt )
+ ENDIF
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN
+ CALL diffusion_s( ddzu, ddzw, kh_m, pt_m, shf_m, tswst_m, &
+ wall_heatflux, tend )
+ ELSE
+ CALL diffusion_s( ddzu, ddzw, kh, pt, shf, tswst, wall_heatflux, &
+ tend )
+ ENDIF
+ ENDIF
+
+!
+!-- If required compute heating/cooling due to long wave radiation
+!-- processes
+ IF ( radiation ) THEN
+ CALL calc_radiation
+ ENDIF
+
+!
+!-- If required compute impact of latent heat due to precipitation
+ IF ( precipitation ) THEN
+ CALL impact_of_latent_heat
+ ENDIF
+ CALL user_actions( 'pt-tendency' )
+
+!
+!-- Prognostic equation for potential temperature
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ pt_p(k,j,i) = ( 1 - sat ) * pt_m(k,j,i) + sat * pt(k,j,i) + &
+ dt_3d * ( &
+ sbt * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) &
+ ) - &
+ tsc(5) * rdf(k) * ( pt(k,j,i) - pt_init(k) )
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tpt_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tpt_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tpt_m(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+
+ CALL cpu_log( log_point(13), 'pt-equation', 'stop' )
+
+!
+!-- If required, compute prognostic equation for salinity
+ IF ( ocean ) THEN
+
+ CALL cpu_log( log_point(37), 'sa-equation', 'start' )
+
+!
+!-- sa-tendency terms with communication
+ sat = tsc(1)
+ sbt = tsc(2)
+ IF ( scalar_advec == 'bc-scheme' ) THEN
+
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+!
+!-- Bott-Chlond scheme always uses Euler time step when leapfrog is
+!-- switched on. Thus:
+ sat = 1.0
+ sbt = 1.0
+ ENDIF
+ tend = 0.0
+ CALL advec_s_bc( sa, 'sa' )
+ ELSE
+ IF ( tsc(2) /= 2.0 ) THEN
+ IF ( scalar_advec == 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_s_ups( sa, 'sa' )
+ ENDIF
+ ENDIF
+ ENDIF
+
+!
+!-- sa-tendency terms with no communication
+ IF ( scalar_advec == 'bc-scheme' ) THEN
+ CALL diffusion_s( ddzu, ddzw, kh, sa, saswsb, saswst, &
+ wall_salinityflux, tend )
+ ELSE
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ tend = 0.0
+ CALL advec_s_pw( sa )
+ ELSE
+ IF ( scalar_advec /= 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_s_up( sa )
+ ENDIF
+ ENDIF
+ CALL diffusion_s( ddzu, ddzw, kh, sa, saswsb, saswst, &
+ wall_salinityflux, tend )
+ ENDIF
+
+ CALL user_actions( 'sa-tendency' )
+
+!
+!-- Prognostic equation for salinity
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ sa_p(k,j,i) = sat * sa(k,j,i) + &
+ dt_3d * ( &
+ sbt * tend(k,j,i) + tsc(3) * tsa_m(k,j,i) &
+ ) - &
+ tsc(5) * rdf(k) * ( sa(k,j,i) - sa_init(k) )
+ IF ( sa_p(k,j,i) < 0.0 ) sa_p(k,j,i) = 0.1 * sa(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tsa_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tsa_m(k,j,i) = -9.5625 * tend(k,j,i) + &
+ 5.3125 * tsa_m(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+
+ CALL cpu_log( log_point(37), 'sa-equation', 'stop' )
+
+!
+!-- Calculate density by the equation of state for seawater
+ CALL cpu_log( log_point(38), 'eqns-seawater', 'start' )
+ CALL eqn_state_seawater
+ CALL cpu_log( log_point(38), 'eqns-seawater', 'stop' )
+
+ ENDIF
+
+!
+!-- If required, compute prognostic equation for total water content / scalar
+ IF ( humidity .OR. passive_scalar ) THEN
+
+ CALL cpu_log( log_point(29), 'q/s-equation', 'start' )
+
+!
+!-- Scalar/q-tendency terms with communication
+ sat = tsc(1)
+ sbt = tsc(2)
+ IF ( scalar_advec == 'bc-scheme' ) THEN
+
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+!
+!-- Bott-Chlond scheme always uses Euler time step when leapfrog is
+!-- switched on. Thus:
+ sat = 1.0
+ sbt = 1.0
+ ENDIF
+ tend = 0.0
+ CALL advec_s_bc( q, 'q' )
+ ELSE
+ IF ( tsc(2) /= 2.0 ) THEN
+ IF ( scalar_advec == 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_s_ups( q, 'q' )
+ ENDIF
+ ENDIF
+ ENDIF
+
+!
+!-- Scalar/q-tendency terms with no communication
+ IF ( scalar_advec == 'bc-scheme' ) THEN
+ CALL diffusion_s( ddzu, ddzw, kh, q, qsws, qswst, wall_qflux, tend )
+ ELSE
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ tend = 0.0
+ CALL advec_s_pw( q )
+ ELSE
+ IF ( scalar_advec /= 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_s_up( q )
+ ENDIF
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN
+ CALL diffusion_s( ddzu, ddzw, kh_m, q_m, qsws_m, qswst_m, &
+ wall_qflux, tend )
+ ELSE
+ CALL diffusion_s( ddzu, ddzw, kh, q, qsws, qswst, &
+ wall_qflux, tend )
+ ENDIF
+ ENDIF
+
+!
+!-- If required compute decrease of total water content due to
+!-- precipitation
+ IF ( precipitation ) THEN
+ CALL calc_precipitation
+ ENDIF
+ CALL user_actions( 'q-tendency' )
+
+!
+!-- Prognostic equation for total water content / scalar
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ q_p(k,j,i) = ( 1 - sat ) * q_m(k,j,i) + sat * q(k,j,i) + &
+ dt_3d * ( &
+ sbt * tend(k,j,i) + tsc(3) * tq_m(k,j,i) &
+ ) - &
+ tsc(5) * rdf(k) * ( q(k,j,i) - q_init(k) )
+ IF ( q_p(k,j,i) < 0.0 ) q_p(k,j,i) = 0.1 * q(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tq_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ tq_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tq_m(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+
+ CALL cpu_log( log_point(29), 'q/s-equation', 'stop' )
+
+ ENDIF
+
+!
+!-- If required, compute prognostic equation for turbulent kinetic
+!-- energy (TKE)
+ IF ( .NOT. constant_diffusion ) THEN
+
+ CALL cpu_log( log_point(16), 'tke-equation', 'start' )
+
+!
+!-- TKE-tendency terms with communication
+ CALL production_e_init
+
+ sat = tsc(1)
+ sbt = tsc(2)
+ IF ( .NOT. use_upstream_for_tke ) THEN
+ IF ( scalar_advec == 'bc-scheme' ) THEN
+
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+!
+!-- Bott-Chlond scheme always uses Euler time step when leapfrog is
+!-- switched on. Thus:
+ sat = 1.0
+ sbt = 1.0
+ ENDIF
+ tend = 0.0
+ CALL advec_s_bc( e, 'e' )
+ ELSE
+ IF ( tsc(2) /= 2.0 ) THEN
+ IF ( scalar_advec == 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_s_ups( e, 'e' )
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDIF
+
+!
+!-- TKE-tendency terms with no communication
+ IF ( scalar_advec == 'bc-scheme' .AND. .NOT. use_upstream_for_tke ) &
+ THEN
+ IF ( .NOT. humidity ) THEN
+ IF ( ocean ) THEN
+ CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, rho, &
+ prho_reference, rif, tend, zu, zw )
+ ELSE
+ CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, pt, &
+ pt_reference, rif, tend, zu, zw )
+ ENDIF
+ ELSE
+ CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, vpt, &
+ pt_reference, rif, tend, zu, zw )
+ ENDIF
+ ELSE
+ IF ( use_upstream_for_tke ) THEN
+ tend = 0.0
+ CALL advec_s_up( e )
+ ELSE
+ IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN
+ tend = 0.0
+ CALL advec_s_pw( e )
+ ELSE
+ IF ( scalar_advec /= 'ups-scheme' ) THEN
+ tend = 0.0
+ CALL advec_s_up( e )
+ ENDIF
+ ENDIF
+ ENDIF
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN
+ IF ( .NOT. humidity ) THEN
+ CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e_m, km_m, l_grid, &
+ pt_m, pt_reference, rif_m, tend, zu, zw )
+ ELSE
+ CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e_m, km_m, l_grid, &
+ vpt_m, pt_reference, rif_m, tend, zu, zw )
+ ENDIF
+ ELSE
+ IF ( .NOT. humidity ) THEN
+ IF ( ocean ) THEN
+ CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, &
+ rho, prho_reference, rif, tend, zu, zw )
+ ELSE
+ CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, &
+ pt, pt_reference, rif, tend, zu, zw )
+ ENDIF
+ ELSE
+ CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, vpt, &
+ pt_reference, rif, tend, zu, zw )
+ ENDIF
+ ENDIF
+ ENDIF
+ CALL production_e
+
+!
+!-- Additional sink term for flows through plant canopies
+ IF ( plant_canopy ) CALL plant_canopy_model( 4 )
+ CALL user_actions( 'e-tendency' )
+
+!
+!-- Prognostic equation for TKE.
+!-- Eliminate negative TKE values, which can occur due to numerical
+!-- reasons in the course of the integration. In such cases the old TKE
+!-- value is reduced by 90%.
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ e_p(k,j,i) = ( 1 - sat ) * e_m(k,j,i) + sat * e(k,j,i) + &
+ dt_3d * ( &
+ sbt * tend(k,j,i) + tsc(3) * te_m(k,j,i) &
+ )
+ IF ( e_p(k,j,i) < 0.0 ) e_p(k,j,i) = 0.1 * e(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Calculate tendencies for the next Runge-Kutta step
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ te_m(k,j,i) = tend(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSEIF ( intermediate_timestep_count < &
+ intermediate_timestep_count_max ) THEN
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb_s_inner(j,i)+1, nzt
+ te_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * te_m(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+
+ CALL cpu_log( log_point(16), 'tke-equation', 'stop' )
+
+ ENDIF
+
+
+ END SUBROUTINE prognostic_equations_vector
+
+
+ END MODULE prognostic_equations_mod
Index: /palm/tags/release-3.4a/SOURCE/random_function.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/random_function.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/random_function.f90 (revision 141)
@@ -0,0 +1,87 @@
+ MODULE random_function_mod
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.3 2003/10/29 09:06:57 raasch
+! Former function changed to a module.
+!
+! Revision 1.1 1998/02/04 16:09:45 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Random number generator, produces numbers equally distributed in interval [0,1]
+! This routine is taken from the "numerical recipies"
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC random_function, random_function_ini
+
+ INTEGER, PUBLIC, SAVE :: random_iv(32), random_iy
+
+ INTERFACE random_function_ini
+ MODULE PROCEDURE random_function_ini
+ END INTERFACE random_function_ini
+
+ INTERFACE random_function
+ MODULE PROCEDURE random_function
+ END INTERFACE random_function
+
+ CONTAINS
+
+ SUBROUTINE random_function_ini
+
+ IMPLICIT NONE
+
+ random_iv = 0
+ random_iy = 0
+
+ END SUBROUTINE random_function_ini
+
+ FUNCTION random_function( idum )
+
+
+ IMPLICIT NONE
+
+ INTEGER :: ia, idum, im, iq, ir, ndiv, ntab
+ REAL :: am, eps, random_function, ranf, rnmx
+
+ PARAMETER ( ia=16807, im=2147483647, am=1.0/im, iq=127773, ir=2836, &
+ ntab=32, ndiv=1+(im-1)/ntab, eps=1.2e-7, rnmx=1.0-eps )
+
+ INTEGER :: j, k
+
+
+ IF ( idum .le. 0 .or. random_iy .eq. 0 ) THEN
+ idum = max (-idum,1)
+ DO j = ntab+8,1,-1
+ k = idum / iq
+ idum = ia * ( idum - k * iq ) - ir * k
+ IF ( idum .lt. 0 ) idum = idum + im
+ IF ( j .le. ntab ) random_iv(j) = idum
+ ENDDO
+ random_iy = random_iv(1)
+ ENDIF
+
+ k = idum / iq
+ idum = ia * ( idum - k * iq ) - ir * k
+ IF ( idum .lt. 0 ) idum = idum + im
+ j = 1 + random_iy / ndiv
+ random_iy = random_iv(j)
+ random_iv(j) = idum
+ random_function = min ( am * random_iy , rnmx )
+
+ END FUNCTION random_function
+
+ END MODULE random_function_mod
Index: /palm/tags/release-3.4a/SOURCE/random_gauss.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/random_gauss.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/random_gauss.f90 (revision 141)
@@ -0,0 +1,62 @@
+ FUNCTION random_gauss( idum, upper_limit )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.4 2006/08/04 15:01:48 raasch
+! Range of random number is limited by an upper limit (new second parameter)
+!
+! Revision 1.1 1998/03/25 20:09:47 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Generates a gaussian distributed random number (mean value 1, sigma = 1)
+! This routine is taken from the "numerical recipies".
+!------------------------------------------------------------------------------!
+
+ USE random_function_mod
+
+ IMPLICIT NONE
+
+ INTEGER :: idum, iset
+ REAL :: fac, gset, random_gauss, rsq, upper_limit, v1, v2
+
+ SAVE iset, gset
+
+ DATA iset /0/
+
+!
+!-- Random numbers are created as long as they do not fall below the given
+!-- upper limit
+ DO
+
+ IF ( iset == 0 ) THEN
+ rsq = 0.0
+ DO WHILE ( rsq >= 1.0 .OR. rsq == 0.0 )
+ v1 = 2.0 * random_function( idum ) - 1.0
+ v2 = 2.0 * random_function( idum ) - 1.0
+ rsq = v1**2 + v2**2
+ ENDDO
+ fac = SQRT( -2.0 * LOG( rsq ) / rsq )
+ gset = v1 * fac
+ random_gauss = v2 * fac + 1.0
+ iset = 1
+ ELSE
+ random_gauss = gset + 1.0
+ iset = 0
+ ENDIF
+
+ IF ( ABS( random_gauss - 1.0 ) <= upper_limit ) EXIT
+
+ ENDDO
+
+ END FUNCTION random_gauss
Index: /palm/tags/release-3.4a/SOURCE/read_3d_binary.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/read_3d_binary.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/read_3d_binary.f90 (revision 141)
@@ -0,0 +1,574 @@
+ SUBROUTINE read_3d_binary
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 102 2007-07-27 09:09:17Z raasch
+! +uswst, uswst_m, vswst, vswst_m
+!
+! 96 2007-06-04 08:07:41Z raasch
+! +rho_av, sa, sa_av, saswsb, saswst
+!
+! 73 2007-03-20 08:33:14Z raasch
+! +precipitation_amount, precipitation_rate_av, rif_wall, u_m_l, u_m_r, etc.,
+! z0_av
+!
+! 19 2007-02-23 04:53:48Z raasch
+! +qswst, qswst_m, tswst, tswst_m
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.4 2006/08/04 15:02:32 raasch
+! +iran, iran_part
+!
+! Revision 1.1 2004/04/30 12:47:27 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Binary input of variables and arrays from restart file
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE averaging
+ USE cloud_parameters
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE particle_attributes
+ USE pegrid
+ USE profil_parameter
+ USE random_function_mod
+ USE statistics
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=10) :: binary_version, version_on_file
+ CHARACTER (LEN=20) :: field_chr
+ CHARACTER (LEN=10), DIMENSION(:), ALLOCATABLE :: chdum10
+ CHARACTER (LEN=40), DIMENSION(:), ALLOCATABLE :: chdum40
+ CHARACTER (LEN=100), DIMENSION(:), ALLOCATABLE :: chdum100
+
+ INTEGER :: idum1, myid_on_file, numprocs_on_file, nxl_on_file, &
+ nxr_on_file, nyn_on_file, nys_on_file, nzb_on_file, nzt_on_file
+
+ INTEGER, DIMENSION(:), ALLOCATABLE :: idum
+
+ REAL, DIMENSION(:), ALLOCATABLE :: rdum
+
+!
+!-- Read data from previous model run. unit 13 already opened in parin
+ CALL cpu_log( log_point_s(14), 'read_3d_binary', 'start' )
+
+!
+!-- First compare the version numbers
+ READ ( 13 ) version_on_file
+ binary_version = '3.0'
+ IF ( TRIM( version_on_file ) /= TRIM( binary_version ) ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ init_3d_model: version mismatch concerning data ', &
+ 'from prior run'
+ PRINT*, ' version on file = "', TRIM( version_on_file ),&
+ '"'
+ PRINT*, ' version in program = "', TRIM( binary_version ), &
+ '"'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Read and compare number of processors, processor-id and array ranges
+ READ ( 13 ) numprocs_on_file, myid_on_file, nxl_on_file, nxr_on_file, &
+ nys_on_file, nyn_on_file, nzb_on_file, nzt_on_file
+
+ IF ( numprocs_on_file /= numprocs ) THEN
+ PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+ PRINT*, ' from prior run on PE ', myid
+ PRINT*, ' numprocs on file = ', numprocs_on_file
+ PRINT*, ' numprocs = ', numprocs
+ CALL local_stop
+ ENDIF
+
+ IF ( myid_on_file /= myid ) THEN
+ PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+ PRINT*, ' from prior run'
+ PRINT*, ' myid_on_file = ', myid_on_file
+ PRINT*, ' myid = ', myid
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ CALL local_stop
+#endif
+ ENDIF
+
+ IF ( nxl_on_file /= nxl ) THEN
+ PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+ PRINT*, ' from prior run on PE ', myid
+ PRINT*, ' nxl on file = ', nxl_on_file
+ PRINT*, ' nxl = ', nxl
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ CALL local_stop
+#endif
+ ENDIF
+
+ IF ( nxr_on_file /= nxr ) THEN
+ PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+ PRINT*, ' from prior run on PE ', myid
+ PRINT*, ' nxr on file = ', nxr_on_file
+ PRINT*, ' nxr = ', nxr
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ CALL local_stop
+#endif
+ ENDIF
+
+ IF ( nys_on_file /= nys ) THEN
+ PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+ PRINT*, ' from prior run on PE ', myid
+ PRINT*, ' nys on file = ', nys_on_file
+ PRINT*, ' nys = ', nys
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ CALL local_stop
+#endif
+ ENDIF
+
+ IF ( nyn_on_file /= nyn ) THEN
+ PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+ PRINT*, ' from prior run on PE ', myid
+ PRINT*, ' nyn on file = ', nyn_on_file
+ PRINT*, ' nyn = ', nyn
+#if defined( __parallel )
+ CALL MPI_ABORT( comm2d, 9999, ierr )
+#else
+ CALL local_stop
+#endif
+ ENDIF
+
+ IF ( nzb_on_file /= nzb ) THEN
+ PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+ PRINT*, ' from prior run on PE ', myid
+ PRINT*, ' nzb on file = ', nzb_on_file
+ PRINT*, ' nzb = ', nzb
+ CALL local_stop
+ ENDIF
+
+ IF ( nzt_on_file /= nzt ) THEN
+ PRINT*, '+++ init_3d_model: mismatch between actual data and data '
+ PRINT*, ' from prior run on PE ', myid
+ PRINT*, ' nzt on file = ', nzt_on_file
+ PRINT*, ' nzt = ', nzt
+ CALL local_stop
+ ENDIF
+
+!
+!-- Local arrays that may be required for possible temporary information
+!-- storage in the following
+ ALLOCATE( chdum10(crmax), chdum40(crmax), chdum100(crmax), &
+ idum(100*crmax), rdum(100*crmax) )
+
+!
+!-- Initialize spectra (for the case of just starting spectra computation
+!-- in continuation runs)
+ IF ( dt_dosp /= 9999999.9 ) THEN
+ spectrum_x = 0.0
+ spectrum_y = 0.0
+ ENDIF
+
+!
+!-- Read arrays
+!-- ATTENTION: If the following read commands have been altered, the
+!-- ---------- version number of the variable binary_version must be altered,
+!-- too. Furthermore, the output list of arrays in write_3d_binary
+!-- must also be altered accordingly.
+ READ ( 13 ) field_chr
+ DO WHILE ( TRIM( field_chr ) /= '*** end ***' )
+
+ SELECT CASE ( TRIM( field_chr ) )
+
+ CASE ( 'e' )
+ READ ( 13 ) e
+ CASE ( 'e_av' )
+ ALLOCATE( e_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) e_av
+ CASE ( 'e_m' )
+ READ ( 13 ) e_m
+ CASE ( 'iran' )
+ READ ( 13 ) iran, iran_part
+ CASE ( 'kh' )
+ READ ( 13 ) kh
+ CASE ( 'kh_m' )
+ READ ( 13 ) kh_m
+ CASE ( 'km' )
+ READ ( 13 ) km
+ CASE ( 'km_m' )
+ READ ( 13 ) km_m
+ CASE ( 'lwp_av' )
+ ALLOCATE( lwp_av(nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) lwp_av
+ CASE ( 'p' )
+ READ ( 13 ) p
+ CASE ( 'p_av' )
+ ALLOCATE( p_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) p_av
+ CASE ( 'pc_av' )
+ ALLOCATE( pc_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) pc_av
+ CASE ( 'pr_av' )
+ ALLOCATE( pr_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) pr_av
+ CASE ( 'precipitation_amount' )
+ READ ( 13 ) precipitation_amount
+ CASE ( 'precipitation_rate_a' )
+ ALLOCATE( precipitation_rate_av(nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) precipitation_rate_av
+ CASE ( 'pt' )
+ READ ( 13 ) pt
+ CASE ( 'pt_av' )
+ ALLOCATE( pt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) pt_av
+ CASE ( 'pt_m' )
+ READ ( 13 ) pt_m
+ CASE ( 'q' )
+ READ ( 13 ) q
+ CASE ( 'q_av' )
+ ALLOCATE( q_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) q_av
+ CASE ( 'q_m' )
+ READ ( 13 ) q_m
+ CASE ( 'ql' )
+ READ ( 13 ) ql
+ CASE ( 'ql_av' )
+ ALLOCATE( ql_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) ql_av
+ CASE ( 'ql_c_av' )
+ ALLOCATE( ql_c_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) ql_c_av
+ CASE ( 'ql_v_av' )
+ ALLOCATE( ql_v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) ql_v_av
+ CASE ( 'ql_vp_av' )
+ ALLOCATE( ql_vp_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) ql_vp_av
+ CASE ( 'qs' )
+ READ ( 13 ) qs
+ CASE ( 'qsws' )
+ READ ( 13 ) qsws
+ CASE ( 'qsws_m' )
+ READ ( 13 ) qsws_m
+ CASE ( 'qswst' )
+ READ ( 13 ) qswst
+ CASE ( 'qswst_m' )
+ READ ( 13 ) qswst_m
+ CASE ( 'qv_av' )
+ ALLOCATE( qv_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) qv_av
+ CASE ( 'random_iv' )
+ READ ( 13 ) random_iv
+ READ ( 13 ) random_iy
+ CASE ( 'rho_av' )
+ ALLOCATE( rho_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) rho_av
+ CASE ( 'rif' )
+ READ ( 13 ) rif
+ CASE ( 'rif_m' )
+ READ ( 13 ) rif_m
+ CASE ( 'rif_wall' )
+ READ ( 13 ) rif_wall
+ CASE ( 's_av' )
+ ALLOCATE( s_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) s_av
+ CASE ( 'sa' )
+ READ ( 13 ) sa
+ CASE ( 'sa_av' )
+ ALLOCATE( sa_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) sa_av
+ CASE ( 'saswsb' )
+ READ ( 13 ) saswsb
+ CASE ( 'saswst' )
+ READ ( 13 ) saswst
+ CASE ( 'shf' )
+ READ ( 13 ) shf
+ CASE ( 'shf_m' )
+ READ ( 13 ) shf_m
+ CASE ( 'tswst' )
+ READ ( 13 ) tswst
+ CASE ( 'tswst_m' )
+ READ ( 13 ) tswst_m
+ CASE ( 'spectrum_x' )
+ READ ( 13 ) spectrum_x
+ CASE ( 'spectrum_y' )
+ READ ( 13 ) spectrum_y
+ CASE ( 'ts' )
+ READ ( 13 ) ts
+ CASE ( 'ts_av' )
+ ALLOCATE( ts_av(nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) ts_av
+ CASE ( 'u' )
+ READ ( 13 ) u
+ CASE ( 'u_av' )
+ ALLOCATE( u_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) u_av
+ CASE ( 'u_m' )
+ READ ( 13 ) u_m
+ CASE ( 'u_m_l' )
+ READ ( 13 ) u_m_l
+ CASE ( 'u_m_n' )
+ READ ( 13 ) u_m_n
+ CASE ( 'u_m_r' )
+ READ ( 13 ) u_m_r
+ CASE ( 'u_m_s' )
+ READ ( 13 ) u_m_s
+ CASE ( 'us' )
+ READ ( 13 ) us
+ CASE ( 'usws' )
+ READ ( 13 ) usws
+ CASE ( 'uswst' )
+ READ ( 13 ) uswst
+ CASE ( 'usws_m' )
+ READ ( 13 ) usws_m
+ CASE ( 'uswst_m' )
+ READ ( 13 ) uswst_m
+ CASE ( 'us_av' )
+ ALLOCATE( us_av(nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) us_av
+ CASE ( 'v' )
+ READ ( 13 ) v
+ CASE ( 'volume_flow_area' )
+ READ ( 13 ) volume_flow_area
+ CASE ( 'volume_flow_initial' )
+ READ ( 13 ) volume_flow_initial
+ CASE ( 'v_av' )
+ ALLOCATE( v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) v_av
+ CASE ( 'v_m' )
+ READ (13 ) v_m
+ CASE ( 'v_m_l' )
+ READ ( 13 ) v_m_l
+ CASE ( 'v_m_n' )
+ READ ( 13 ) v_m_n
+ CASE ( 'v_m_r' )
+ READ ( 13 ) v_m_r
+ CASE ( 'v_m_s' )
+ READ ( 13 ) v_m_s
+ CASE ( 'vpt' )
+ READ ( 13 ) vpt
+ CASE ( 'vpt_av' )
+ ALLOCATE( vpt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) vpt_av
+ CASE ( 'vpt_m' )
+ READ ( 13 ) vpt_m
+ CASE ( 'vsws' )
+ READ ( 13 ) vsws
+ CASE ( 'vswst' )
+ READ ( 13 ) vswst
+ CASE ( 'vsws_m' )
+ READ ( 13 ) vsws_m
+ CASE ( 'vswst_m' )
+ READ ( 13 ) vswst_m
+ CASE ( 'w' )
+ READ ( 13 ) w
+ CASE ( 'w_av' )
+ ALLOCATE( w_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) w_av
+ CASE ( 'w_m' )
+ READ ( 13 ) w_m
+ CASE ( 'w_m_l' )
+ READ ( 13 ) w_m_l
+ CASE ( 'w_m_n' )
+ READ ( 13 ) w_m_n
+ CASE ( 'w_m_r' )
+ READ ( 13 ) w_m_r
+ CASE ( 'w_m_s' )
+ READ ( 13 ) w_m_s
+ CASE ( 'z0' )
+ READ ( 13 ) z0
+ CASE ( 'z0_av' )
+ ALLOCATE( z0_av(nys-1:nyn+1,nxl-1:nxr+1) )
+ READ ( 13 ) z0_av
+
+ CASE ( 'cross_linecolors' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_linecolors
+ ELSE
+ READ ( 13 ) idum
+ ENDIF
+ CASE ( 'cross_linestyles' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_linestyles
+ ELSE
+ READ ( 13 ) idum
+ ENDIF
+ CASE ( 'cross_normalized_x' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_normalized_x
+ ELSE
+ READ ( 13 ) chdum10
+ ENDIF
+ CASE ( 'cross_normalized_y' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_normalized_y
+ ELSE
+ READ ( 13 ) chdum10
+ ENDIF
+ CASE ( 'cross_normx_factor' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_normx_factor
+ ELSE
+ READ ( 13 ) rdum
+ ENDIF
+ CASE ( 'cross_normy_factor' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_normy_factor
+ ELSE
+ READ ( 13 ) rdum
+ ENDIF
+ CASE ( 'cross_profiles' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_profiles
+ ELSE
+ READ ( 13 ) chdum100
+ ENDIF
+ CASE ( 'cross_profile_n_coun' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_profile_number_count
+ ELSE
+ READ ( 13 ) idum(1:crmax)
+ ENDIF
+ CASE ( 'cross_profile_number' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_profile_numbers
+ ELSE
+ READ ( 13 ) idum
+ ENDIF
+ CASE ( 'cross_uxmax' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_uxmax
+ ELSE
+ READ ( 13 ) rdum(1:crmax)
+ ENDIF
+ CASE ( 'cross_uxmax_computed' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_uxmax_computed
+ ELSE
+ READ ( 13 ) rdum(1:crmax)
+ ENDIF
+ CASE ( 'cross_uxmax_normaliz' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_uxmax_normalized
+ ELSE
+ READ ( 13 ) rdum(1:crmax)
+ ENDIF
+ CASE ( 'cross_uxmax_norm_com' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_uxmax_normalized_computed
+ ELSE
+ READ ( 13 ) rdum(1:crmax)
+ ENDIF
+ CASE ( 'cross_uxmin' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_uxmin
+ ELSE
+ READ ( 13 ) rdum(1:crmax)
+ ENDIF
+ CASE ( 'cross_uxmin_computed' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_uxmin_computed
+ ELSE
+ READ ( 13 ) rdum(1:crmax)
+ ENDIF
+ CASE ( 'cross_uxmin_normaliz' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_uxmin_normalized
+ ELSE
+ READ ( 13 ) rdum(1:crmax)
+ ENDIF
+ CASE ( 'cross_uxmin_norm_com' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_uxmin_normalized_computed
+ ELSE
+ READ ( 13 ) rdum(1:crmax)
+ ENDIF
+ CASE ( 'cross_uymax' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_uymax
+ ELSE
+ READ ( 13 ) rdum(1:crmax)
+ ENDIF
+ CASE ( 'cross_uymin' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_uymin
+ ELSE
+ READ ( 13 ) rdum(1:crmax)
+ ENDIF
+ CASE ( 'cross_xtext' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) cross_xtext
+ ELSE
+ READ ( 13 ) chdum40
+ ENDIF
+ CASE ( 'dopr_crossindex' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) dopr_crossindex
+ ELSE
+ READ ( 13 ) idum(1:100)
+ ENDIF
+ CASE ( 'dopr_time_count' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) dopr_time_count
+ ELSE
+ READ ( 13 ) idum1
+ ENDIF
+ CASE ( 'hom_sum' )
+ READ ( 13 ) hom_sum
+ CASE ( 'profile_columns' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) profile_columns
+ ELSE
+ READ ( 13 ) idum1
+ ENDIF
+ CASE ( 'profile_number' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) profile_number
+ ELSE
+ READ ( 13 ) idum1
+ ENDIF
+ CASE ( 'profile_rows' )
+ IF ( use_prior_plot1d_parameters ) THEN
+ READ ( 13 ) profile_rows
+ ELSE
+ READ ( 13 ) idum1
+ ENDIF
+
+ CASE DEFAULT
+ PRINT*, '+++ init_3d_model: unknown field named "', &
+ TRIM( field_chr ), '" found in'
+ PRINT*, ' data from prior run on PE ', myid
+ CALL local_stop
+
+ END SELECT
+!
+!-- Read next character string
+ READ ( 13 ) field_chr
+
+ ENDDO
+
+ DEALLOCATE( chdum10, chdum40, chdum100, idum, rdum )
+
+!
+!-- End of time measuring for reading binary data
+ CALL cpu_log( log_point_s(14), 'read_3d_binary', 'stop' )
+
+ END SUBROUTINE read_3d_binary
Index: /palm/tags/release-3.4a/SOURCE/read_var_list.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/read_var_list.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/read_var_list.f90 (revision 141)
@@ -0,0 +1,510 @@
+ SUBROUTINE read_var_list
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 138 2007-11-28 10:03:58Z letzel
+! +canopy_mode, drag_coefficient, lad, lad_surface, lad_vertical_gradient,
+! lad_vertical_gradient_level, lad_vertical_gradient_level_ind, pch_index,
+! plant_canopy, time_sort_particles
+!
+! 102 2007-07-27 09:09:17Z raasch
+! +time_coupling, top_momentumflux_u|v
+!
+! 95 2007-06-02 16:48:38Z raasch
+! +bc_sa_t, ocean, sa_init, sa_surface, sa_vertical_gradient,
+! sa_vertical_gradient_level, bottom/top_salinity_flux
+!
+! 87 2007-05-22 15:46:47Z raasch
+! +max_pr_user (version 3.1), var_hom renamed pr_palm
+!
+! 75 2007-03-22 09:54:05Z raasch
+! +loop_optimization, pt_reference, moisture renamed humidity
+!
+! 20 2007-02-26 00:12:32Z raasch
+! +top_heatflux, use_top_fluxes
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.34 2006/08/22 14:14:27 raasch
+! +dz_max
+!
+! Revision 1.1 1998/03/18 20:18:48 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Reading values of control variables from restart-file (binary format)
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE averaging
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE model_1d
+ USE particle_attributes
+ USE pegrid
+ USE profil_parameter
+ USE statistics
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=10) :: binary_version, version_on_file
+ CHARACTER (LEN=30) :: variable_chr
+
+ INTEGER :: max_pr_user_on_file
+
+ CALL check_open( 13 )
+
+!
+!-- Make version number check first
+ READ ( 13 ) version_on_file
+ binary_version = '3.1'
+ IF ( TRIM( version_on_file ) /= TRIM( binary_version ) ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ read_var_list: version mismatch concerning control', &
+ ' variables'
+ PRINT*, ' version on file = "', &
+ TRIM( version_on_file ), '"'
+ PRINT*, ' version on program = "', &
+ TRIM( binary_version ), '"'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+!
+!-- Read vertical number of gridpoints and number of different areas used
+!-- for computing statistics. Allocate arrays depending on these values,
+!-- which are needed for the following read instructions.
+ READ ( 13 ) variable_chr
+ IF ( TRIM( variable_chr ) /= 'nz' ) THEN
+ PRINT*, '+++ read_var_list: nz not found in data from prior run on PE ',&
+ myid
+ CALL local_stop
+ ENDIF
+ READ ( 13 ) nz
+
+ READ ( 13 ) variable_chr
+ IF ( TRIM( variable_chr ) /= 'max_pr_user' ) THEN
+ PRINT*, '+++ read_var_list: max_pr_user not found in data from ', &
+ 'prior run on PE ', myid
+ CALL local_stop
+ ENDIF
+ READ ( 13 ) max_pr_user_on_file
+ IF ( max_pr_user_on_file /= max_pr_user ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ read_var_list: version mismatch concerning maximum', &
+ ' number of user profiles'
+ PRINT*, ' max_pr_user on file = "', &
+ max_pr_user_on_file, '"'
+ PRINT*, ' max_pr_user from run = "', &
+ max_pr_user, '"'
+ ENDIF
+ CALL local_stop
+ ENDIF
+
+ READ ( 13 ) variable_chr
+ IF ( TRIM( variable_chr ) /= 'statistic_regions' ) THEN
+ PRINT*, '+++ read_var_list: statistic_regions not found in data from ', &
+ 'prior run on PE ', myid
+ CALL local_stop
+ ENDIF
+ READ ( 13 ) statistic_regions
+ ALLOCATE( ug(0:nz+1), u_init(0:nz+1), vg(0:nz+1), v_init(0:nz+1), &
+ pt_init(0:nz+1), q_init(0:nz+1), sa_init(0:nz+1), &
+ hom(0:nz+1,2,pr_palm+max_pr_user,0:statistic_regions) )
+
+!
+!-- Now read all control parameters:
+!-- Caution: When the following read instructions have been changed, the
+!-- ------- version number stored in the variable binary_version has to be
+!-- increased. The same changes must also be done in write_var_list.
+ READ ( 13 ) variable_chr
+ DO WHILE ( TRIM( variable_chr ) /= '*** end ***' )
+
+ SELECT CASE ( TRIM( variable_chr ) )
+
+ CASE ( 'adjust_mixing_length' )
+ READ ( 13 ) adjust_mixing_length
+ CASE ( 'advected_distance_x' )
+ READ ( 13 ) advected_distance_x
+ CASE ( 'advected_distance_y' )
+ READ ( 13 ) advected_distance_y
+ CASE ( 'alpha_surface' )
+ READ ( 13 ) alpha_surface
+ CASE ( 'average_count_pr' )
+ READ ( 13 ) average_count_pr
+ CASE ( 'average_count_sp' )
+ READ ( 13 ) average_count_sp
+ CASE ( 'average_count_3d' )
+ READ ( 13 ) average_count_3d
+ CASE ( 'bc_e_b' )
+ READ ( 13 ) bc_e_b
+ CASE ( 'bc_lr' )
+ READ ( 13 ) bc_lr
+ CASE ( 'bc_ns' )
+ READ ( 13 ) bc_ns
+ CASE ( 'bc_p_b' )
+ READ ( 13 ) bc_p_b
+ CASE ( 'bc_p_t' )
+ READ ( 13 ) bc_p_t
+ CASE ( 'bc_pt_b' )
+ READ ( 13 ) bc_pt_b
+ CASE ( 'bc_pt_t' )
+ READ ( 13 ) bc_pt_t
+ CASE ( 'bc_pt_t_val' )
+ READ ( 13 ) bc_pt_t_val
+ CASE ( 'bc_q_b' )
+ READ ( 13 ) bc_q_b
+ CASE ( 'bc_q_t' )
+ READ ( 13 ) bc_q_t
+ CASE ( 'bc_q_t_val' )
+ READ ( 13 ) bc_q_t_val
+ CASE ( 'bc_s_b' )
+ READ ( 13 ) bc_s_b
+ CASE ( 'bc_s_t' )
+ READ ( 13 ) bc_s_t
+ CASE ( 'bc_sa_t' )
+ READ ( 13 ) bc_sa_t
+ CASE ( 'bc_uv_b' )
+ READ ( 13 ) bc_uv_b
+ CASE ( 'bc_uv_t' )
+ READ ( 13 ) bc_uv_t
+ CASE ( 'bottom_salinityflux' )
+ READ ( 13 ) bottom_salinityflux
+ CASE ( 'building_height' )
+ READ ( 13 ) building_height
+ CASE ( 'building_length_x' )
+ READ ( 13 ) building_length_x
+ CASE ( 'building_length_y' )
+ READ ( 13 ) building_length_y
+ CASE ( 'building_wall_left' )
+ READ ( 13 ) building_wall_left
+ CASE ( 'building_wall_south' )
+ READ ( 13 ) building_wall_south
+ CASE ( 'canopy_mode' )
+ READ ( 13 ) canopy_mode
+ CASE ( 'cloud_droplets' )
+ READ ( 13 ) cloud_droplets
+ CASE ( 'cloud_physics' )
+ READ ( 13 ) cloud_physics
+ CASE ( 'conserve_volume_flow' )
+ READ ( 13 ) conserve_volume_flow
+ CASE ( 'current_timestep_number' )
+ READ ( 13 ) current_timestep_number
+ CASE ( 'cut_spline_overshoot' )
+ READ ( 13 ) cut_spline_overshoot
+ CASE ( 'damp_level_1d' )
+ READ ( 13 ) damp_level_1d
+ CASE ( 'dissipation_1d' )
+ READ ( 13 ) dissipation_1d
+ CASE ( 'drag_coefficient' )
+ READ ( 13 ) drag_coefficient
+ CASE ( 'dt_fixed' )
+ READ ( 13 ) dt_fixed
+ CASE ( 'dt_pr_1d' )
+ READ ( 13 ) dt_pr_1d
+ CASE ( 'dt_run_control_1d' )
+ READ ( 13 ) dt_run_control_1d
+ CASE ( 'dt_3d' )
+ READ ( 13 ) dt_3d
+ CASE ( 'dvrp_filecount' )
+ READ ( 13 ) dvrp_filecount
+ CASE ( 'dx' )
+ READ ( 13 ) dx
+ CASE ( 'dy' )
+ READ ( 13 ) dy
+ CASE ( 'dz' )
+ READ ( 13 ) dz
+ CASE ( 'dz_max' )
+ READ ( 13 ) dz_max
+ CASE ( 'dz_stretch_factor' )
+ READ ( 13 ) dz_stretch_factor
+ CASE ( 'dz_stretch_level' )
+ READ ( 13 ) dz_stretch_level
+ CASE ( 'e_min' )
+ READ ( 13 ) e_min
+ CASE ( 'end_time_1d' )
+ READ ( 13 ) end_time_1d
+ CASE ( 'fft_method' )
+ READ ( 13 ) fft_method
+ CASE ( 'first_call_advec_particles' )
+ READ ( 13 ) first_call_advec_particles
+ CASE ( 'galilei_transformation' )
+ READ ( 13 ) galilei_transformation
+ CASE ( 'grid_matching' )
+ READ ( 13 ) grid_matching
+ CASE ( 'hom' )
+ READ ( 13 ) hom
+ CASE ( 'inflow_disturbance_begin' )
+ READ ( 13 ) inflow_disturbance_begin
+ CASE ( 'inflow_disturbance_end' )
+ READ ( 13 ) inflow_disturbance_end
+ CASE ( 'km_constant' )
+ READ ( 13 ) km_constant
+ CASE ( 'km_damp_max' )
+ READ ( 13 ) km_damp_max
+ CASE ( 'lad' )
+ READ ( 13 ) lad
+ CASE ( 'lad_surface' )
+ READ ( 13 ) lad_surface
+ CASE ( 'lad_vertical_gradient' )
+ READ ( 13 ) lad_vertical_gradient
+ CASE ( 'lad_vertical_gradient_level' )
+ READ ( 13 ) lad_vertical_gradient_level
+ CASE ( 'lad_vertical_gradient_level_in' )
+ READ ( 13 ) lad_vertical_gradient_level_ind
+ CASE ( 'last_dt_change' )
+ READ ( 13 ) last_dt_change
+ CASE ( 'long_filter_factor' )
+ READ ( 13 ) long_filter_factor
+ CASE ( 'loop_optimization' )
+ READ ( 13 ) loop_optimization
+ CASE ( 'mixing_length_1d' )
+ READ ( 13 ) mixing_length_1d
+ CASE ( 'humidity' )
+ READ ( 13 ) humidity
+ CASE ( 'momentum_advec' )
+ READ ( 13 ) momentum_advec
+ CASE ( 'netcdf_precision' )
+ READ ( 13 ) netcdf_precision
+ CASE ( 'npex' )
+ READ ( 13 ) npex
+ CASE ( 'npey' )
+ READ ( 13 ) npey
+ CASE ( 'nsor_ini' )
+ READ ( 13 ) nsor_ini
+ CASE ( 'nx' )
+ READ ( 13 ) nx
+ CASE ( 'ny' )
+ READ ( 13 ) ny
+ CASE ( 'ocean' )
+ READ ( 13 ) ocean
+ CASE ( 'old_dt' )
+ READ ( 13 ) old_dt
+ CASE ( 'omega' )
+ READ ( 13 ) omega
+ CASE ( 'outflow_damping_width' )
+ READ ( 13 ) outflow_damping_width
+ CASE ( 'overshoot_limit_e' )
+ READ ( 13 ) overshoot_limit_e
+ CASE ( 'overshoot_limit_pt' )
+ READ ( 13 ) overshoot_limit_pt
+ CASE ( 'overshoot_limit_u' )
+ READ ( 13 ) overshoot_limit_u
+ CASE ( 'overshoot_limit_v' )
+ READ ( 13 ) overshoot_limit_v
+ CASE ( 'overshoot_limit_w' )
+ READ ( 13 ) overshoot_limit_w
+ CASE ( 'passive_scalar' )
+ READ ( 13 ) passive_scalar
+ CASE ( 'pch_index' )
+ READ ( 13 ) pch_index
+ CASE ( 'phi' )
+ READ ( 13 ) phi
+ CASE ( 'plant_canopy' )
+ READ ( 13 ) plant_canopy
+ CASE ( 'prandtl_layer' )
+ READ ( 13 ) prandtl_layer
+ CASE ( 'precipitation' )
+ READ ( 13 ) precipitation
+ CASE ( 'pt_init' )
+ READ ( 13 ) pt_init
+ CASE ( 'pt_reference' )
+ READ ( 13 ) pt_reference
+ CASE ( 'pt_surface' )
+ READ ( 13 ) pt_surface
+ CASE ( 'pt_surface_initial_change' )
+ READ ( 13 ) pt_surface_initial_change
+ CASE ( 'pt_vertical_gradient' )
+ READ ( 13 ) pt_vertical_gradient
+ CASE ( 'pt_vertical_gradient_level' )
+ READ ( 13 ) pt_vertical_gradient_level
+ CASE ( 'pt_vertical_gradient_level_ind' )
+ READ ( 13 ) pt_vertical_gradient_level_ind
+ CASE ( 'q_init' )
+ READ ( 13 ) q_init
+ CASE ( 'q_surface' )
+ READ ( 13 ) q_surface
+ CASE ( 'q_surface_initial_change' )
+ READ ( 13 ) q_surface_initial_change
+ CASE ( 'q_vertical_gradient' )
+ READ ( 13 ) q_vertical_gradient
+ CASE ( 'q_vertical_gradient_level' )
+ READ ( 13 ) q_vertical_gradient_level
+ CASE ( 'q_vertical_gradient_level_ind' )
+ READ ( 13 ) q_vertical_gradient_level_ind
+ CASE ( 'radiation' )
+ READ ( 13 ) radiation
+ CASE ( 'random_generator' )
+ READ ( 13 ) random_generator
+ CASE ( 'random_heatflux' )
+ READ ( 13 ) random_heatflux
+ CASE ( 'rif_max' )
+ READ ( 13 ) rif_max
+ CASE ( 'rif_min' )
+ READ ( 13 ) rif_min
+ CASE ( 'roughness_length' )
+ READ ( 13 ) roughness_length
+ CASE ( 'runnr' )
+ READ ( 13 ) runnr
+ CASE ( 'sa_init' )
+ READ ( 13 ) sa_init
+ CASE ( 'sa_surface' )
+ READ ( 13 ) sa_surface
+ CASE ( 'sa_vertical_gradient' )
+ READ ( 13 ) sa_vertical_gradient
+ CASE ( 'sa_vertical_gradient_level' )
+ READ ( 13 ) sa_vertical_gradient_level
+ CASE ( 'scalar_advec' )
+ READ ( 13 ) scalar_advec
+ CASE ( 'simulated_time' )
+ READ ( 13 ) simulated_time
+ CASE ( 'surface_heatflux' )
+ READ ( 13 ) surface_heatflux
+ CASE ( 'surface_pressure' )
+ READ ( 13 ) surface_pressure
+ CASE ( 'surface_scalarflux' )
+ READ ( 13 ) surface_scalarflux
+ CASE ( 'surface_waterflux' )
+ READ ( 13 ) surface_waterflux
+ CASE ( 's_surface' )
+ READ ( 13 ) s_surface
+ CASE ( 's_surface_initial_change' )
+ READ ( 13 ) s_surface_initial_change
+ CASE ( 's_vertical_gradient' )
+ READ ( 13 ) s_vertical_gradient
+ CASE ( 's_vertical_gradient_level' )
+ READ ( 13 ) s_vertical_gradient_level
+ CASE ( 'time_coupling' )
+ READ ( 13 ) time_coupling
+ CASE ( 'time_disturb' )
+ READ ( 13 ) time_disturb
+ CASE ( 'time_dopr' )
+ READ ( 13 ) time_dopr
+ CASE ( 'time_dopr_av' )
+ READ ( 13 ) time_dopr_av
+ CASE ( 'time_dopr_listing' )
+ READ ( 13 ) time_dopr_listing
+ CASE ( 'time_dopts' )
+ READ ( 13 ) time_dopts
+ CASE ( 'time_dosp' )
+ READ ( 13 ) time_dosp
+ CASE ( 'time_dots' )
+ READ ( 13 ) time_dots
+ CASE ( 'time_do2d_xy' )
+ READ ( 13 ) time_do2d_xy
+ CASE ( 'time_do2d_xz' )
+ READ ( 13 ) time_do2d_xz
+ CASE ( 'time_do2d_yz' )
+ READ ( 13 ) time_do2d_yz
+ CASE ( 'time_do3d' )
+ READ ( 13 ) time_do3d
+ CASE ( 'time_do_av' )
+ READ ( 13 ) time_do_av
+ CASE ( 'time_do_sla' )
+ READ ( 13 ) time_do_sla
+ CASE ( 'time_dvrp' )
+ READ ( 13 ) time_dvrp
+ CASE ( 'time_restart' )
+ READ ( 13 ) time_restart
+ CASE ( 'time_run_control' )
+ READ ( 13 ) time_run_control
+ CASE ( 'time_sort_particles' )
+ READ ( 13 ) time_sort_particles
+ CASE ( 'timestep_scheme' )
+ READ ( 13 ) timestep_scheme
+ CASE ( 'topography' )
+ READ ( 13 ) topography
+ CASE ( 'top_heatflux' )
+ READ ( 13 ) top_heatflux
+ CASE ( 'top_momentumflux_u' )
+ READ ( 13 ) top_momentumflux_u
+ CASE ( 'top_momentumflux_v' )
+ READ ( 13 ) top_momentumflux_v
+ CASE ( 'top_salinityflux' )
+ READ ( 13 ) top_salinityflux
+ CASE ( 'tsc' )
+ READ ( 13 ) tsc
+ CASE ( 'u_init' )
+ READ ( 13 ) u_init
+ CASE ( 'u_max' )
+ READ ( 13 ) u_max
+ CASE ( 'u_max_ijk' )
+ READ ( 13 ) u_max_ijk
+ CASE ( 'ug' )
+ READ ( 13 ) ug
+ CASE ( 'ug_surface' )
+ READ ( 13 ) ug_surface
+ CASE ( 'ug_vertical_gradient' )
+ READ ( 13 ) ug_vertical_gradient
+ CASE ( 'ug_vertical_gradient_level' )
+ READ ( 13 ) ug_vertical_gradient_level
+ CASE ( 'ug_vertical_gradient_level_ind' )
+ READ ( 13 ) ug_vertical_gradient_level_ind
+ CASE ( 'ups_limit_e' )
+ READ ( 13 ) ups_limit_e
+ CASE ( 'ups_limit_pt' )
+ READ ( 13 ) ups_limit_pt
+ CASE ( 'ups_limit_u' )
+ READ ( 13 ) ups_limit_u
+ CASE ( 'ups_limit_v' )
+ READ ( 13 ) ups_limit_v
+ CASE ( 'ups_limit_w' )
+ READ ( 13 ) ups_limit_w
+ CASE ( 'use_surface_fluxes' )
+ READ ( 13 ) use_surface_fluxes
+ CASE ( 'use_top_fluxes' )
+ READ ( 13 ) use_top_fluxes
+ CASE ( 'use_ug_for_galilei_tr' )
+ READ ( 13 ) use_ug_for_galilei_tr
+ CASE ( 'use_upstream_for_tke' )
+ READ ( 13 ) use_upstream_for_tke
+ CASE ( 'v_init' )
+ READ ( 13 ) v_init
+ CASE ( 'v_max' )
+ READ ( 13 ) v_max
+ CASE ( 'v_max_ijk' )
+ READ ( 13 ) v_max_ijk
+ CASE ( 'vg' )
+ READ ( 13 ) vg
+ CASE ( 'vg_surface' )
+ READ ( 13 ) vg_surface
+ CASE ( 'vg_vertical_gradient' )
+ READ ( 13 ) vg_vertical_gradient
+ CASE ( 'vg_vertical_gradient_level' )
+ READ ( 13 ) vg_vertical_gradient_level
+ CASE ( 'vg_vertical_gradient_level_ind' )
+ READ ( 13 ) vg_vertical_gradient_level_ind
+ CASE ( 'wall_adjustment' )
+ READ ( 13 ) wall_adjustment
+ CASE ( 'w_max' )
+ READ ( 13 ) w_max
+ CASE ( 'w_max_ijk' )
+ READ ( 13 ) w_max_ijk
+ CASE ( 'time-series-quantities' )
+ READ ( 13 ) cross_ts_uymax, cross_ts_uymax_computed, &
+ cross_ts_uymin, cross_ts_uymin_computed
+
+ CASE DEFAULT
+ PRINT*, '+++ read_var_list: unknown variable named "', &
+ TRIM( variable_chr ), '" found in'
+ PRINT*, ' data from prior run on PE ', myid
+ CALL local_stop
+ END SELECT
+!
+!-- Read next string
+ READ ( 13 ) variable_chr
+
+ ENDDO
+
+
+ END SUBROUTINE read_var_list
Index: /palm/tags/release-3.4a/SOURCE/run_control.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/run_control.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/run_control.f90 (revision 141)
@@ -0,0 +1,130 @@
+ SUBROUTINE run_control
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 97 2007-06-21 08:23:15Z raasch
+! Timestep and z_i format changed
+!
+! 87 2007-05-22 15:46:47Z raasch
+! var_hom renamed pr_palm
+!
+! 82 2007-04-16 15:40:52Z raasch
+! Preprocessor strings for different linux clusters changed to "lc",
+! routine local_flush is used for buffer flushing
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.20 2006/06/02 15:23:47 raasch
+! cpp-directives extended for lctit
+!
+! Revision 1.1 1997/08/11 06:25:38 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Computation and output of run-control quantities
+!------------------------------------------------------------------------------!
+
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE statistics
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=1) :: change_chr, disturb_chr
+
+!
+!-- If required, do statistics
+ IF ( .NOT. flow_statistics_called ) CALL flow_statistics
+
+!
+!-- Flow_statistics has its own cpu-time measurement
+ CALL cpu_log( log_point(11), 'run_control', 'start' )
+
+!
+!-- Output
+ IF ( myid == 0 ) THEN
+
+!
+!-- Check, whether file unit is already open (may have been opened in header
+!-- before)
+ CALL check_open( 15 )
+
+!
+!-- If required, write header
+ IF ( .NOT. run_control_header ) THEN
+ WRITE ( 15, 100 )
+ run_control_header = .TRUE.
+ ENDIF
+
+!
+!-- Output the the beginning of the run receives no information about an
+!-- Euler-timestep
+ IF ( dt_changed .AND. simulated_time /= 0.0 .AND. &
+ timestep_scheme(1:5) /= 'runge' ) THEN
+ IF ( timestep_scheme == 'leapfrog' ) THEN
+ change_chr = 'L'
+ ELSE
+ change_chr = 'E'
+ ENDIF
+ ELSE
+ change_chr = ' '
+ ENDIF
+!
+!-- If required, set disturbance flag
+ IF ( disturbance_created ) THEN
+ disturb_chr = 'D'
+ ELSE
+ disturb_chr = ' '
+ ENDIF
+ WRITE ( 15, 101 ) runnr, current_timestep_number, simulated_time_chr, &
+ simulated_time-INT( simulated_time ), dt_3d, &
+ timestep_reason, change_chr, u_max, disturb_chr, &
+ v_max, disturb_chr, w_max, hom(nzb,1,pr_palm,0), &
+ hom(nzb+8,1,pr_palm,0), hom(nzb+3,1,pr_palm,0), &
+ hom(nzb+6,1,pr_palm,0), hom(nzb+4,1,pr_palm,0), &
+ hom(nzb+5,1,pr_palm,0), hom(nzb+9,1,pr_palm,0), &
+ hom(nzb+10,1,pr_palm,0), u_max_ijk(1:3), &
+ v_max_ijk(1:3), w_max_ijk(1:3), &
+ advected_distance_x/1000.0, &
+ advected_distance_y/1000.0, mgcycles
+!
+!-- Write buffer contents to disc immediately
+ CALL local_flush( 15 )
+
+ ENDIF
+!
+!-- If required, reset disturbance flag. This has to be done outside the above
+!-- IF-loop, because the flag would otherwise only be reset on PE0
+ IF ( disturbance_created ) disturbance_created = .FALSE.
+
+ CALL cpu_log( log_point(11), 'run_control', 'stop' )
+
+!
+!-- Formats
+100 FORMAT (///'Run-control output:'/ &
+ &'------------------'// &
+ &'RUN ITER. HH:MM:SS.SS DT(E) UMAX VMAX WMAX U', &
+ &'* W* THETA* Z_I ENERG. DISTENERG DIVOLD DIV', &
+ &'NEW UMAX(KJI) VMAX(KJI) WMAX(KJI) ADVECX ADVECY ', &
+ &'MGCYC'/ &
+ &'----------------------------------------------------------------', &
+ &'----------------------------------------------------------------', &
+ &'----------------------------------------------------------------', &
+ &'-----')
+101 FORMAT (I3,1X,I6,1X,A8,F3.2,1X,F8.4,A1,A1,F8.4,A1,F8.4,A1,F8.4,2X,F5.3,2X, &
+ F4.2, &
+ 2X,F6.3,2X,F6.0,1X,4(E10.3,1X),3(3(I4),1X),F8.3,1X,F8.3,5X,I3)
+
+ END SUBROUTINE run_control
Index: /palm/tags/release-3.4a/SOURCE/singleton.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/singleton.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/singleton.f90 (revision 141)
@@ -0,0 +1,1125 @@
+ MODULE singleton
+
+!-----------------------------------------------------------------------------
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.2 2004/04/30 12:52:09 raasch
+! Shape of arrays is explicitly stored in ishape and handled to the
+! fft-routines instead of the shape-function (due to a compiler error on
+! decalpha)
+!
+! Revision 1.1 2002/05/02 18:56:59 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Multivariate Fast Fourier Transform
+!
+! Fortran 90 Implementation of Singleton's mixed-radix algorithm,
+! RC Singleton, Stanford Research Institute, Sept. 1968.
+!
+! Adapted from fftn.c, translated from Fortran 66 to C by Mark Olesen and
+! John Beale.
+!
+! Fourier transforms can be computed either in place, using assumed size
+! arguments, or by generic function, using assumed shape arguments.
+!
+!
+! Public:
+!
+! fftkind kind parameter of complex arguments
+! and function results.
+!
+! fft(array, dim, inv, stat) generic transform function
+! COMPLEX(fftkind), DIMENSION(:,...,:), INTENT(IN) :: array
+! INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL:: dim
+! LOGICAL, INTENT(IN), OPTIONAL:: inv
+! INTEGER, INTENT(OUT), OPTIONAL:: stat
+!
+! fftn(array, shape, dim, inv, stat) in place transform subroutine
+! COMPLEX(fftkind), DIMENSION(*), INTENT(INOUT) :: array
+! INTEGER, DIMENSION(:), INTENT(IN) :: shape
+! INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL:: dim
+! LOGICAL, INTENT(IN), OPTIONAL:: inv
+! INTEGER, INTENT(OUT), OPTIONAL:: stat
+!
+!
+! Formal Parameters:
+!
+! array The complex array to be transformed. array can be of arbitrary
+! rank (i.e. up to seven).
+!
+! shape With subroutine fftn, the shape of the array to be transformed
+! has to be passed separately, since fftradix - the internal trans-
+! formation routine - will treat array always as one dimensional.
+! The product of elements in shape must be the number of
+! elements in array.
+! Although passing array with assumed shape would have been nicer,
+! I prefered assumed size in order to prevent the compiler from
+! using a copy-in-copy-out mechanism. That would generally be
+! necessary with fftn passing array to fftradix and with fftn
+! being prepared for accepting non consecutive array sections.
+! Using assumed size, it's up to the user to pass an array argu-
+! ment, that can be addressed as continous one dimensional array
+! without copying. Otherwise, transformation will not really be
+! performed in place.
+! On the other hand, since the rank of array and the size of
+! shape needn't match, fftn is appropriate for handling more than
+! seven dimensions.
+! As far as function fft is concerned all this doesn't matter,
+! because the argument will be copied anyway. Thus no extra
+! shape argument is needed for fft.
+!
+! Optional Parameters:
+!
+! dim One dimensional integer array, containing the dimensions to be
+! transformed. Default is (/1,...,N/) with N being the rank of
+! array, i.e. complete transform. dim can restrict transformation
+! to a subset of available dimensions. Its size must not exceed the
+! rank of array or the size of shape respectivly.
+!
+! inv If .true., inverse transformation will be performed. Default is
+! .false., i.e. forward transformation.
+!
+! stat If present, a system dependent nonzero status value will be
+! returned in stat, if allocation of temporary storage failed.
+!
+!
+! Scaling:
+!
+! Transformation results will always be scaled by the square root of the
+! product of sizes of each dimension in dim. (See examples below)
+!
+!
+! Examples:
+!
+! Let A be a L*M*N three dimensional complex array. Then
+!
+! result = fft(A)
+!
+! will produce a three dimensional transform, scaled by sqrt(L*M*N), while
+!
+! call fftn(A, SHAPE(A))
+!
+! will do the same in place.
+!
+! result = fft(A, dim=(/1,3/))
+!
+! will transform with respect to the first and the third dimension, scaled
+! by sqrt(L*N).
+!
+! result = fft(fft(A), inv=.true.)
+!
+! should (approximately) reproduce A.
+! With B having the same shape as A
+!
+! result = fft(fft(A) * CONJG(fft(B)), inv=.true.)
+!
+! will correlate A and B.
+!
+!
+! Remarks:
+!
+! Following changes have been introduced with respect to fftn.c:
+! - complex arguments and results are of type complex, rather than
+! real an imaginary part separately.
+! - increment parameter (magnitude of isign) has been dropped,
+! inc is always one, direction of transform is given by inv.
+! - maxf and maxp have been dropped. The amount of temporary storage
+! needed is determined by the fftradix routine. Both fftn and fft
+! can handle any size of array. (Maybe they take a lot of time and
+! memory, but they will do it)
+!
+! Redesigning fftradix in a way, that it handles assumed shape arrays
+! would have been desirable. However, I found it rather hard to do this
+! in an efficient way. Problems were:
+! - to prevent stride multiplications when indexing arrays. At least our
+! compiler was not clever enough to discover that in fact additions
+! would do the job as well. On the other hand, I haven't been clever
+! enough to find an implementation using array operations.
+! - fftradix is rather large and different versions would be necessaray
+! for each possible rank of array.
+! Consequently, in place transformation still needs the argument stored
+! in a consecutive bunch of memory and can't be performed on array
+! sections like A(100:199:-3, 50:1020). Calling fftn with such sections
+! will most probably imply copy-in-copy-out. However, the function fft
+! works with everything it gets and should be convenient to use.
+!
+! Michael Steffens, 09.12.96,
+! Restructured fftradix for better optimization. M. Steffens, 4 June 1997
+!-----------------------------------------------------------------------------
+
+ IMPLICIT NONE
+
+ PRIVATE
+ PUBLIC:: fft, fftn, fftkind
+
+ INTEGER, PARAMETER:: fftkind = KIND(0.0) ! adjust here for other precisions
+
+ REAL(fftkind), PARAMETER:: sin60 = 0.86602540378443865_fftkind
+ REAL(fftkind), PARAMETER:: cos72 = 0.30901699437494742_fftkind
+ REAL(fftkind), PARAMETER:: sin72 = 0.95105651629515357_fftkind
+ REAL(fftkind), PARAMETER:: pi = 3.14159265358979323_fftkind
+
+ INTERFACE fft
+ MODULE PROCEDURE fft1d
+ MODULE PROCEDURE fft2d
+ MODULE PROCEDURE fft3d
+ MODULE PROCEDURE fft4d
+ MODULE PROCEDURE fft5d
+ MODULE PROCEDURE fft6d
+ MODULE PROCEDURE fft7d
+ END INTERFACE
+
+
+ CONTAINS
+
+
+ FUNCTION fft1d(array, dim, inv, stat) RESULT(ft)
+!
+!-- Formal parameters
+ COMPLEX(fftkind), DIMENSION(:), INTENT(IN) :: array
+ INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL:: dim
+ LOGICAL, INTENT(IN), OPTIONAL:: inv
+ INTEGER, INTENT(OUT), OPTIONAL:: stat
+!
+!-- Function result
+ COMPLEX(fftkind), DIMENSION(SIZE(array, 1)):: ft
+
+ INTEGER :: ishape(1)
+
+!
+!-- Intrinsics used
+ INTRINSIC SIZE, SHAPE
+
+ ft = array
+ ishape = SHAPE( array )
+ CALL fftn(ft, ishape, inv = inv, stat = stat)
+
+ END FUNCTION fft1d
+
+
+ FUNCTION fft2d(array, dim, inv, stat) RESULT(ft)
+!
+!-- Formal parameters
+ COMPLEX(fftkind), DIMENSION(:,:), INTENT(IN) :: array
+ INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL:: dim
+ LOGICAL, INTENT(IN), OPTIONAL:: inv
+ INTEGER, INTENT(OUT), OPTIONAL:: stat
+!
+!-- Function result
+ COMPLEX(fftkind), DIMENSION(SIZE(array, 1), SIZE(array, 2)):: ft
+
+ INTEGER :: ishape(2)
+!
+!-- Intrinsics used
+ INTRINSIC SIZE, SHAPE
+
+ ft = array
+ ishape = SHAPE( array )
+ CALL fftn(ft, ishape, dim, inv, stat)
+
+ END FUNCTION fft2d
+
+
+ FUNCTION fft3d(array, dim, inv, stat) RESULT(ft)
+!
+!-- Formal parameters
+ COMPLEX(fftkind), DIMENSION(:,:,:), INTENT(IN) :: array
+ INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL:: dim
+ LOGICAL, INTENT(IN), OPTIONAL:: inv
+ INTEGER, INTENT(OUT), OPTIONAL:: stat
+!
+!-- Function result
+ COMPLEX(fftkind), &
+ DIMENSION(SIZE(array, 1), SIZE(array, 2), SIZE(array, 3)):: ft
+
+ INTEGER :: ishape(3)
+
+!
+!-- Intrinsics used
+ INTRINSIC SIZE, SHAPE
+
+ ft = array
+ ishape = SHAPE( array)
+ CALL fftn(ft, ishape, dim, inv, stat)
+
+ END FUNCTION fft3d
+
+
+ FUNCTION fft4d(array, dim, inv, stat) RESULT(ft)
+!
+!-- Formal parameters
+ COMPLEX(fftkind), DIMENSION(:,:,:,:), INTENT(IN) :: array
+ INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL:: dim
+ LOGICAL, INTENT(IN), OPTIONAL:: inv
+ INTEGER, INTENT(OUT), OPTIONAL:: stat
+!
+!-- Function result
+ COMPLEX(fftkind), DIMENSION( &
+ SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4)):: ft
+
+ INTEGER :: ishape(4)
+!
+!-- Intrinsics used
+ INTRINSIC SIZE, SHAPE
+
+ ft = array
+ ishape = SHAPE( array )
+ CALL fftn(ft, ishape, dim, inv, stat)
+
+ END FUNCTION fft4d
+
+
+ FUNCTION fft5d(array, dim, inv, stat) RESULT(ft)
+!
+!-- Formal parameters
+ COMPLEX(fftkind), DIMENSION(:,:,:,:,:), INTENT(IN) :: array
+ INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL:: dim
+ LOGICAL, INTENT(IN), OPTIONAL:: inv
+ INTEGER, INTENT(OUT), OPTIONAL:: stat
+!
+!-- Function result
+ COMPLEX(fftkind), DIMENSION( &
+ SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), &
+ SIZE(array, 5)):: ft
+
+ INTEGER :: ishape(5)
+
+!
+!-- Intrinsics used
+ INTRINSIC SIZE, SHAPE
+
+ ft = array
+ ishape = SHAPE( array )
+ CALL fftn(ft, ishape, dim, inv, stat)
+
+ END FUNCTION fft5d
+
+
+ FUNCTION fft6d(array, dim, inv, stat) RESULT(ft)
+!
+!-- Formal parameters
+ COMPLEX(fftkind), DIMENSION(:,:,:,:,:,:), INTENT(IN) :: array
+ INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL:: dim
+ LOGICAL, INTENT(IN), OPTIONAL:: inv
+ INTEGER, INTENT(OUT), OPTIONAL:: stat
+!
+!-- Function result
+ COMPLEX(fftkind), DIMENSION( &
+ SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), &
+ SIZE(array, 5), SIZE(array, 6)):: ft
+
+ INTEGER :: ishape(6)
+
+!
+!-- Intrinsics used
+ INTRINSIC SIZE, SHAPE
+
+ ft = array
+ ishape = SHAPE( array )
+ CALL fftn(ft, ishape, dim, inv, stat)
+
+ END FUNCTION fft6d
+
+
+ FUNCTION fft7d(array, dim, inv, stat) RESULT(ft)
+!
+!-- Formal parameters
+ COMPLEX(fftkind), DIMENSION(:,:,:,:,:,:,:), INTENT(IN) :: array
+ INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL:: dim
+ LOGICAL, INTENT(IN), OPTIONAL:: inv
+ INTEGER, INTENT(OUT), OPTIONAL:: stat
+!
+!-- Function result
+ COMPLEX(fftkind), DIMENSION( &
+ SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), &
+ SIZE(array, 5), SIZE(array, 6), SIZE(array, 7)):: ft
+
+ INTEGER :: ishape(7)
+
+!
+!-- Intrinsics used
+ INTRINSIC SIZE, SHAPE
+
+ ft = array
+ ishape = SHAPE( array )
+ CALL fftn(ft, ishape, dim, inv, stat)
+
+ END FUNCTION fft7d
+
+
+ SUBROUTINE fftn(array, shape, dim, inv, stat)
+!
+!-- Formal parameters
+ COMPLEX(fftkind), DIMENSION(*), INTENT(INOUT) :: array
+ INTEGER, DIMENSION(:), INTENT(IN) :: shape
+ INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL:: dim
+ LOGICAL, INTENT(IN), OPTIONAL:: inv
+ INTEGER, INTENT(OUT), OPTIONAL:: stat
+!
+!-- Local arrays
+ INTEGER, DIMENSION(SIZE(shape)):: d
+!
+!-- Local scalars
+ LOGICAL :: inverse
+ INTEGER :: i, ndim, ntotal
+ REAL(fftkind):: scale
+!
+!-- Intrinsics used
+ INTRINSIC PRESENT, MIN, PRODUCT, SIZE, SQRT
+
+!
+!-- Optional parameter settings
+ IF (PRESENT(inv)) THEN
+ inverse = inv
+ ELSE
+ inverse = .FALSE.
+ END IF
+ IF (PRESENT(dim)) THEN
+ ndim = MIN(SIZE(dim), SIZE(d))
+ d(1:ndim) = DIM(1:ndim)
+ ELSE
+ ndim = SIZE(d)
+ d = (/(i, i = 1, SIZE(d))/)
+ END IF
+
+ ntotal = PRODUCT(shape)
+ scale = SQRT(1.0_fftkind / PRODUCT(shape(d(1:ndim))))
+ DO i = 1, ntotal
+ array(i) = CMPLX(REAL(array(i)) * scale, AIMAG(array(i)) * scale, &
+ KIND=fftkind)
+ END DO
+
+ DO i = 1, ndim
+ CALL fftradix(array, ntotal, shape(d(i)), PRODUCT(shape(1:d(i))), &
+ inverse, stat)
+ IF (PRESENT(stat)) THEN
+ IF (stat /=0) RETURN
+ END IF
+ END DO
+
+ END SUBROUTINE fftn
+
+
+ SUBROUTINE fftradix(array, ntotal, npass, nspan, inv, stat)
+!
+!-- Formal parameters
+ COMPLEX(fftkind), DIMENSION(*), INTENT(INOUT) :: array
+ INTEGER, INTENT(IN) :: ntotal, npass, nspan
+ LOGICAL, INTENT(IN) :: inv
+ INTEGER, INTENT(OUT), OPTIONAL:: stat
+!
+!-- Local arrays
+ INTEGER, DIMENSION(BIT_SIZE(0)) :: factor
+ COMPLEX(fftkind), DIMENSION(:), ALLOCATABLE :: ctmp
+ REAL(fftkind), DIMENSION(:), ALLOCATABLE :: sine, cosine
+ INTEGER, DIMENSION(:), ALLOCATABLE :: perm
+!
+!-- Local scalars
+ INTEGER :: maxfactor, nfactor, nsquare, nperm
+!
+!-- Intrinsics used
+ INTRINSIC MAXVAL, MOD, PRESENT, ISHFT, BIT_SIZE, SIN, COS, &
+ CMPLX, REAL, AIMAG
+
+ IF (npass <= 1) RETURN
+
+ CALL factorize(npass, factor, nfactor, nsquare)
+
+ maxfactor = MAXVAL(factor(:nfactor))
+ IF (nfactor - ISHFT(nsquare, 1) > 0) THEN
+ nperm = MAX(nfactor + 1, PRODUCT(factor(nsquare+1: nfactor-nsquare)) - 1)
+ ELSE
+ nperm = nfactor + 1
+ END IF
+
+ IF (PRESENT(stat)) THEN
+ ALLOCATE(ctmp(maxfactor), sine(maxfactor), cosine(maxfactor), STAT=stat)
+ IF (stat /= 0) RETURN
+ CALL transform(array, ntotal, npass, nspan, &
+ factor, nfactor, ctmp, sine, cosine, inv)
+ DEALLOCATE(sine, cosine, STAT=stat)
+ IF (stat /= 0) RETURN
+ ALLOCATE(perm(nperm), STAT=stat)
+ IF (stat /= 0) RETURN
+ CALL permute(array, ntotal, npass, nspan, &
+ factor, nfactor, nsquare, maxfactor, &
+ ctmp, perm)
+ DEALLOCATE(perm, ctmp, STAT=stat)
+ IF (stat /= 0) RETURN
+ ELSE
+ ALLOCATE(ctmp(maxfactor), sine(maxfactor), cosine(maxfactor))
+ CALL transform(array, ntotal, npass, nspan, &
+ factor, nfactor, ctmp, sine, cosine, inv)
+ DEALLOCATE(sine, cosine)
+ ALLOCATE(perm(nperm))
+ CALL permute(array, ntotal, npass, nspan, &
+ factor, nfactor, nsquare, maxfactor, &
+ ctmp, perm)
+ DEALLOCATE(perm, ctmp)
+ END IF
+
+
+ CONTAINS
+
+
+ SUBROUTINE factorize(npass, factor, nfactor, nsquare)
+!
+!-- Formal parameters
+ INTEGER, INTENT(IN) :: npass
+ INTEGER, DIMENSION(*), INTENT(OUT):: factor
+ INTEGER, INTENT(OUT):: nfactor, nsquare
+!
+!-- Local scalars
+ INTEGER:: j, jj, k
+
+ nfactor = 0
+ k = npass
+ DO WHILE (MOD(k, 16) == 0)
+ nfactor = nfactor + 1
+ factor(nfactor) = 4
+ k = k / 16
+ END DO
+ j = 3
+ jj = 9
+ DO
+ DO WHILE (MOD(k, jj) == 0)
+ nfactor = nfactor + 1
+ factor(nfactor) = j
+ k = k / jj
+ END DO
+ j = j + 2
+ jj = j * j
+ IF (jj > k) EXIT
+ END DO
+ IF (k <= 4) THEN
+ nsquare = nfactor
+ factor(nfactor + 1) = k
+ IF (k /= 1) nfactor = nfactor + 1
+ ELSE
+ IF (k - ISHFT(k / 4, 2) == 0) THEN
+ nfactor = nfactor + 1
+ factor(nfactor) = 2
+ k = k / 4
+ END IF
+ nsquare = nfactor
+ j = 2
+ DO
+ IF (MOD(k, j) == 0) THEN
+ nfactor = nfactor + 1
+ factor(nfactor) = j
+ k = k / j
+ END IF
+ j = ISHFT((j + 1) / 2, 1) + 1
+ IF (j > k) EXIT
+ END DO
+ END IF
+ IF (nsquare > 0) THEN
+ j = nsquare
+ DO
+ nfactor = nfactor + 1
+ factor(nfactor) = factor(j)
+ j = j - 1
+ IF (j==0) EXIT
+ END DO
+ END IF
+
+ END SUBROUTINE factorize
+
+
+ SUBROUTINE transform(array, ntotal, npass, nspan, &
+ factor, nfactor, ctmp, sine, cosine, inv) !-- compute fourier transform
+!
+!-- Formal parameters
+ COMPLEX(fftkind), DIMENSION(*), INTENT(IN OUT):: array
+ INTEGER, INTENT(IN) :: ntotal, npass, nspan
+ INTEGER, DIMENSION(*), INTENT(IN) :: factor
+ INTEGER, INTENT(IN) :: nfactor
+ COMPLEX(fftkind), DIMENSION(*), INTENT(OUT) :: ctmp
+ REAL(fftkind), DIMENSION(*), INTENT(OUT) :: sine, cosine
+ LOGICAL, INTENT(IN) :: inv
+!
+!-- Local scalars
+ INTEGER :: ii, ispan
+ INTEGER :: j, jc, jf, jj
+ INTEGER :: k, kk, kspan, k1, k2, k3, k4
+ INTEGER :: nn, nt
+ REAL(fftkind) :: s60, c72, s72, pi2, radf
+ REAL(fftkind) :: c1, s1, c2, s2, c3, s3, cd, sd, ak
+ COMPLEX(fftkind):: cc, cj, ck, cjp, cjm, ckp, ckm
+
+ c72 = cos72
+ IF (inv) THEN
+ s72 = sin72
+ s60 = sin60
+ pi2 = pi
+ ELSE
+ s72 = -sin72
+ s60 = -sin60
+ pi2 = -pi
+ END IF
+
+ nt = ntotal
+ nn = nt - 1
+ kspan = nspan
+ jc = nspan / npass
+ radf = pi2 * jc
+ pi2 = pi2 * 2.0_fftkind !-- use 2 PI from here on
+
+ ii = 0
+ jf = 0
+ DO
+ sd = radf / kspan
+ cd = SIN(sd)
+ cd = 2.0_fftkind * cd * cd
+ sd = SIN(sd + sd)
+ kk = 1
+ ii = ii + 1
+
+ SELECT CASE (factor(ii))
+ CASE (2)
+!
+!-- Transform for factor of 2 (including rotation factor)
+ kspan = kspan / 2
+ k1 = kspan + 2
+ DO
+ DO
+ k2 = kk + kspan
+ ck = array(k2)
+ array(k2) = array(kk)-ck
+ array(kk) = array(kk) + ck
+ kk = k2 + kspan
+ IF (kk > nn) EXIT
+ END DO
+ kk = kk - nn
+ IF (kk > jc) EXIT
+ END DO
+ IF (kk > kspan) RETURN
+ DO
+ c1 = 1.0_fftkind - cd
+ s1 = sd
+ DO
+ DO
+ DO
+ k2 = kk + kspan
+ ck = array(kk) - array(k2)
+ array(kk) = array(kk) + array(k2)
+ array(k2) = ck * CMPLX(c1, s1, KIND=fftkind)
+ kk = k2 + kspan
+ IF (kk >= nt) EXIT
+ END DO
+ k2 = kk - nt
+ c1 = -c1
+ kk = k1 - k2
+ IF (kk <= k2) EXIT
+ END DO
+ ak = c1 - (cd * c1 + sd * s1)
+ s1 = sd * c1 - cd * s1 + s1
+ c1 = 2.0_fftkind - (ak * ak + s1 * s1)
+ s1 = s1 * c1
+ c1 = c1 * ak
+ kk = kk + jc
+ IF (kk >= k2) EXIT
+ END DO
+ k1 = k1 + 1 + 1
+ kk = (k1 - kspan) / 2 + jc
+ IF (kk > jc + jc) EXIT
+ END DO
+
+ CASE (4) !-- transform for factor of 4
+ ispan = kspan
+ kspan = kspan / 4
+
+ DO
+ c1 = 1.0_fftkind
+ s1 = 0.0_fftkind
+ DO
+ DO
+ k1 = kk + kspan
+ k2 = k1 + kspan
+ k3 = k2 + kspan
+ ckp = array(kk) + array(k2)
+ ckm = array(kk) - array(k2)
+ cjp = array(k1) + array(k3)
+ cjm = array(k1) - array(k3)
+ array(kk) = ckp + cjp
+ cjp = ckp - cjp
+ IF (inv) THEN
+ ckp = ckm + CMPLX(-AIMAG(cjm), REAL(cjm), KIND=fftkind)
+ ckm = ckm + CMPLX(AIMAG(cjm), -REAL(cjm), KIND=fftkind)
+ ELSE
+ ckp = ckm + CMPLX(AIMAG(cjm), -REAL(cjm), KIND=fftkind)
+ ckm = ckm + CMPLX(-AIMAG(cjm), REAL(cjm), KIND=fftkind)
+ END IF
+!
+!-- Avoid useless multiplies
+ IF (s1 == 0.0_fftkind) THEN
+ array(k1) = ckp
+ array(k2) = cjp
+ array(k3) = ckm
+ ELSE
+ array(k1) = ckp * CMPLX(c1, s1, KIND=fftkind)
+ array(k2) = cjp * CMPLX(c2, s2, KIND=fftkind)
+ array(k3) = ckm * CMPLX(c3, s3, KIND=fftkind)
+ END IF
+ kk = k3 + kspan
+ IF (kk > nt) EXIT
+ END DO
+
+ c2 = c1 - (cd * c1 + sd * s1)
+ s1 = sd * c1 - cd * s1 + s1
+ c1 = 2.0_fftkind - (c2 * c2 + s1 * s1)
+ s1 = s1 * c1
+ c1 = c1 * c2
+!
+!-- Values of c2, c3, s2, s3 that will get used next time
+ c2 = c1 * c1 - s1 * s1
+ s2 = 2.0_fftkind * c1 * s1
+ c3 = c2 * c1 - s2 * s1
+ s3 = c2 * s1 + s2 * c1
+ kk = kk - nt + jc
+ IF (kk > kspan) EXIT
+ END DO
+ kk = kk - kspan + 1
+ IF (kk > jc) EXIT
+ END DO
+ IF (kspan == jc) RETURN
+
+ CASE default
+!
+!-- Transform for odd factors
+ k = factor(ii)
+ ispan = kspan
+ kspan = kspan / k
+
+ SELECT CASE (k)
+ CASE (3) !-- transform for factor of 3 (optional code)
+ DO
+ DO
+ k1 = kk + kspan
+ k2 = k1 + kspan
+ ck = array(kk)
+ cj = array(k1) + array(k2)
+ array(kk) = ck + cj
+ ck = ck - CMPLX( &
+ 0.5_fftkind * REAL (cj), &
+ 0.5_fftkind * AIMAG(cj), &
+ KIND=fftkind)
+ cj = CMPLX( &
+ (REAL (array(k1)) - REAL (array(k2))) * s60, &
+ (AIMAG(array(k1)) - AIMAG(array(k2))) * s60, &
+ KIND=fftkind)
+ array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=fftkind)
+ array(k2) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=fftkind)
+ kk = k2 + kspan
+ IF (kk >= nn) EXIT
+ END DO
+ kk = kk - nn
+ IF (kk > kspan) EXIT
+ END DO
+
+ CASE (5) !-- transform for factor of 5 (optional code)
+ c2 = c72 * c72 - s72 * s72
+ s2 = 2.0_fftkind * c72 * s72
+ DO
+ DO
+ k1 = kk + kspan
+ k2 = k1 + kspan
+ k3 = k2 + kspan
+ k4 = k3 + kspan
+ ckp = array(k1) + array(k4)
+ ckm = array(k1) - array(k4)
+ cjp = array(k2) + array(k3)
+ cjm = array(k2) - array(k3)
+ cc = array(kk)
+ array(kk) = cc + ckp + cjp
+ ck = CMPLX(REAL(ckp) * c72, AIMAG(ckp) * c72, &
+ KIND=fftkind) + &
+ CMPLX(REAL(cjp) * c2, AIMAG(cjp) * c2, &
+ KIND=fftkind) + cc
+ cj = CMPLX(REAL(ckm) * s72, AIMAG(ckm) * s72, &
+ KIND=fftkind) + &
+ CMPLX(REAL(cjm) * s2, AIMAG(cjm) * s2, &
+ KIND=fftkind)
+ array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=fftkind)
+ array(k4) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=fftkind)
+ ck = CMPLX(REAL(ckp) * c2, AIMAG(ckp) * c2, &
+ KIND=fftkind) + &
+ CMPLX(REAL(cjp) * c72, AIMAG(cjp) * c72, &
+ KIND=fftkind) + cc
+ cj = CMPLX(REAL(ckm) * s2, AIMAG(ckm) * s2, &
+ KIND=fftkind) - &
+ CMPLX(REAL(cjm) * s72, AIMAG(cjm) * s72, &
+ KIND=fftkind)
+ array(k2) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=fftkind)
+ array(k3) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=fftkind)
+ kk = k4 + kspan
+ IF (kk >= nn) EXIT
+ END DO
+ kk = kk - nn
+ IF (kk > kspan) EXIT
+ END DO
+
+ CASE default
+ IF (k /= jf) THEN
+ jf = k
+ s1 = pi2 / k
+ c1 = COS(s1)
+ s1 = SIN(s1)
+ cosine (jf) = 1.0_fftkind
+ sine (jf) = 0.0_fftkind
+ j = 1
+ DO
+ cosine (j) = cosine (k) * c1 + sine (k) * s1
+ sine (j) = cosine (k) * s1 - sine (k) * c1
+ k = k-1
+ cosine (k) = cosine (j)
+ sine (k) = -sine (j)
+ j = j + 1
+ IF (j >= k) EXIT
+ END DO
+ END IF
+ DO
+ DO
+ k1 = kk
+ k2 = kk + ispan
+ cc = array(kk)
+ ck = cc
+ j = 1
+ k1 = k1 + kspan
+ DO
+ k2 = k2 - kspan
+ j = j + 1
+ ctmp(j) = array(k1) + array(k2)
+ ck = ck + ctmp(j)
+ j = j + 1
+ ctmp(j) = array(k1) - array(k2)
+ k1 = k1 + kspan
+ IF (k1 >= k2) EXIT
+ END DO
+ array(kk) = ck
+ k1 = kk
+ k2 = kk + ispan
+ j = 1
+ DO
+ k1 = k1 + kspan
+ k2 = k2 - kspan
+ jj = j
+ ck = cc
+ cj = (0.0_fftkind, 0.0_fftkind)
+ k = 1
+ DO
+ k = k + 1
+ ck = ck + CMPLX( &
+ REAL (ctmp(k)) * cosine(jj), &
+ AIMAG(ctmp(k)) * cosine(jj), KIND=fftkind)
+ k = k + 1
+ cj = cj + CMPLX( &
+ REAL (ctmp(k)) * sine(jj), &
+ AIMAG(ctmp(k)) * sine(jj), KIND=fftkind)
+ jj = jj + j
+ IF (jj > jf) jj = jj - jf
+ IF (k >= jf) EXIT
+ END DO
+ k = jf - j
+ array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), &
+ KIND=fftkind)
+ array(k2) = ck + CMPLX(AIMAG(cj), -REAL(cj), &
+ KIND=fftkind)
+ j = j + 1
+ IF (j >= k) EXIT
+ END DO
+ kk = kk + ispan
+ IF (kk > nn) EXIT
+ END DO
+ kk = kk - nn
+ IF (kk > kspan) EXIT
+ END DO
+
+ END SELECT
+!
+!-- Multiply by rotation factor (except for factors of 2 and 4)
+ IF (ii == nfactor) RETURN
+ kk = jc + 1
+ DO
+ c2 = 1.0_fftkind - cd
+ s1 = sd
+ DO
+ c1 = c2
+ s2 = s1
+ kk = kk + kspan
+ DO
+ DO
+ array(kk) = CMPLX(c2, s2, KIND=fftkind) * array(kk)
+ kk = kk + ispan
+ IF (kk > nt) EXIT
+ END DO
+ ak = s1 * s2
+ s2 = s1 * c2 + c1 * s2
+ c2 = c1 * c2 - ak
+ kk = kk - nt + kspan
+ IF (kk > ispan) EXIT
+ END DO
+ c2 = c1 - (cd * c1 + sd * s1)
+ s1 = s1 + sd * c1 - cd * s1
+ c1 = 2.0_fftkind - (c2 * c2 + s1 * s1)
+ s1 = s1 * c1
+ c2 = c2 * c1
+ kk = kk - ispan + jc
+ IF (kk > kspan) EXIT
+ END DO
+ kk = kk - kspan + jc + 1
+ IF (kk > jc + jc) EXIT
+ END DO
+
+ END SELECT
+ END DO
+ END SUBROUTINE transform
+
+
+ SUBROUTINE permute(array, ntotal, npass, nspan, &
+ factor, nfactor, nsquare, maxfactor, &
+ ctmp, perm)
+!
+!-- Formal parameters
+ COMPLEX(fftkind), DIMENSION(*), INTENT(IN OUT):: array
+ INTEGER, INTENT(IN) :: ntotal, npass, nspan
+ INTEGER, DIMENSION(*), INTENT(IN OUT):: factor
+ INTEGER, INTENT(IN) :: nfactor, nsquare
+ INTEGER, INTENT(IN) :: maxfactor
+ COMPLEX(fftkind), DIMENSION(*), INTENT(OUT) :: ctmp
+ INTEGER, DIMENSION(*), INTENT(OUT) :: perm
+!
+!-- Local scalars
+ INTEGER :: ii, ispan
+ INTEGER :: j, jc, jj
+ INTEGER :: k, kk, kspan, kt, k1, k2, k3
+ INTEGER :: nn, nt
+ COMPLEX(fftkind):: ck
+
+!
+!-- Permute the results to normal order---done in two stages
+!-- Permutation for square factors of n
+
+ nt = ntotal
+ nn = nt - 1
+ kt = nsquare
+ kspan = nspan
+ jc = nspan / npass
+
+ perm (1) = nspan
+ IF (kt > 0) THEN
+ k = kt + kt + 1
+ IF (nfactor < k) k = k - 1
+ j = 1
+ perm (k + 1) = jc
+ DO
+ perm (j + 1) = perm (j) / factor(j)
+ perm (k) = perm (k + 1) * factor(j)
+ j = j + 1
+ k = k - 1
+ IF (j >= k) EXIT
+ END DO
+ k3 = perm (k + 1)
+ kspan = perm (2)
+ kk = jc + 1
+ k2 = kspan + 1
+ j = 1
+
+ IF (npass /= ntotal) THEN
+ permute_multi: DO
+ DO
+ DO
+ k = kk + jc
+ DO
+!
+!-- Swap array(kk) <> array(k2)
+ ck = array(kk)
+ array(kk) = array(k2)
+ array(k2) = ck
+ kk = kk + 1
+ k2 = k2 + 1
+ IF (kk >= k) EXIT
+ END DO
+ kk = kk + nspan - jc
+ k2 = k2 + nspan - jc
+ IF (kk >= nt) EXIT
+ END DO
+ kk = kk - nt + jc
+ k2 = k2 - nt + kspan
+ IF (k2 >= nspan) EXIT
+ END DO
+ DO
+ DO
+ k2 = k2 - perm (j)
+ j = j + 1
+ k2 = perm (j + 1) + k2
+ IF (k2 <= perm (j)) EXIT
+ END DO
+ j = 1
+ DO
+ IF (kk < k2) CYCLE permute_multi
+ kk = kk + jc
+ k2 = k2 + kspan
+ IF (k2 >= nspan) EXIT
+ END DO
+ IF (kk >= nspan) EXIT
+ END DO
+ EXIT
+ END DO permute_multi
+ ELSE
+ permute_single: DO
+ DO
+!
+!-- Swap array(kk) <> array(k2)
+ ck = array(kk)
+ array(kk) = array(k2)
+ array(k2) = ck
+ kk = kk + 1
+ k2 = k2 + kspan
+ IF (k2 >= nspan) EXIT
+ END DO
+ DO
+ DO
+ k2 = k2 - perm (j)
+ j = j + 1
+ k2 = perm (j + 1) + k2
+ IF (k2 <= perm (j)) EXIT
+ END DO
+ j = 1
+ DO
+ IF (kk < k2) CYCLE permute_single
+ kk = kk + 1
+ k2 = k2 + kspan
+ IF (k2 >= nspan) EXIT
+ END DO
+ IF (kk >= nspan) EXIT
+ END DO
+ EXIT
+ END DO permute_single
+ END IF
+ jc = k3
+ END IF
+
+ IF (ISHFT(kt, 1) + 1 >= nfactor) RETURN
+
+ ispan = perm (kt + 1)
+!
+!-- Permutation for square-free factors of n
+ j = nfactor - kt
+ factor(j + 1) = 1
+ DO
+ factor(j) = factor(j) * factor(j+1)
+ j = j - 1
+ IF (j == kt) EXIT
+ END DO
+ kt = kt + 1
+ nn = factor(kt) - 1
+ j = 0
+ jj = 0
+ DO
+ k = kt + 1
+ k2 = factor(kt)
+ kk = factor(k)
+ j = j + 1
+ IF (j > nn) EXIT !-- exit infinite loop
+ jj = jj + kk
+ DO WHILE (jj >= k2)
+ jj = jj - k2
+ k2 = kk
+ k = k + 1
+ kk = factor(k)
+ jj = jj + kk
+ END DO
+ perm (j) = jj
+ END DO
+!
+!-- Determine the permutation cycles of length greater than 1
+ j = 0
+ DO
+ DO
+ j = j + 1
+ kk = perm(j)
+ IF (kk >= 0) EXIT
+ END DO
+ IF (kk /= j) THEN
+ DO
+ k = kk
+ kk = perm (k)
+ perm (k) = -kk
+ IF (kk == j) EXIT
+ END DO
+ k3 = kk
+ ELSE
+ perm (j) = -j
+ IF (j == nn) EXIT !-- exit infinite loop
+ END IF
+ END DO
+!
+!-- Reorder a and b, following the permutation cycles
+ DO
+ j = k3 + 1
+ nt = nt - ispan
+ ii = nt - 1 + 1
+ IF (nt < 0) EXIT !-- exit infinite loop
+ DO
+ DO
+ j = j-1
+ IF (perm(j) >= 0) EXIT
+ END DO
+ jj = jc
+ DO
+ kspan = jj
+ IF (jj > maxfactor) kspan = maxfactor
+ jj = jj - kspan
+ k = perm(j)
+ kk = jc * k + ii + jj
+ k1 = kk + kspan
+ k2 = 0
+ DO
+ k2 = k2 + 1
+ ctmp(k2) = array(k1)
+ k1 = k1 - 1
+ IF (k1 == kk) EXIT
+ END DO
+ DO
+ k1 = kk + kspan
+ k2 = k1 - jc * (k + perm(k))
+ k = -perm(k)
+ DO
+ array(k1) = array(k2)
+ k1 = k1 - 1
+ k2 = k2 - 1
+ IF (k1 == kk) EXIT
+ END DO
+ kk = k2
+ IF (k == j) EXIT
+ END DO
+ k1 = kk + kspan
+ k2 = 0
+ DO
+ k2 = k2 + 1
+ array(k1) = ctmp(k2)
+ k1 = k1 - 1
+ IF (k1 == kk) EXIT
+ END DO
+ IF (jj == 0) EXIT
+ END DO
+ IF (j == 1) EXIT
+ END DO
+ END DO
+
+ END SUBROUTINE permute
+
+ END SUBROUTINE fftradix
+
+ END MODULE singleton
Index: /palm/tags/release-3.4a/SOURCE/sor.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/sor.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/sor.f90 (revision 141)
@@ -0,0 +1,191 @@
+ SUBROUTINE sor( d, ddzu, ddzw, p )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 75 2007-03-22 09:54:05Z raasch
+! 2nd+3rd argument removed from exchange horiz
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.9 2005/03/26 21:02:23 raasch
+! Implementation of non-cyclic (Neumann) horizontal boundary conditions,
+! dx2,dy2 replaced by ddx2,ddy2
+!
+! Revision 1.1 1997/08/11 06:25:56 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Solve the Poisson-equation with the SOR-Red/Black-scheme.
+!------------------------------------------------------------------------------!
+
+ USE grid_variables
+ USE indices
+ USE pegrid
+ USE control_parameters
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, n, nxl1, nxl2, nys1, nys2
+ REAL :: ddzu(1:nz+1), ddzw(1:nz)
+ REAL :: d(nzb+1:nzt,nys:nyn,nxl:nxr), &
+ p(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+ REAL, DIMENSION(:), ALLOCATABLE :: f1, f2, f3
+
+ ALLOCATE( f1(1:nz), f2(1:nz), f3(1:nz) )
+
+!
+!-- Compute pre-factors.
+ DO k = 1, nz
+ f2(k) = ddzu(k+1) * ddzw(k)
+ f3(k) = ddzu(k) * ddzw(k)
+ f1(k) = 2.0 * ( ddx2 + ddy2 ) + f2(k) + f3(k)
+ ENDDO
+
+!
+!-- Limits for RED- and BLACK-part.
+ IF ( MOD( nxl , 2 ) == 0 ) THEN
+ nxl1 = nxl
+ nxl2 = nxl + 1
+ ELSE
+ nxl1 = nxl + 1
+ nxl2 = nxl
+ ENDIF
+ IF ( MOD( nys , 2 ) == 0 ) THEN
+ nys1 = nys
+ nys2 = nys + 1
+ ELSE
+ nys1 = nys + 1
+ nys2 = nys
+ ENDIF
+
+ DO n = 1, n_sor
+
+!
+!-- RED-part
+ DO i = nxl1, nxr, 2
+ DO j = nys2, nyn, 2
+ DO k = nzb+1, nzt
+ p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * ( &
+ ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) + &
+ ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) + &
+ f2(k) * p(k+1,j,i) + &
+ f3(k) * p(k-1,j,i) - &
+ d(k,j,i) - &
+ f1(k) * p(k,j,i) )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO i = nxl2, nxr, 2
+ DO j = nys1, nyn, 2
+ DO k = nzb+1, nzt
+ p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * ( &
+ ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) + &
+ ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) + &
+ f2(k) * p(k+1,j,i) + &
+ f3(k) * p(k-1,j,i) - &
+ d(k,j,i) - &
+ f1(k) * p(k,j,i) )
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Exchange of boundary values for p.
+ CALL exchange_horiz( p )
+
+!
+!-- Horizontal (Neumann) boundary conditions in case of non-cyclic boundaries
+ IF ( bc_lr /= 'cyclic' ) THEN
+ IF ( inflow_l .OR. outflow_l ) p(:,:,nxl-1) = p(:,:,nxl)
+ IF ( inflow_r .OR. outflow_r ) p(:,:,nxr+1) = p(:,:,nxr)
+ ENDIF
+ IF ( bc_ns /= 'cyclic' ) THEN
+ IF ( inflow_n .OR. outflow_n ) p(:,nyn+1,:) = p(:,nyn,:)
+ IF ( inflow_s .OR. outflow_s ) p(:,nys-1,:) = p(:,nys,:)
+ ENDIF
+
+!
+!-- BLACK-part
+ DO i = nxl1, nxr, 2
+ DO j = nys1, nyn, 2
+ DO k = nzb+1, nzt
+ p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * ( &
+ ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) + &
+ ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) + &
+ f2(k) * p(k+1,j,i) + &
+ f3(k) * p(k-1,j,i) - &
+ d(k,j,i) - &
+ f1(k) * p(k,j,i) )
+ ENDDO
+ ENDDO
+ ENDDO
+
+ DO i = nxl2, nxr, 2
+ DO j = nys2, nyn, 2
+ DO k = nzb+1, nzt
+ p(k,j,i) = p(k,j,i) + omega_sor / f1(k) * ( &
+ ddx2 * ( p(k,j,i+1) + p(k,j,i-1) ) + &
+ ddy2 * ( p(k,j+1,i) + p(k,j-1,i) ) + &
+ f2(k) * p(k+1,j,i) + &
+ f3(k) * p(k-1,j,i) - &
+ d(k,j,i) - &
+ f1(k) * p(k,j,i) )
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Exchange of boundary values for p.
+ CALL exchange_horiz( p )
+
+!
+!-- Boundary conditions top/bottom.
+!-- Bottom boundary
+ IF ( ibc_p_b == 1 ) THEN
+!
+!-- Neumann
+ p(nzb,:,:) = p(nzb+1,:,:)
+ ELSE
+!
+!-- Dirichlet
+ p(nzb,:,:) = 0.0
+ ENDIF
+
+!
+!-- Top boundary
+ IF ( ibc_p_t == 1 ) THEN
+!
+!-- Neumann
+ p(nzt+1,:,:) = p(nzt,:,:)
+ ELSE
+!
+!-- Dirichlet
+ p(nzt+1,:,:) = 0.0
+ ENDIF
+
+!
+!-- Horizontal (Neumann) boundary conditions in case of non-cyclic boundaries
+ IF ( bc_lr /= 'cyclic' ) THEN
+ IF ( inflow_l .OR. outflow_l ) p(:,:,nxl-1) = p(:,:,nxl)
+ IF ( inflow_r .OR. outflow_r ) p(:,:,nxr+1) = p(:,:,nxr)
+ ENDIF
+ IF ( bc_ns /= 'cyclic' ) THEN
+ IF ( inflow_n .OR. outflow_n ) p(:,nyn+1,:) = p(:,nyn,:)
+ IF ( inflow_s .OR. outflow_s ) p(:,nys-1,:) = p(:,nys,:)
+ ENDIF
+
+ ENDDO
+
+ DEALLOCATE( f1, f2, f3 )
+
+ END SUBROUTINE sor
Index: /palm/tags/release-3.4a/SOURCE/spline_x.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/spline_x.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/spline_x.f90 (revision 141)
@@ -0,0 +1,525 @@
+ SUBROUTINE spline_x( vad_in_out, ad_v, var_char )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.8 2004/04/30 12:54:20 raasch
+! Names of transpose indices changed, enlarged transposition arrays introduced
+!
+! Revision 1.1 1999/02/05 09:15:59 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Upstream-spline advection along x
+!
+! Input/output parameters:
+! ad_v = advecting wind speed component
+! vad_in_out = quantity to be advected, excluding ghost- or cyclic boundaries
+! result is given to the calling routine in this array
+! var_char = string which defines the quantity to be advected
+!
+! Internal arrays:
+! r = 2D-working array (right hand side of linear equation, buffer for
+! Long filter)
+! tf = tendency field (2D), used for long filter
+! vad = quantity to be advected (2D), including ghost- or cyclic
+! boundarys along the direction of advection
+! wrk_long = working array (long coefficients)
+! wrk_spline = working array (spline coefficients)
+!------------------------------------------------------------------------------!
+
+ USE advection
+ USE grid_variables
+ USE indices
+ USE statistics
+ USE control_parameters
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: var_char
+
+ INTEGER :: component, i, j, k, sr
+ REAL :: overshoot_limit, sm_faktor, t1, t2, t3, ups_limit
+ REAL, DIMENSION(:,:), ALLOCATABLE :: r, tf, vad, wrk_spline
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: wrk_long
+
+#if defined( __parallel )
+ REAL :: ad_v(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa), &
+ vad_in_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa)
+#else
+ REAL :: ad_v(nzb+1:nzt,nys:nyn,nxl:nxr), &
+ vad_in_out(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+#endif
+
+!
+!-- Set criteria for switching between upstream- and upstream-spline-method
+ IF ( var_char == 'u' ) THEN
+ overshoot_limit = overshoot_limit_u
+ ups_limit = ups_limit_u
+ component = 1
+ ELSEIF ( var_char == 'v' ) THEN
+ overshoot_limit = overshoot_limit_v
+ ups_limit = ups_limit_v
+ component = 2
+ ELSEIF ( var_char == 'w' ) THEN
+ overshoot_limit = overshoot_limit_w
+ ups_limit = ups_limit_w
+ component = 3
+ ELSEIF ( var_char == 'pt' ) THEN
+ overshoot_limit = overshoot_limit_pt
+ ups_limit = ups_limit_pt
+ component = 4
+ ELSEIF ( var_char == 'e' ) THEN
+ overshoot_limit = overshoot_limit_e
+ ups_limit = ups_limit_e
+ component = 5
+ ENDIF
+
+!
+!-- Initialize calculation of relative upstream fraction
+ sums_up_fraction_l(component,1,:) = 0.0
+
+#if defined( __parallel )
+
+!
+!-- Allocate working arrays
+ ALLOCATE( r(-1:nx+1,nys_x:nyn_x), vad(-1:nx+1,nys_x:nyn_x), &
+ wrk_spline(0:nx,nys_x:nyn_x) )
+ IF ( long_filter_factor /= 0.0 ) THEN
+ ALLOCATE( tf(0:nx,nys_x:nyn_x), wrk_long(0:nx,nys_x:nyn_x,1:3) )
+ ENDIF
+
+!
+!-- Loop over all gridpoints along z
+ DO k = nzb_x, nzt_x
+
+!
+!-- Store array to be advected on work array and add cyclic boundary along x
+ vad(0:nx,nys_x:nyn_x) = vad_in_out(0:nx,nys_x:nyn_x,k)
+ vad(-1,:) = vad(nx,:)
+ vad(nx+1,:) = vad(0,:)
+
+!
+!-- Calculate right hand side
+ DO j = nys_x, nyn_x
+ DO i = 0, nx
+ r(i,j) = 3.0 * ( &
+ spl_tri_x(2,i) * ( vad(i,j) - vad(i-1,j) ) * ddx + &
+ spl_tri_x(3,i) * ( vad(i+1,j) - vad(i,j) ) * ddx &
+ )
+ ENDDO
+ ENDDO
+
+!
+!-- Forward substitution
+ DO j = nys_x, nyn_x
+ wrk_spline(0,j) = r(0,j)
+ DO i = 1, nx
+ wrk_spline(i,j) = r(i,j) - spl_tri_x(5,i) * wrk_spline(i-1,j)
+ ENDDO
+ ENDDO
+
+!
+!-- Backward substitution (Sherman-Morrison-formula)
+ DO j = nys_x, nyn_x
+ r(nx,j) = wrk_spline(nx,j) / spl_tri_x(4,nx)
+ DO i = nx-1, 0, -1
+ r(i,j) = ( wrk_spline(i,j) - spl_tri_x(3,i) * r(i+1,j) ) / &
+ spl_tri_x(4,i)
+ ENDDO
+ sm_faktor = ( r(0,j) + 0.5 * r(nx,j) / spl_gamma_x ) / &
+ ( 1.0 + spl_z_x(0) + 0.5 * spl_z_x(nx) / spl_gamma_x )
+ DO i = 0, nx
+ r(i,j) = r(i,j) - sm_faktor * spl_z_x(i)
+ ENDDO
+ ENDDO
+
+!
+!-- Add cyclic boundary to right hand side
+ r(-1,:) = r(nx,:)
+ r(nx+1,:) = r(0,:)
+
+!
+!-- Calculate advection along x
+ DO j = nys_x, nyn_x
+ DO i = 0, nx
+
+ IF ( ad_v(i,j,k) == 0.0 ) THEN
+
+ vad_in_out(i,j,k) = vad(i,j)
+
+ ELSEIF ( ad_v(i,j,k) > 0.0 ) THEN
+
+ IF ( ABS( vad(i,j) - vad(i-1,j) ) <= ups_limit ) THEN
+ vad_in_out(i,j,k) = vad(i,j) - dt_3d * ad_v(i,j,k) * &
+ ( vad(i,j) - vad(i-1,j) ) * ddx
+!
+!-- Calculate upstream fraction in % (s. flow_statistics)
+ DO sr = 0, statistic_regions
+ sums_up_fraction_l(component,1,sr) = &
+ sums_up_fraction_l(component,1,sr) + 1.0
+ ENDDO
+ ELSE
+ t1 = ad_v(i,j,k) * dt_3d * ddx
+ t2 = 3.0 * ( vad(i-1,j) - vad(i,j) ) + &
+ ( 2.0 * r(i,j) + r(i-1,j) ) * dx
+ t3 = 2.0 * ( vad(i-1,j) - vad(i,j) ) + &
+ ( r(i,j) + r(i-1,j) ) * dx
+ vad_in_out(i,j,k) = vad(i,j) - r(i,j) * t1 * dx + &
+ t2 * t1**2 - t3 * t1**3
+ IF ( vad(i-1,j) == vad(i,j) ) THEN
+ vad_in_out(i,j,k) = vad(i,j)
+ ENDIF
+ ENDIF
+
+ ELSE
+
+ IF ( ABS( vad(i,j) - vad(i+1,j) ) <= ups_limit ) THEN
+ vad_in_out(i,j,k) = vad(i,j) - dt_3d * ad_v(i,j,k) * &
+ ( vad(i+1,j) - vad(i,j) ) * ddx
+!
+!-- Calculate upstream fraction in % (s. flow_statistics)
+ DO sr = 0, statistic_regions
+ sums_up_fraction_l(component,1,sr) = &
+ sums_up_fraction_l(component,1,sr) + 1.0
+ ENDDO
+ ELSE
+ t1 = -ad_v(i,j,k) * dt_3d * ddx
+ t2 = 3.0 * ( vad(i,j) - vad(i+1,j) ) + &
+ ( 2.0 * r(i,j) + r(i+1,j) ) * dx
+ t3 = 2.0 * ( vad(i,j) - vad(i+1,j) ) + &
+ ( r(i,j) + r(i+1,j) ) * dx
+ vad_in_out(i,j,k) = vad(i,j) + r(i,j) * t1 * dx - &
+ t2 * t1**2 + t3 * t1**3
+ IF ( vad(i+1,j) == vad(i,j) ) THEN
+ vad_in_out(i,j,k) = vad(i,j)
+ ENDIF
+ ENDIF
+
+ ENDIF
+ ENDDO
+ ENDDO
+
+!
+!-- Limit values in order to prevent overshooting
+ IF ( cut_spline_overshoot ) THEN
+
+ DO j = nys_x, nyn_x
+ DO i = 0, nx
+ IF ( ad_v(i,j,k) > 0.0 ) THEN
+ IF ( vad(i,j) > vad(i-1,j) ) THEN
+ vad_in_out(i,j,k) = MIN( vad_in_out(i,j,k), &
+ vad(i,j) + overshoot_limit )
+ vad_in_out(i,j,k) = MAX( vad_in_out(i,j,k), &
+ vad(i-1,j) - overshoot_limit )
+ ELSE
+ vad_in_out(i,j,k) = MAX( vad_in_out(i,j,k), &
+ vad(i,j) - overshoot_limit )
+ vad_in_out(i,j,k) = MIN( vad_in_out(i,j,k), &
+ vad(i-1,j) + overshoot_limit )
+ ENDIF
+ ELSE
+ IF ( vad(i,j) > vad(i+1,j) ) THEN
+ vad_in_out(i,j,k) = MIN( vad_in_out(i,j,k), &
+ vad(i,j) + overshoot_limit )
+ vad_in_out(i,j,k) = MAX( vad_in_out(i,j,k), &
+ vad(i+1,j) - overshoot_limit )
+ ELSE
+ vad_in_out(i,j,k) = MAX( vad_in_out(i,j,k), &
+ vad(i,j) - overshoot_limit )
+ vad_in_out(i,j,k) = MIN( vad_in_out(i,j,k), &
+ vad(i+1,j) + overshoot_limit )
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+!
+!-- Long-filter (acting on tendency only)
+ IF ( long_filter_factor /= 0.0 ) THEN
+
+!
+!-- Compute tendency
+ DO j = nys_x, nyn_x
+ DO i = 0, nx
+ tf(i,j) = vad_in_out(i,j,k) - vad(i,j)
+ ENDDO
+ ENDDO
+
+!
+!-- Apply the filter.
+ DO j = nys_x, nyn_x
+ wrk_long(0,j,1) = 2.0 * ( 1.0 + long_filter_factor )
+ wrk_long(0,j,2) = ( 1.0 - long_filter_factor ) / wrk_long(0,j,1)
+ wrk_long(0,j,3) = ( long_filter_factor * tf(nx,j) + &
+ 2.0 * tf(0,j) + tf(1,j) &
+ ) / wrk_long(0,j,1)
+ DO i = 1, nx-1
+ wrk_long(i,j,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+ ( 1.0 - long_filter_factor ) * wrk_long(i-1,j,2)
+ wrk_long(i,j,2) = ( 1.0 - long_filter_factor ) / wrk_long(i,j,1)
+ wrk_long(i,j,3) = ( tf(i-1,j) + 2.0 * tf(i,j) + &
+ tf(i+1,j) - ( 1.0 - long_filter_factor ) * &
+ wrk_long(i-1,j,3) ) / wrk_long(i,j,1)
+ ENDDO
+ wrk_long(nx,j,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+ ( 1.0 - long_filter_factor ) * wrk_long(nx-1,j,2)
+ wrk_long(nx,j,2) = ( 1.0 - long_filter_factor ) / wrk_long(nx,j,1)
+ wrk_long(nx,j,3) = ( tf(nx-1,j) + 2.0 * tf(nx,j) + &
+ long_filter_factor * tf(0,j) - &
+ ( 1.0 - long_filter_factor ) * &
+ wrk_long(nx-1,j,3) &
+ ) / wrk_long(nx,j,1)
+ r(nx,j) = wrk_long(nx,j,3)
+ ENDDO
+
+ DO i = nx-1, 0, -1
+ DO j = nys_x, nyn_x
+ r(i,j) = wrk_long(i,j,3) - wrk_long(i,j,2) * r(i+1,j)
+ ENDDO
+ ENDDO
+
+ DO j = nys_x, nyn_x
+ DO i = 0, nx
+ vad_in_out(i,j,k) = vad(i,j) + r(i,j)
+ ENDDO
+ ENDDO
+
+ ENDIF ! Long filter
+
+ ENDDO
+
+#else
+
+!
+!-- Allocate working arrays
+ ALLOCATE( r(nzb+1:nzt,nxl-1:nxr+1), vad(nzb:nzt+1,nxl-1:nxr+1), &
+ wrk_spline(nzb+1:nzt,nxl-1:nxr+1) )
+ IF ( long_filter_factor /= 0.0 ) THEN
+ ALLOCATE( tf(nzb+1:nzt,nxl-1:nxr+1), wrk_long(nzb+1:nzt,0:nx,1:3) )
+ ENDIF
+
+!
+!-- Loop over all gridpoints along y
+ DO j = nys, nyn
+
+!
+!-- Store array to be advected on work array and add cyclic boundary along x
+ vad(:,:) = vad_in_out(:,j,:)
+ vad(:,-1) = vad(:,nx)
+ vad(:,nx+1) = vad(:,0)
+
+!
+!-- Calculate right hand side
+ DO i = 0, nx
+ DO k = nzb+1, nzt
+ r(k,i) = 3.0 * ( &
+ spl_tri_x(2,i) * ( vad(k,i) - vad(k,i-1) ) * ddx + &
+ spl_tri_x(3,i) * ( vad(k,i+1) - vad(k,i) ) * ddx &
+ )
+ ENDDO
+ ENDDO
+
+!
+!-- Forward substitution
+ DO k = nzb+1, nzt
+ wrk_spline(k,0) = r(k,0)
+ ENDDO
+
+ DO i = 1, nx
+ DO k = nzb+1, nzt
+ wrk_spline(k,i) = r(k,i) - spl_tri_x(5,i) * wrk_spline(k,i-1)
+ ENDDO
+ ENDDO
+
+!
+!-- Backward substitution (Sherman-Morrison-formula)
+ DO k = nzb+1, nzt
+ r(k,nx) = wrk_spline(k,nx) / spl_tri_x(4,nx)
+ ENDDO
+
+ DO k = nzb+1, nzt
+ DO i = nx-1, 0, -1
+ r(k,i) = ( wrk_spline(k,i) - spl_tri_x(3,i) * r(k,i+1) ) / &
+ spl_tri_x(4,i)
+ ENDDO
+ sm_faktor = ( r(k,0) + 0.5 * r(k,nx) / spl_gamma_x ) / &
+ ( 1.0 + spl_z_x(0) + 0.5 * spl_z_x(nx) / spl_gamma_x )
+ DO i = 0, nx
+ r(k,i) = r(k,i) - sm_faktor * spl_z_x(i)
+ ENDDO
+ ENDDO
+
+!
+!-- Add cyclic boundary to the right hand side
+ r(:,-1) = r(:,nx)
+ r(:,nx+1) = r(:,0)
+
+!
+!-- Calculate advection along x
+ DO i = 0, nx
+ DO k = nzb+1, nzt
+
+ IF (ad_v(k,j,i) == 0.0) THEN
+
+ vad_in_out(k,j,i) = vad(k,i)
+
+ ELSEIF ( ad_v(k,j,i) > 0.0) THEN
+
+ IF ( ABS( vad(k,i) - vad(k,i-1) ) <= ups_limit ) THEN
+ vad_in_out(k,j,i) = vad(k,i) - dt_3d * ad_v(k,j,i) * &
+ ( vad(k,i) - vad(k,i-1) ) * ddx
+!
+!-- Calculate upstream fraction in % (s. flow_statistics)
+ DO sr = 0, statistic_regions
+ sums_up_fraction_l(component,1,sr) = &
+ sums_up_fraction_l(component,1,sr) + 1.0
+ ENDDO
+ ELSE
+ t1 = ad_v(k,j,i) * dt_3d * ddx
+ t2 = 3.0 * ( vad(k,i-1) - vad(k,i) ) + &
+ ( 2.0 * r(k,i) + r(k,i-1) ) * dx
+ t3 = 2.0 * ( vad(k,i-1) - vad(k,i) ) + &
+ ( r(k,i) + r(k,i-1) ) * dx
+ vad_in_out(k,j,i) = vad(k,i) - r(k,i) * t1 * dx + &
+ t2 * t1**2 - t3 * t1**3
+ IF ( vad(k,i-1) == vad(k,i) ) THEN
+ vad_in_out(k,j,i) = vad(k,i)
+ ENDIF
+ ENDIF
+
+ ELSE
+
+ IF ( ABS( vad(k,i) - vad(k,i+1) ) <= ups_limit ) THEN
+ vad_in_out(k,j,i) = vad(k,i) - dt_3d * ad_v(k,j,i) * &
+ ( vad(k,i+1) - vad(k,i) ) * ddx
+!
+!-- Calculate upstream fraction in % (s. flow_statistics)
+ DO sr = 0, statistic_regions
+ sums_up_fraction_l(component,1,sr) = &
+ sums_up_fraction_l(component,1,sr) + 1.0
+ ENDDO
+ ELSE
+ t1 = -ad_v(k,j,i) * dt_3d * ddx
+ t2 = 3.0 * ( vad(k,i) - vad(k,i+1) ) + &
+ ( 2.0 * r(k,i) + r(k,i+1)) * dx
+ t3 = 2.0 * ( vad(k,i) - vad(k,i+1) ) + &
+ ( r(k,i) + r(k,i+1) ) * dx
+ vad_in_out(k,j,i) = vad(k,i) + r(k,i) * t1 * dx - &
+ t2 * t1**2 + t3 * t1**3
+ IF ( vad(k,i+1) == vad(k,i) ) THEN
+ vad_in_out(k,j,i) = vad(k,i)
+ ENDIF
+ ENDIF
+
+ ENDIF
+ ENDDO
+ ENDDO
+
+!
+!-- Limit values in order to prevent overshooting
+ IF ( cut_spline_overshoot ) THEN
+
+ DO i = 0, nx
+ DO k = nzb+1, nzt
+ IF ( ad_v(k,j,i) > 0.0 ) THEN
+ IF ( vad(k,i) > vad(k,i-1) ) THEN
+ vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+ vad(k,i) + overshoot_limit )
+ vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+ vad(k,i-1) - overshoot_limit )
+ ELSE
+ vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+ vad(k,i) - overshoot_limit )
+ vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+ vad(k,i-1) + overshoot_limit )
+ ENDIF
+ ELSE
+ IF ( vad(k,i) > vad(k,i+1) ) THEN
+ vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+ vad(k,i) + overshoot_limit )
+ vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+ vad(k,i+1) - overshoot_limit )
+ ELSE
+ vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+ vad(k,i) - overshoot_limit )
+ vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+ vad(k,i+1) + overshoot_limit )
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+!
+!-- Long filter (acting on tendency only)
+ IF ( long_filter_factor /= 0.0 ) THEN
+
+!
+!-- Compute tendency
+ DO i = nxl, nxr
+ DO k = nzb+1, nzt
+ tf(k,i) = vad_in_out(k,j,i) - vad(k,i)
+ ENDDO
+ ENDDO
+
+!
+!-- Apply the filter
+ wrk_long(:,0,1) = 2.0 * ( 1.0 + long_filter_factor )
+ wrk_long(:,0,2) = ( 1.0 - long_filter_factor ) / wrk_long(:,0,1)
+ wrk_long(:,0,3) = ( long_filter_factor * tf(:,nx) + &
+ 2.0 * tf(:,0) + tf(:,1) ) / wrk_long(:,0,1)
+
+ DO i = 1, nx-1
+ DO k = nzb+1, nzt
+ wrk_long(k,i,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+ ( 1.0 - long_filter_factor ) * &
+ wrk_long(k,i-1,2)
+ wrk_long(k,i,2) = ( 1.0 - long_filter_factor ) / wrk_long(k,i,1)
+ wrk_long(k,i,3) = ( tf(k,i-1) + 2.0 * tf(k,i) + &
+ tf(k,i+1) - ( 1.0 - long_filter_factor ) * &
+ wrk_long(k,i-1,3) ) / wrk_long(k,i,1)
+ ENDDO
+ wrk_long(:,nx,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+ ( 1.0 - long_filter_factor ) * &
+ wrk_long(:,nx-1,2)
+ wrk_long(:,nx,2) = ( 1.0 - long_filter_factor ) / wrk_long(:,nx,1)
+ wrk_long(:,nx,3) = ( tf(:,nx-1) + 2.0 * tf(:,nx) + &
+ long_filter_factor * tf(:,0) - &
+ ( 1.0 - long_filter_factor ) * &
+ wrk_long(:,nx-1,3) ) / wrk_long(:,nx,1)
+ r(:,nx) = wrk_long(:,nx,3)
+ ENDDO
+ DO i = nx-1, 0, -1
+ DO k = nzb+1, nzt
+ r(k,i) = wrk_long(k,i,3) - wrk_long(k,i,2) * r(k,i+1)
+ ENDDO
+ ENDDO
+ DO i = 0, nx
+ DO k = nzb+1, nzt
+ vad_in_out(k,j,i) = vad(k,i) + r(k,i)
+ ENDDO
+ ENDDO
+
+ ENDIF ! Long filter
+
+ ENDDO
+#endif
+
+ IF ( long_filter_factor /= 0.0 ) DEALLOCATE( tf, wrk_long )
+ DEALLOCATE( r, vad, wrk_spline )
+
+ END SUBROUTINE spline_x
Index: /palm/tags/release-3.4a/SOURCE/spline_y.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/spline_y.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/spline_y.f90 (revision 141)
@@ -0,0 +1,527 @@
+ SUBROUTINE spline_y( vad_in_out, ad_v, var_char )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.9 2004/04/30 12:54:37 raasch
+! Names of transpose indices changed, enlarged transposition arrays introduced
+!
+! Revision 1.1 1999/02/05 09:16:31 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Upstream-spline advection along x
+!
+! Input/output parameters:
+! ad_v = advecting wind speed component
+! vad_in_out = quantity to be advected, excluding ghost- or cyclic boundaries
+! result is given to the calling routine in this array
+! var_char = string which defines the quantity to be advected
+!
+! Internal arrays:
+! r = 2D-working array (right hand side of linear equation, buffer for
+! Long filter)
+! tf = tendency field (2D), used for long filter
+! vad = quantity to be advected (2D), including ghost- or cyclic
+! boundarys along the direction of advection
+! wrk_long = working array (long coefficients)
+! wrk_spline = working array (spline coefficients)
+!------------------------------------------------------------------------------!
+
+ USE advection
+ USE grid_variables
+ USE indices
+ USE statistics
+ USE control_parameters
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: var_char
+
+ INTEGER :: component, i, j, k, sr
+ REAL :: overshoot_limit, sm_faktor, t1, t2, t3, ups_limit
+ REAL, DIMENSION(:,:), ALLOCATABLE :: r, tf, vad, wrk_spline
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: wrk_long
+
+#if defined( __parallel )
+ REAL :: ad_v(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya), &
+ vad_in_out(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya)
+#else
+ REAL :: ad_v(nzb+1:nzt,nys:nyn,nxl:nxr), &
+ vad_in_out(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+#endif
+
+!
+!-- Set criteria for switching between upstream- and upstream-spline-method
+ IF ( var_char == 'u' ) THEN
+ overshoot_limit = overshoot_limit_u
+ ups_limit = ups_limit_u
+ component = 1
+ ELSEIF ( var_char == 'v' ) THEN
+ overshoot_limit = overshoot_limit_v
+ ups_limit = ups_limit_v
+ component = 2
+ ELSEIF ( var_char == 'w' ) THEN
+ overshoot_limit = overshoot_limit_w
+ ups_limit = ups_limit_w
+ component = 3
+ ELSEIF ( var_char == 'pt' ) THEN
+ overshoot_limit = overshoot_limit_pt
+ ups_limit = ups_limit_pt
+ component = 4
+ ELSEIF ( var_char == 'e' ) THEN
+ overshoot_limit = overshoot_limit_e
+ ups_limit = ups_limit_e
+ component = 5
+ ENDIF
+
+!
+!-- Initialize calculation of relative upstream fraction
+ sums_up_fraction_l(component,2,:) = 0.0
+
+#if defined( __parallel )
+
+!
+!-- Allocate working arrays
+ ALLOCATE( r(-1:ny+1,nxl_y:nxr_y), &
+ vad(-1:ny+1,nxl_y:nxr_y), &
+ wrk_spline(0:ny,nxl_y:nxr_y) )
+ IF ( long_filter_factor /= 0.0 ) THEN
+ ALLOCATE( tf(0:ny,nxl_y:nxr_y), &
+ wrk_long(0:ny,nxl_y:nxr_y,1:3) )
+ ENDIF
+
+!
+!-- Loop over all gridpoints along z
+ DO k = nzb_y, nzt_y
+
+!
+!-- Store array to be advected on work array and add cyclic boundary along y
+ vad(0:ny,nxl_y:nxr_y) = vad_in_out(0:ny,nxl_y:nxr_y,k)
+ vad(-1,:) = vad(ny,:)
+ vad(ny+1,:) = vad(0,:)
+
+!
+!-- Calculate right hand side
+ DO i = nxl_y, nxr_y
+ DO j = 0, ny
+ r(j,i) = 3.0 * ( &
+ spl_tri_y(2,j) * ( vad(j,i) - vad(j-1,i) ) * ddy + &
+ spl_tri_y(3,j) * ( vad(j+1,i) - vad(j,i) ) * ddy &
+ )
+ ENDDO
+ ENDDO
+
+!
+!-- Forward substitution
+ DO i = nxl_y, nxr_y
+ wrk_spline(0,i) = r(0,i)
+ DO j = 1, ny
+ wrk_spline(j,i) = r(j,i) - spl_tri_y(5,j) * wrk_spline(j-1,i)
+ ENDDO
+ ENDDO
+
+!
+!-- Backward substitution (sherman-Morrison-formula)
+ DO i = nxl_y, nxr_y
+ r(ny,i) = wrk_spline(ny,i) / spl_tri_y(4,ny)
+ DO j = ny-1, 0, -1
+ r(j,i) = ( wrk_spline(j,i) - spl_tri_y(3,j) * r(j+1,i) ) / &
+ spl_tri_y(4,j)
+ ENDDO
+ sm_faktor = ( r(0,i) + 0.5 * r(ny,i) / spl_gamma_y ) / &
+ ( 1.0 + spl_z_y(0) + 0.5 * spl_z_y(ny) / spl_gamma_y )
+ DO j = 0, ny
+ r(j,i) = r(j,i) - sm_faktor * spl_z_y(j)
+ ENDDO
+ ENDDO
+
+!
+!-- Add cyclic boundary conditions to right hand side
+ r(-1,:) = r(ny,:)
+ r(ny+1,:) = r(0,:)
+
+!
+!-- Calculate advection along y
+ DO i = nxl_y, nxr_y
+ DO j = 0, ny
+
+ IF ( ad_v(j,i,k) == 0.0 ) THEN
+
+ vad_in_out(j,i,k) = vad(j,i)
+
+ ELSEIF ( ad_v(j,i,k) > 0.0 ) THEN
+
+ IF ( ABS( vad(j,i) - vad(j-1,i) ) <= ups_limit ) THEN
+ vad_in_out(j,i,k) = vad(j,i) - dt_3d * ad_v(j,i,k) * &
+ ( vad(j,i) - vad(j-1,i) ) * ddy
+!
+!-- Calculate upstream fraction in % (s. flow_statistics)
+ DO sr = 0, statistic_regions
+ sums_up_fraction_l(component,2,sr) = &
+ sums_up_fraction_l(component,2,sr) + 1.0
+ ENDDO
+ ELSE
+ t1 = ad_v(j,i,k) * dt_3d * ddy
+ t2 = 3.0 * ( vad(j-1,i) - vad(j,i) ) + &
+ ( 2.0 * r(j,i) + r(j-1,i) ) * dy
+ t3 = 2.0 * ( vad(j-1,i) - vad(j,i) ) + &
+ ( r(j,i) + r(j-1,i) ) * dy
+ vad_in_out(j,i,k) = vad(j,i) - r(j,i) * t1 * dy + &
+ t2 * t1**2 - t3 * t1**3
+ IF ( vad(j-1,i) == vad(j,i) ) THEN
+ vad_in_out(j,i,k) = vad(j,i)
+ ENDIF
+ ENDIF
+
+ ELSE
+
+ IF ( ABS( vad(j,i) - vad(j+1,i) ) <= ups_limit ) THEN
+ vad_in_out(j,i,k) = vad(j,i) - dt_3d * ad_v(j,i,k) * &
+ ( vad(j+1,i) - vad(j,i) ) * ddy
+!
+!-- Calculate upstream fraction in % (s. flow_statistics)
+ DO sr = 0, statistic_regions
+ sums_up_fraction_l(component,2,sr) = &
+ sums_up_fraction_l(component,2,sr) + 1.0
+ ENDDO
+ ELSE
+ t1 = -ad_v(j,i,k) * dt_3d * ddy
+ t2 = 3.0 * ( vad(j,i) - vad(j+1,i) ) + &
+ ( 2.0 * r(j,i) + r(j+1,i) ) * dy
+ t3 = 2.0 * ( vad(j,i) - vad(j+1,i) ) + &
+ ( r(j,i) + r(j+1,i) ) * dy
+ vad_in_out(j,i,k) = vad(j,i) + r(j,i) * t1 * dy - &
+ t2 * t1**2 + t3 * t1**3
+ IF ( vad(j+1,i) == vad(j,i) ) THEN
+ vad_in_out(j,i,k) = vad(j,i)
+ ENDIF
+ ENDIF
+
+ ENDIF
+ ENDDO
+ ENDDO
+
+!
+!-- Limit values in order to prevent overshooting
+ IF ( cut_spline_overshoot ) THEN
+
+ DO i = nxl_y, nxr_y
+ DO j = 0, ny
+ IF ( ad_v(j,i,k) > 0.0 ) THEN
+ IF ( vad(j,i) > vad(j-1,i) ) THEN
+ vad_in_out(j,i,k) = MIN( vad_in_out(j,i,k), &
+ vad(j,i) + overshoot_limit )
+ vad_in_out(j,i,k) = MAX( vad_in_out(j,i,k), &
+ vad(j-1,i) - overshoot_limit )
+ ELSE
+ vad_in_out(j,i,k) = MAX( vad_in_out(j,i,k), &
+ vad(j,i) - overshoot_limit )
+ vad_in_out(j,i,k) = MIN( vad_in_out(j,i,k), &
+ vad(j-1,i) + overshoot_limit )
+ ENDIF
+ ELSE
+ IF ( vad(j,i) > vad(j+1,i) ) THEN
+ vad_in_out(j,i,k) = MIN( vad_in_out(j,i,k), &
+ vad(j,i) + overshoot_limit )
+ vad_in_out(j,i,k) = MAX( vad_in_out(j,i,k), &
+ vad(j+1,i) - overshoot_limit )
+ ELSE
+ vad_in_out(j,i,k) = MAX( vad_in_out(j,i,k), &
+ vad(j,i) - overshoot_limit )
+ vad_in_out(j,i,k) = MIN( vad_in_out(j,i,k), &
+ vad(j+1,i) + overshoot_limit )
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+!
+!-- Long-filter (acting on tendency only)
+ IF ( long_filter_factor /= 0.0 ) THEN
+
+!
+!-- Compute tendency. Filter only acts on this quantity.
+ DO i = nxl_y, nxr_y
+ DO j = 0, ny
+ tf(j,i) = vad_in_out(j,i,k) - vad(j,i)
+ ENDDO
+ ENDDO
+
+!
+!-- Apply the filter.
+ DO i = nxl_y, nxr_y
+ wrk_long(0,i,1) = 2.0 * ( 1.0 + long_filter_factor )
+ wrk_long(0,i,2) = ( 1.0 - long_filter_factor ) / wrk_long(0,i,1)
+ wrk_long(0,i,3) = ( long_filter_factor * tf(ny,i) + &
+ 2.0 * tf(0,i) + tf(1,i) &
+ ) / wrk_long(0,i,1)
+ DO j = 1, ny-1
+ wrk_long(j,i,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+ ( 1.0 - long_filter_factor ) * wrk_long(j-1,i,2)
+ wrk_long(j,i,2) = ( 1.0 - long_filter_factor ) / wrk_long(j,i,1)
+ wrk_long(j,i,3) = ( tf(j-1,i) + 2.0 * tf(j,i) + &
+ tf(j+1,i) - ( 1.0 - long_filter_factor ) * &
+ wrk_long(j-1,i,3) ) / wrk_long(j,i,1)
+ ENDDO
+ wrk_long(ny,i,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+ ( 1.0 - long_filter_factor ) * wrk_long(ny-1,i,2)
+ wrk_long(ny,i,2) = ( 1.0 - long_filter_factor ) / wrk_long(ny,i,1)
+ wrk_long(ny,i,3) = ( tf(ny-1,i) + 2.0 * tf(ny,i) + &
+ long_filter_factor * tf(0,i) - &
+ ( 1.0 - long_filter_factor ) * &
+ wrk_long(ny-1,i,3) &
+ ) / wrk_long(ny,i,1)
+ r(ny,i) = wrk_long(ny,i,3)
+ ENDDO
+
+ DO j = ny-1, 0, -1
+ DO i = nxl_y, nxr_y
+ r(j,i) = wrk_long(j,i,3) - wrk_long(j,i,2) * r(j+1,i)
+ ENDDO
+ ENDDO
+
+ DO i = nxl_y, nxr_y
+ DO j = 0, ny
+ vad_in_out(j,i,k) = vad(j,i) + r(j,i)
+ ENDDO
+ ENDDO
+
+ ENDIF ! Long filter
+
+ ENDDO
+
+#else
+
+!
+!-- Allocate working arrays
+ ALLOCATE( r(nzb+1:nzt,nys-1:nyn+1), vad(nzb:nzt+1,nys-1:nyn+1), &
+ wrk_spline(nzb+1:nzt,nys-1:nyn+1) )
+ IF ( long_filter_factor /= 0.0 ) THEN
+ ALLOCATE( tf(nzb+1:nzt,nys-1:nyn+1), wrk_long(nzb+1:nzt,0:ny,1:3) )
+ ENDIF
+
+!
+!-- Loop over all gridpoints along x
+ DO i = nxl, nxr
+
+!
+!-- Store array to be advected on work array and add cyclic boundary along x
+ vad(:,:) = vad_in_out(:,:,i)
+ vad(:,-1) = vad(:,ny)
+ vad(:,ny+1) = vad(:,0)
+
+!
+!-- Calculate right hand side
+ DO j = 0, ny
+ DO k = nzb+1, nzt
+ r(k,j) = 3.0 * ( &
+ spl_tri_y(2,j) * ( vad(k,j) - vad(k,j-1) ) * ddy + &
+ spl_tri_y(3,j) * ( vad(k,j+1) - vad(k,j) ) * ddy &
+ )
+ ENDDO
+ ENDDO
+
+!
+!-- Forward substitution
+ DO k = nzb+1, nzt
+ wrk_spline(k,0) = r(k,0)
+ ENDDO
+
+ DO j = 1, ny
+ DO k = nzb+1, nzt
+ wrk_spline(k,j) = r(k,j) - spl_tri_y(5,j) * wrk_spline(k,j-1)
+ ENDDO
+ ENDDO
+
+!
+!-- Backward substitution (Sherman-Morrison-formula)
+ DO k = nzb+1, nzt
+ r(k,ny) = wrk_spline(k,ny) / spl_tri_y(4,ny)
+ ENDDO
+
+ DO k = nzb+1, nzt
+ DO j = ny-1, 0, -1
+ r(k,j) = ( wrk_spline(k,j) - spl_tri_y(3,j) * r(k,j+1) ) / &
+ spl_tri_y(4,j)
+ ENDDO
+ sm_faktor = ( r(k,0) + 0.5 * r(k,ny) / spl_gamma_y ) / &
+ ( 1.0 + spl_z_y(0) + 0.5 * spl_z_y(ny) / spl_gamma_y )
+ DO j = 0, ny
+ r(k,j) = r(k,j) - sm_faktor * spl_z_y(j)
+ ENDDO
+ ENDDO
+
+!
+!-- Add cyclic boundary to the right hand side
+ r(:,-1) = r(:,ny)
+ r(:,ny+1) = r(:,0)
+
+!
+!-- Calculate advection along y
+ DO j = 0, ny
+ DO k = nzb+1, nzt
+
+ IF ( ad_v(k,j,i) == 0.0 ) THEN
+
+ vad_in_out(k,j,i) = vad(k,j)
+
+ ELSEIF ( ad_v(k,j,i) > 0.0 ) THEN
+
+ IF ( ABS( vad(k,j) - vad(k,j-1) ) <= ups_limit ) THEN
+ vad_in_out(k,j,i) = vad(k,j) - dt_3d * ad_v(k,j,i) * &
+ ( vad(k,j) - vad(k,j-1) ) * ddy
+!
+!-- Calculate upstream fraction in % (s. flow_statistics)
+ DO sr = 0, statistic_regions
+ sums_up_fraction_l(component,2,sr) = &
+ sums_up_fraction_l(component,2,sr) + 1.0
+ ENDDO
+ ELSE
+ t1 = ad_v(k,j,i) * dt_3d * ddy
+ t2 = 3.0 * ( vad(k,j-1) - vad(k,j) ) + &
+ ( 2.0 * r(k,j) + r(k,j-1) ) * dy
+ t3 = 2.0 * ( vad(k,j-1) - vad(k,j) ) + &
+ ( r(k,j) + r(k,j-1) ) * dy
+ vad_in_out(k,j,i) = vad(k,j) - r(k,j) * t1 * dy + &
+ t2 * t1**2 - t3 * t1**3
+ IF ( vad(k,j-1) == vad(k,j) ) THEN
+ vad_in_out(k,j,i) = vad(k,j)
+ ENDIF
+ ENDIF
+
+ ELSE
+
+ IF ( ABS( vad(k,j) - vad(k,j+1) ) <= ups_limit ) THEN
+ vad_in_out(k,j,i) = vad(k,j) - dt_3d * ad_v(k,j,i) * &
+ ( vad(k,j+1) - vad(k,j) ) * ddy
+!
+!-- Calculate upstream fraction in % (s. flow_statistics)
+ DO sr = 0, statistic_regions
+ sums_up_fraction_l(component,2,sr) = &
+ sums_up_fraction_l(component,2,sr) + 1.0
+ ENDDO
+ ELSE
+ t1 = -ad_v(k,j,i) * dt_3d * ddy
+ t2 = 3.0 * ( vad(k,j) - vad(k,j+1) ) + &
+ ( 2.0 * r(k,j) + r(k,j+1) ) * dy
+ t3 = 2.0 * ( vad(k,j) - vad(k,j+1) ) + &
+ ( r(k,j) + r(k,j+1) ) * dy
+ vad_in_out(k,j,i) = vad(k,j) + r(k,j) * t1 * dy - &
+ t2 * t1**2 + t3 * t1**3
+ IF ( vad(k,j+1) == vad(k,j) ) THEN
+ vad_in_out(k,j,i) = vad(k,j)
+ ENDIF
+ ENDIF
+
+ ENDIF
+ ENDDO
+ ENDDO
+
+!
+!-- Limit values in order to prevent overshooting
+ IF ( cut_spline_overshoot ) THEN
+
+ DO j = 0, ny
+ DO k = nzb+1, nzt
+ IF ( ad_v(k,j,i) > 0.0 ) THEN
+ IF ( vad(k,j) > vad(k,j-1) ) THEN
+ vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+ vad(k,j) + overshoot_limit )
+ vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+ vad(k,j-1) - overshoot_limit )
+ ELSE
+ vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+ vad(k,j) - overshoot_limit )
+ vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+ vad(k,j-1) + overshoot_limit )
+ ENDIF
+ ELSE
+ IF ( vad(k,j) > vad(k,j+1) ) THEN
+ vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+ vad(k,j) + overshoot_limit )
+ vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+ vad(k,j+1) - overshoot_limit )
+ ELSE
+ vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+ vad(k,j) - overshoot_limit )
+ vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+ vad(k,j+1) + overshoot_limit )
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+!
+!-- Long filter (acting on tendency only)
+ IF ( long_filter_factor /= 0.0 ) THEN
+
+!
+!-- Compute tendency
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ tf(k,j) = vad_in_out(k,j,i) - vad(k,j)
+ ENDDO
+ ENDDO
+
+!
+!-- Apply the filter
+ wrk_long(:,0,1) = 2.0 * ( 1.0 + long_filter_factor )
+ wrk_long(:,0,2) = ( 1.0 - long_filter_factor ) / wrk_long(:,0,1)
+ wrk_long(:,0,3) = ( long_filter_factor * tf(:,ny) + &
+ 2.0 * tf(:,0) + tf(:,1) ) / wrk_long(:,0,1)
+
+ DO j = 1, ny-1
+ DO k = nzb+1, nzt
+ wrk_long(k,j,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+ ( 1.0 - long_filter_factor ) * &
+ wrk_long(k,j-1,2)
+ wrk_long(k,j,2) = ( 1.0 - long_filter_factor ) / wrk_long(k,j,1)
+ wrk_long(k,j,3) = ( tf(k,j-1) + 2.0 * tf(k,j) + &
+ tf(k,j+1) - ( 1.0 - long_filter_factor ) * &
+ wrk_long(k,j-1,3) ) / wrk_long(k,j,1)
+ ENDDO
+ wrk_long(:,ny,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+ ( 1.0 - long_filter_factor ) * &
+ wrk_long(:,ny-1,2)
+ wrk_long(:,ny,2) = ( 1.0 - long_filter_factor ) / wrk_long(:,ny,1)
+ wrk_long(:,ny,3) = ( tf(:,ny-1) + 2.0 * tf(:,ny) + &
+ long_filter_factor * tf(:,0) - &
+ ( 1.0 - long_filter_factor ) * &
+ wrk_long(:,ny-1,3) ) / wrk_long(:,ny,1)
+ r(:,ny) = wrk_long(:,ny,3)
+ ENDDO
+ DO j = ny-1, 0, -1
+ DO k = nzb+1, nzt
+ r(k,j) = wrk_long(k,j,3) - wrk_long(k,j,2) * r(k,j+1)
+ ENDDO
+ ENDDO
+ DO j = 0, ny
+ DO k = nzb+1, nzt
+ vad_in_out(k,j,i) = vad(k,j) + r(k,j)
+ ENDDO
+ ENDDO
+
+ ENDIF ! Long filter
+
+ ENDDO
+#endif
+
+ IF ( long_filter_factor /= 0.0 ) DEALLOCATE( tf, wrk_long )
+ DEALLOCATE( r, vad, wrk_spline )
+
+ END SUBROUTINE spline_y
Index: /palm/tags/release-3.4a/SOURCE/spline_z.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/spline_z.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/spline_z.f90 (revision 141)
@@ -0,0 +1,431 @@
+ SUBROUTINE spline_z( vad_in_out, ad_v, dz_spline, spline_tri, var_char )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 19 2007-02-23 04:53:48Z raasch
+! Boundary condition for pt at top adjusted
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.9 2005/06/29 08:22:56 steinfeld
+! Dependency of ug and vg on height considered in the determination of the
+! upper boundary condition for vad
+!
+! Revision 1.1 1999/02/05 09:17:16 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Upstream-spline advection along x
+!
+! Input/output parameters:
+! ad_v = advecting wind speed component
+! dz_spline = vertical grid spacing (dzu or dzw, depending on quantity to be
+! advected)
+! spline_tri = grid spacing factors (spl_tri_zu or spl_tri_zw, depending on
+! quantity to be advected)
+! vad_in_out = quantity to be advected, excluding ghost- or cyclic boundaries
+! result is given to the calling routine in this array
+! var_char = string which defines the quantity to be advected
+!
+! Internal arrays:
+! r = 2D-working array (right hand side of linear equation, buffer for
+! Long filter)
+! tf = tendency field (2D), used for long filter
+! vad = quantity to be advected (2D), including ghost- or cyclic
+! boundarys along the direction of advection
+! wrk_long = working array (long coefficients)
+! wrk_spline = working array (spline coefficients)
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE grid_variables
+ USE indices
+ USE statistics
+ USE control_parameters
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: var_char
+
+ INTEGER :: component, i, j, k, sr
+ REAL :: dzwd, dzwu, overshoot_limit, t1, t2, t3, ups_limit
+ REAL :: dz_spline(1:nzt+1)
+ REAL :: spline_tri(5,nzb:nzt+1)
+ REAL :: ad_v(nzb+1:nzta,nys:nyna,nxl:nxra)
+
+ REAL, DIMENSION(:,:), ALLOCATABLE :: r, tf, vad, wrk_spline
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: wrk_long
+
+#if defined( __parallel )
+ REAL :: vad_in_out(nzb+1:nzta,nys:nyna,nxl:nxra)
+#else
+ REAL :: vad_in_out(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1)
+#endif
+
+!
+!-- Set criteria for switching between upstream- and upstream-spline-method
+ IF ( var_char == 'u' ) THEN
+ overshoot_limit = overshoot_limit_u
+ ups_limit = ups_limit_u
+ component = 1
+ ELSEIF ( var_char == 'v' ) THEN
+ overshoot_limit = overshoot_limit_v
+ ups_limit = ups_limit_v
+ component = 2
+ ELSEIF ( var_char == 'w' ) THEN
+ overshoot_limit = overshoot_limit_w
+ ups_limit = ups_limit_w
+ component = 3
+ ELSEIF ( var_char == 'pt' ) THEN
+ overshoot_limit = overshoot_limit_pt
+ ups_limit = ups_limit_pt
+ component = 4
+ ELSEIF ( var_char == 'e' ) THEN
+ overshoot_limit = overshoot_limit_e
+ ups_limit = ups_limit_e
+ component = 5
+ ENDIF
+
+!
+!-- Allocate working arrays
+ ALLOCATE( r(nzb:nzt+1,nys:nyn), vad(nzb:nzt+1,nys:nyn), &
+ wrk_spline(nzb:nzt+1,nys:nyn) )
+ IF ( long_filter_factor /= 0.0 ) THEN
+ ALLOCATE( tf(nzb:nzt+1,nys:nyn), wrk_long(nzb+1:nzt,nys:nyn,1:3) )
+ ENDIF
+
+!
+!-- Initialize calculation of relative upstream fraction
+ sums_up_fraction_l(component,3,:) = 0.0
+
+!
+!-- Loop over all gridpoints along x
+ DO i = nxl, nxr
+
+!
+!-- Store array to be advected on work array
+ vad(nzb+1:nzt,:) = vad_in_out(nzb+1:nzt,nys:nyn,i)
+!
+!-- Add boundary conditions along z
+ IF ( var_char == 'u' .OR. var_char == 'v' ) THEN
+!
+!-- Bottom boundary
+!-- u- and v-component
+ IF ( ibc_uv_b == 0 ) THEN
+ vad(nzb,:) = -vad(nzb+1,:)
+ ELSE
+ vad(nzb,:) = vad(nzb+1,:)
+ ENDIF
+!
+!-- Top boundary
+!-- Dirichlet condition
+ IF ( ibc_uv_t == 0 .AND. var_char == 'u' ) THEN
+!
+!-- u-component
+ vad(nzt+1,:) = ug(nzt+1)
+ ELSEIF ( ibc_uv_t == 0 .AND. var_char == 'v' ) THEN
+!
+!-- v-component
+ vad(nzt+1,:) = vg(nzt+1)
+ ELSE
+!
+!-- Neumann condition
+ vad(nzt+1,:) = vad(nzt,:)
+ ENDIF
+
+ ELSEIF ( var_char == 'w' ) THEN
+!
+!-- Bottom and top boundary for w-component
+ vad(nzb,:) = 0.0
+ vad(nzt+1,:) = 0.0
+
+ ELSEIF ( var_char == 'pt' ) THEN
+!
+!-- Bottom boundary for temperature
+ IF ( ibc_pt_b == 1 ) THEN
+ vad(nzb,:) = vad(nzb+1,:)
+ ELSE
+ vad(nzb,:) = pt(nzb,:,i)
+ ENDIF
+!
+!-- Top boundary for temperature
+ IF ( ibc_pt_t == 0 ) THEN
+ vad(nzt+1,:) = pt(nzt+1,nys:nyn,i)
+ ELSEIF ( ibc_pt_t == 1 ) THEN
+ vad(nzt+1,:) = vad(nzt,:)
+ ELSEIF ( ibc_pt_t == 2 ) THEN
+ vad(nzt+1,:) = vad(nzt,:) + bc_pt_t_val * dz_spline(nzt+1)
+ ENDIF
+
+ ELSEIF ( var_char == 'e' ) THEN
+!
+!-- Boundary conditions for TKE (Neumann in any case)
+ vad(nzb,:) = vad(nzb+1,:)
+ vad(nzt,:) = vad(nzt-1,:)
+ vad(nzt+1,:) = vad(nzt,:)
+
+ ENDIF
+
+!
+!-- Calculate right hand side
+ DO j = nys, nyn
+ r(nzb,j) = 3.0 * ( vad(nzb+1,j)-vad(nzb,j) ) / dz_spline(1)
+ r(nzt+1,j) = 3.0 * ( vad(nzt+1,j)-vad(nzt,j) ) / dz_spline(nzt+1)
+ DO k = nzb+1, nzt
+ r(k,j) = 3.0 * ( &
+ spline_tri(2,k) * ( vad(k,j)-vad(k-1,j) ) / dz_spline(k) &
+ + spline_tri(3,k) * ( vad(k+1,j)-vad(k,j) ) / dz_spline(k+1) &
+ )
+ ENDDO
+ ENDDO
+
+!
+!-- Forward substitution
+ DO j = nys, nyn
+ wrk_spline(nzb,j) = r(nzb,j)
+ DO k = nzb+1, nzt+1
+ wrk_spline(k,j) = r(k,j) - spline_tri(5,k) * r(k-1,j)
+ ENDDO
+ ENDDO
+
+!
+!-- Backward substitution
+ DO j = nys, nyn
+ r(nzt+1,j) = wrk_spline(nzt+1,j) / spline_tri(4,nzt+1)
+ DO k = nzt, nzb, -1
+ r(k,j) = ( wrk_spline(k,j) - spline_tri(3,k) * r(k+1,j) ) / &
+ spline_tri(4,k)
+ ENDDO
+ ENDDO
+
+!
+!-- Calculate advection along z
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+
+ IF ( ad_v(k,j,i) == 0.0 ) THEN
+
+ vad_in_out(k,j,i) = vad(k,j)
+
+ ELSEIF ( ad_v(k,j,i) > 0.0 ) THEN
+
+ IF ( ABS( vad(k,j) - vad(k-1,j) ) <= ups_limit ) THEN
+ vad_in_out(k,j,i) = vad(k,j) - dt_3d * ad_v(k,j,i) * &
+ ( vad(k,j) - vad(k-1,j) ) * ddzu(k)
+!
+!-- Calculate upstream fraction in % (s. flow_statistics)
+ DO sr = 0, statistic_regions
+ sums_up_fraction_l(component,3,sr) = &
+ sums_up_fraction_l(component,3,sr) + 1.0
+ ENDDO
+ ELSE
+ t1 = ad_v(k,j,i) * dt_3d / dz_spline(k)
+ t2 = 3.0 * ( vad(k-1,j) - vad(k,j) ) + &
+ ( 2.0 * r(k,j) + r(k-1,j) ) * dz_spline(k)
+ t3 = 2.0 * ( vad(k-1,j) - vad(k,j) ) + &
+ ( r(k,j) + r(k-1,j) ) * dz_spline(k)
+ vad_in_out(k,j,i) = vad(k,j) - r(k,j) * t1* dz_spline(k) + &
+ t2 * t1**2 - t3 * t1**3
+ IF ( vad(k-1,j) == vad(k,j) ) THEN
+ vad_in_out(k,j,i) = vad(k,j)
+ ENDIF
+ ENDIF
+
+ ELSE
+
+ IF( ABS( vad(k,j) - vad(k+1,j) ) <= ups_limit ) THEN
+ vad_in_out(k,j,i) = vad(k,j) - dt_3d * ad_v(k,j,i) * &
+ ( vad(k+1,j) - vad(k,j) ) * ddzu(k+1)
+!
+!-- Calculate upstream fraction in % (s. flow_statistics)
+ DO sr = 0, statistic_regions
+ sums_up_fraction_l(component,3,sr) = &
+ sums_up_fraction_l(component,3,sr) + 1.0
+ ENDDO
+ ELSE
+ t1 = -ad_v(k,j,i) * dt_3d / dz_spline(k+1)
+ t2 = 3.0 * ( vad(k,j) - vad(k+1,j) ) + &
+ ( 2.0 * r(k,j) + r(k+1,j) ) * dz_spline(k+1)
+ t3 = 2.0 * ( vad(k,j) - vad(k+1,j) ) + &
+ ( r(k,j) + r(k+1,j) ) * dz_spline(k+1)
+ vad_in_out(k,j,i) = vad(k,j) + r(k,j)*t1*dz_spline(k+1) - &
+ t2 * t1**2 + t3 * t1**3
+ IF ( vad(k+1,j) == vad(k,j) ) THEN
+ vad_in_out(k,j,i) = vad(k,j)
+ ENDIF
+ ENDIF
+
+ ENDIF
+ ENDDO
+ ENDDO
+
+!
+!-- Limit values in order to prevent overshooting
+ IF ( cut_spline_overshoot ) THEN
+
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ IF ( ad_v(k,j,i) > 0.0 ) THEN
+ IF ( vad(k,j) > vad(k-1,j) ) THEN
+ vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+ vad(k,j) + overshoot_limit )
+ vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+ vad(k-1,j) - overshoot_limit )
+ ELSE
+ vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+ vad(k,j) - overshoot_limit )
+ vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+ vad(k-1,j) + overshoot_limit )
+ ENDIF
+ ELSE
+ IF ( vad(k,j) > vad(k+1,j) ) THEN
+ vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+ vad(k,j) + overshoot_limit )
+ vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+ vad(k+1,j) - overshoot_limit )
+ ELSE
+ vad_in_out(k,j,i) = MAX( vad_in_out(k,j,i), &
+ vad(k,j) - overshoot_limit )
+ vad_in_out(k,j,i) = MIN( vad_in_out(k,j,i), &
+ vad(k+1,j) + overshoot_limit )
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+
+ ENDIF
+
+!
+!-- Long-filter (acting on tendency only)
+ IF ( long_filter_factor /= 0.0 ) THEN
+
+!
+!-- Compute tendency
+ DO j = nys, nyn
+
+!
+!-- Depending on the quantity to be advected, the respective vertical
+!-- boundary conditions must be applied.
+ IF ( var_char == 'u' .OR. var_char == 'v' ) THEN
+
+ IF ( ibc_uv_b == 0 ) THEN
+ tf(nzb,j) = - ( vad_in_out(nzb+1,j,i) - vad(nzb+1,j) )
+ ELSE
+ tf(nzb,j) = vad_in_out(nzb+1,j,i) - vad(nzb+1,j)
+ ENDIF
+
+ IF ( ibc_uv_t == 0 ) THEN
+ tf(nzt+1,j) = 0.0
+ ELSE
+ tf(nzt+1,j) = vad_in_out(nzt,j,i) - vad(nzt,j)
+ ENDIF
+
+ ELSEIF ( var_char == 'w' ) THEN
+
+ tf(nzb,j) = 0.0
+ tf(nzt+1,j) = 0.0
+
+ ELSEIF ( var_char == 'pt' ) THEN
+
+ IF ( ibc_pt_b == 1 ) THEN
+ tf(nzb,j) = vad_in_out(nzb+1,j,i) - vad(nzb+1,j)
+ ELSE
+ tf(nzb,j) = 0.0
+ ENDIF
+
+ IF ( ibc_pt_t == 1 ) THEN
+ vad_in_out(nzt,j,i) = vad_in_out(nzt-1,j,i) + bc_pt_t_val * &
+ dz_spline(nzt)
+ tf(nzt+1,j) = vad_in_out(nzt,j,i) + bc_pt_t_val * &
+ dz_spline(nzt+1) - vad(nzt+1,j)
+ ELSE
+ vad_in_out(nzt,j,i) = pt(nzt,j,i)
+ tf(nzt+1,j) = 0.0
+ ENDIF
+
+ ENDIF
+
+ DO k = nzb+1, nzt
+ tf(k,j) = vad_in_out(k,j,i) - vad(k,j)
+ ENDDO
+
+ ENDDO
+
+!
+!-- Apply the filter.
+ DO j = nys, nyn
+
+ dzwd = dz_spline(1) / ( dz_spline(1) + dz_spline(2) )
+ dzwu = dz_spline(2) / ( dz_spline(1) + dz_spline(2) )
+
+ wrk_long(nzb+1,j,1) = 2.0 * ( 1.0 + long_filter_factor )
+ wrk_long(nzb+1,j,2) = ( 1.0 - long_filter_factor ) * dzwd / &
+ wrk_long(nzb+1,j,1)
+ wrk_long(nzb+1,j,3) = ( long_filter_factor * dzwu * tf(nzb,j) + &
+ 2.0 * tf(nzb+1,j) + dzwd * tf(nzb+2,j) &
+ ) / wrk_long(nzb+1,j,1)
+
+ DO k = nzb+2, nzt-1
+
+ dzwd = dz_spline(k) / ( dz_spline(k) + dz_spline(k+1) )
+ dzwu = dz_spline(k+1) / ( dz_spline(k) + dz_spline(k+1) )
+
+ wrk_long(k,j,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+ ( 1.0 - long_filter_factor ) * dzwu * &
+ wrk_long(k-1,j,2)
+ wrk_long(k,j,2) = ( 1.0 - long_filter_factor ) * dzwd / &
+ wrk_long(k,j,1)
+ wrk_long(k,j,3) = ( dzwu * tf(k-1,j) + 2.0 * tf(k,j) + &
+ dzwd * tf(k+1,j) - &
+ ( 1.0 - long_filter_factor ) * dzwu * &
+ wrk_long(k-1,j,3) &
+ ) / wrk_long(k,j,1)
+ ENDDO
+
+ dzwd = dz_spline(nzt) / ( dz_spline(nzt) + dz_spline(nzt+1) )
+ dzwu = dz_spline(nzt+1) / ( dz_spline(nzt) + dz_spline(nzt+1) )
+
+ wrk_long(nzt,j,1) = 2.0 * ( 1.0 + long_filter_factor ) - &
+ ( 1.0 - long_filter_factor ) * dzwu * &
+ wrk_long(nzt-1,j,2)
+ wrk_long(nzt,j,2) = ( 1.0 - long_filter_factor ) * dzwd / &
+ wrk_long(nzt,j,1)
+ wrk_long(nzt,j,3) = ( dzwu * tf(nzt-1,j) + 2.0 * tf(nzt,j) + &
+ dzwd * long_filter_factor * tf(nzt+1,j) - &
+ ( 1.0 - long_filter_factor ) * dzwu * &
+ wrk_long(nzt-1,j,3) &
+ ) / wrk_long(nzt,j,1)
+ r(nzt,j) = wrk_long(nzt,j,3)
+
+ ENDDO
+
+ DO j = nys, nyn
+ DO k = nzt-1, nzb+1, -1
+ r(k,j) = wrk_long(k,j,3) - wrk_long(k,j,2) * r(k+1,j)
+ ENDDO
+ ENDDO
+
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ vad_in_out(k,j,i) = vad(k,j) + r(k,j)
+ ENDDO
+ ENDDO
+
+ ENDIF ! Long filter
+
+ ENDDO
+
+ DEALLOCATE( r, vad, wrk_spline )
+ IF ( long_filter_factor /= 0.0 ) DEALLOCATE( tf, wrk_long )
+
+ END SUBROUTINE spline_z
Index: /palm/tags/release-3.4a/SOURCE/sum_up_3d_data.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/sum_up_3d_data.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/sum_up_3d_data.f90 (revision 141)
@@ -0,0 +1,450 @@
+ SUBROUTINE sum_up_3d_data
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 96 2007-06-04 08:07:41Z raasch
+! +sum-up of density and salinity
+!
+! 72 2007-03-19 08:20:46Z raasch
+! +sum-up of precipitation rate and roughness length (prr*, z0*)
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.1 2006/02/23 12:55:23 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Sum-up the values of 3d-arrays. The real averaging is later done in routine
+! average_3d_data.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE averaging
+ USE cloud_parameters
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE particle_attributes
+
+ IMPLICIT NONE
+
+ INTEGER :: i, ii, j, k, n, psi
+
+ REAL :: mean_r, s_r3, s_r4
+
+
+ CALL cpu_log (log_point(34),'sum_up_3d_data','start')
+
+!
+!-- Allocate and initialize the summation arrays if called for the very first
+!-- time or the first time after average_3d_data has been called
+!-- (some or all of the arrays may have been already allocated
+!-- in read_3d_binary)
+ IF ( average_count_3d == 0 ) THEN
+
+ DO ii = 1, doav_n
+
+ SELECT CASE ( TRIM( doav(ii) ) )
+
+ CASE ( 'e' )
+ IF ( .NOT. ALLOCATED( e_av ) ) THEN
+ ALLOCATE( e_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ e_av = 0.0
+
+ CASE ( 'lwp*' )
+ IF ( .NOT. ALLOCATED( lwp_av ) ) THEN
+ ALLOCATE( lwp_av(nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ lwp_av = 0.0
+
+ CASE ( 'p' )
+ IF ( .NOT. ALLOCATED( p_av ) ) THEN
+ ALLOCATE( p_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ p_av = 0.0
+
+ CASE ( 'pc' )
+ IF ( .NOT. ALLOCATED( pc_av ) ) THEN
+ ALLOCATE( pc_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ pc_av = 0.0
+
+ CASE ( 'pr' )
+ IF ( .NOT. ALLOCATED( pr_av ) ) THEN
+ ALLOCATE( pr_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ pr_av = 0.0
+
+ CASE ( 'prr*' )
+ IF ( .NOT. ALLOCATED( precipitation_rate_av ) ) THEN
+ ALLOCATE( precipitation_rate_av(nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ precipitation_rate_av = 0.0
+
+ CASE ( 'pt' )
+ IF ( .NOT. ALLOCATED( pt_av ) ) THEN
+ ALLOCATE( pt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ pt_av = 0.0
+
+ CASE ( 'q' )
+ IF ( .NOT. ALLOCATED( q_av ) ) THEN
+ ALLOCATE( q_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ q_av = 0.0
+
+ CASE ( 'ql' )
+ IF ( .NOT. ALLOCATED( ql_av ) ) THEN
+ ALLOCATE( ql_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ ql_av = 0.0
+
+ CASE ( 'ql_c' )
+ IF ( .NOT. ALLOCATED( ql_c_av ) ) THEN
+ ALLOCATE( ql_c_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ ql_c_av = 0.0
+
+ CASE ( 'ql_v' )
+ IF ( .NOT. ALLOCATED( ql_v_av ) ) THEN
+ ALLOCATE( ql_v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ ql_v_av = 0.0
+
+ CASE ( 'ql_vp' )
+ IF ( .NOT. ALLOCATED( ql_vp_av ) ) THEN
+ ALLOCATE( ql_vp_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ ql_vp_av = 0.0
+
+ CASE ( 'qv' )
+ IF ( .NOT. ALLOCATED( qv_av ) ) THEN
+ ALLOCATE( qv_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ qv_av = 0.0
+
+ CASE ( 'rho' )
+ IF ( .NOT. ALLOCATED( rho_av ) ) THEN
+ ALLOCATE( rho_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ rho_av = 0.0
+
+ CASE ( 's' )
+ IF ( .NOT. ALLOCATED( s_av ) ) THEN
+ ALLOCATE( s_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ s_av = 0.0
+
+ CASE ( 'sa' )
+ IF ( .NOT. ALLOCATED( sa_av ) ) THEN
+ ALLOCATE( sa_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ sa_av = 0.0
+
+ CASE ( 't*' )
+ IF ( .NOT. ALLOCATED( ts_av ) ) THEN
+ ALLOCATE( ts_av(nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ ts_av = 0.0
+
+ CASE ( 'u' )
+ IF ( .NOT. ALLOCATED( u_av ) ) THEN
+ ALLOCATE( u_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ u_av = 0.0
+
+ CASE ( 'u*' )
+ IF ( .NOT. ALLOCATED( us_av ) ) THEN
+ ALLOCATE( us_av(nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ us_av = 0.0
+
+ CASE ( 'v' )
+ IF ( .NOT. ALLOCATED( v_av ) ) THEN
+ ALLOCATE( v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ v_av = 0.0
+
+ CASE ( 'vpt' )
+ IF ( .NOT. ALLOCATED( vpt_av ) ) THEN
+ ALLOCATE( vpt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ vpt_av = 0.0
+
+ CASE ( 'w' )
+ IF ( .NOT. ALLOCATED( w_av ) ) THEN
+ ALLOCATE( w_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ w_av = 0.0
+
+ CASE ( 'z0*' )
+ IF ( .NOT. ALLOCATED( z0_av ) ) THEN
+ ALLOCATE( z0_av(nys-1:nyn+1,nxl-1:nxr+1) )
+ ENDIF
+ z0_av = 0.0
+
+ CASE DEFAULT
+!
+!-- User-defined quantity
+ CALL user_3d_data_averaging( 'allocate', doav(ii) )
+
+ END SELECT
+
+ ENDDO
+
+ ENDIF
+
+!
+!-- Loop of all variables to be averaged.
+ DO ii = 1, doav_n
+
+!
+!-- Store the array chosen on the temporary array.
+ SELECT CASE ( TRIM( doav(ii) ) )
+
+ CASE ( 'e' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ e_av(k,j,i) = e_av(k,j,i) + e(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'lwp*' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ lwp_av(j,i) = lwp_av(j,i) + SUM( ql(nzb:nzt,j,i) * &
+ dzw(1:nzt+1) )
+ ENDDO
+ ENDDO
+
+ CASE ( 'p' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ p_av(k,j,i) = p_av(k,j,i) + p(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'pc' )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb, nzt+1
+ pc_av(k,j,i) = pc_av(k,j,i) + prt_count(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'pr' )
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb, nzt+1
+ psi = prt_start_index(k,j,i)
+ s_r3 = 0.0
+ s_r4 = 0.0
+ DO n = psi, psi+prt_count(k,j,i)-1
+ s_r3 = s_r3 + particles(n)%radius**3
+ s_r4 = s_r4 + particles(n)%radius**4
+ ENDDO
+ IF ( s_r3 /= 0.0 ) THEN
+ mean_r = s_r4 / s_r3
+ ELSE
+ mean_r = 0.0
+ ENDIF
+ pr_av(k,j,i) = pr_av(k,j,i) + mean_r
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'pr*' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ precipitation_rate_av(j,i) = precipitation_rate_av(j,i) + &
+ precipitation_rate(j,i)
+ ENDDO
+ ENDDO
+
+ CASE ( 'pt' )
+ IF ( .NOT. cloud_physics ) THEN
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSE
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ pt_av(k,j,i) = pt_av(k,j,i) + pt(k,j,i) + l_d_cp * &
+ pt_d_t(k) * ql(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+ CASE ( 'q' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ q_av(k,j,i) = q_av(k,j,i) + q(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'ql' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ ql_av(k,j,i) = ql_av(k,j,i) + ql(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'ql_c' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ ql_c_av(k,j,i) = ql_c_av(k,j,i) + ql_c(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'ql_v' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ ql_v_av(k,j,i) = ql_v_av(k,j,i) + ql_v(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'ql_vp' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ ql_vp_av(k,j,i) = ql_vp_av(k,j,i) + ql_vp(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'qv' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ qv_av(k,j,i) = qv_av(k,j,i) + q(k,j,i) - ql(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'rho' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ rho_av(k,j,i) = rho_av(k,j,i) + rho(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 's' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ s_av(k,j,i) = s_av(k,j,i) + q(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'sa' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ sa_av(k,j,i) = sa_av(k,j,i) + sa(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 't*' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ ts_av(j,i) = ts_av(j,i) + ts(j,i)
+ ENDDO
+ ENDDO
+
+ CASE ( 'u' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ u_av(k,j,i) = u_av(k,j,i) + u(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'u*' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ us_av(j,i) = us_av(j,i) + us(j,i)
+ ENDDO
+ ENDDO
+
+ CASE ( 'v' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ v_av(k,j,i) = v_av(k,j,i) + v(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'vpt' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ vpt_av(k,j,i) = vpt_av(k,j,i) + vpt(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'w' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ DO k = nzb, nzt+1
+ w_av(k,j,i) = w_av(k,j,i) + w(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ CASE ( 'z0*' )
+ DO i = nxl-1, nxr+1
+ DO j = nys-1, nyn+1
+ z0_av(j,i) = z0_av(j,i) + z0(j,i)
+ ENDDO
+ ENDDO
+
+ CASE DEFAULT
+!
+!-- User-defined quantity
+ CALL user_3d_data_averaging( 'sum', doav(ii) )
+
+ END SELECT
+
+ ENDDO
+
+ CALL cpu_log (log_point(34),'sum_up_3d_data','stop','nobarrier')
+
+
+ END SUBROUTINE sum_up_3d_data
Index: /palm/tags/release-3.4a/SOURCE/surface_coupler.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/surface_coupler.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/surface_coupler.f90 (revision 141)
@@ -0,0 +1,203 @@
+ SUBROUTINE surface_coupler
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! ------------------
+! $Id$
+!
+! 109 2007-08-28 15:26:47Z letzel
+! Initial revision
+!
+! Description:
+! ------------
+! Data exchange at the interface between coupled models
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE pegrid
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL :: simulated_time_remote
+
+#if defined( __parallel ) && defined( __mpi2 )
+
+ CALL cpu_log( log_point(39), 'surface_coupler', 'start' )
+
+!
+!-- In case of model termination initiated by the remote model
+!-- (terminate_coupled_remote > 0), initiate termination of the local model.
+!-- The rest of the coupler must then be skipped because it would cause an MPI
+!-- intercomminucation hang.
+!-- If necessary, the coupler will be called at the beginning of the next
+!-- restart run.
+ CALL MPI_SENDRECV( terminate_coupled, 1, MPI_INTEGER, myid, 0, &
+ terminate_coupled_remote, 1, MPI_INTEGER, myid, 0, &
+ comm_inter, status, ierr )
+ IF ( terminate_coupled_remote > 0 ) THEN
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ surface_coupler:'
+ PRINT*, ' remote model "', TRIM( coupling_mode_remote ), &
+ '" terminated'
+ PRINT*, ' with terminate_coupled_remote = ', &
+ terminate_coupled_remote
+ PRINT*, ' local model "', TRIM( coupling_mode ), &
+ '" has'
+ PRINT*, ' terminate_coupled = ', &
+ terminate_coupled
+ ENDIF
+ CALL local_stop
+ RETURN
+ ENDIF
+!
+!-- Exchange the current simulated time between the models,
+!-- currently just for testing
+ CALL MPI_SEND( simulated_time, 1, MPI_REAL, myid, 11, comm_inter, ierr )
+ CALL MPI_RECV( simulated_time_remote, 1, MPI_REAL, myid, 11, &
+ comm_inter, status, ierr )
+ WRITE ( 9, * ) simulated_time, ' remote: ', simulated_time_remote
+ CALL local_flush( 9 )
+
+!
+!-- Exchange the interface data
+ IF ( coupling_mode == 'atmosphere_to_ocean' ) THEN
+
+!
+!-- Send heat flux at bottom surface to the ocean model
+ WRITE ( 9, * ) '*** send shf to ocean'
+ CALL local_flush( 9 )
+ CALL MPI_SEND( shf(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 12, &
+ comm_inter, ierr )
+ WRITE ( 9, * ) ' ready'
+ CALL local_flush( 9 )
+
+!
+!-- Send humidity flux at bottom surface to the ocean model
+ IF ( humidity ) THEN
+ WRITE ( 9, * ) '*** send qsws to ocean'
+ CALL local_flush( 9 )
+ CALL MPI_SEND( qsws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 13, &
+ comm_inter, ierr )
+ WRITE ( 9, * ) ' ready'
+ CALL local_flush( 9 )
+ ENDIF
+
+!
+!-- Receive temperature at the bottom surface from the ocean model
+ WRITE ( 9, * ) '*** receive pt from ocean'
+ CALL local_flush( 9 )
+ CALL MPI_RECV( pt(0,nys-1,nxl-1), 1, type_xy, myid, 14, comm_inter, &
+ status, ierr )
+ WRITE ( 9, * ) ' ready'
+ CALL local_flush( 9 )
+
+!
+!-- Send the momentum flux (u) at bottom surface to the ocean model
+ WRITE ( 9, * ) '*** send usws to ocean'
+ CALL local_flush( 9 )
+ CALL MPI_SEND( usws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 15, &
+ comm_inter, ierr )
+ WRITE ( 9, * ) ' ready'
+ CALL local_flush( 9 )
+
+!
+!-- Send the momentum flux (v) at bottom surface to the ocean model
+ WRITE ( 9, * ) '*** send vsws to ocean'
+ CALL local_flush( 9 )
+ CALL MPI_SEND( vsws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 16, &
+ comm_inter, ierr )
+ WRITE ( 9, * ) ' ready'
+ CALL local_flush( 9 )
+
+ ELSEIF ( coupling_mode == 'ocean_to_atmosphere' ) THEN
+
+!
+!-- Receive heat flux at the sea surface (top) from the atmosphere model
+ WRITE ( 9, * ) '*** receive tswst from atmosphere'
+ CALL local_flush( 9 )
+ CALL MPI_RECV( tswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 12, &
+ comm_inter, status, ierr )
+ WRITE ( 9, * ) ' ready'
+ CALL local_flush( 9 )
+
+!
+!-- Receive humidity flux from the atmosphere model (bottom)
+!-- and add it to the heat flux at the sea surface (top)...
+ IF ( humidity_remote ) THEN
+ WRITE ( 9, * ) '*** receive qswst_remote from atmosphere'
+ CALL local_flush( 9 )
+ CALL MPI_RECV( qswst_remote(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, &
+ 13, comm_inter, status, ierr )
+ WRITE ( 9, * ) ' ready'
+ CALL local_flush( 9 )
+
+ !here tswst is still the sum of atmospheric bottom heat fluxes
+ tswst = tswst + qswst_remote * 2.2626108e6 / 1005.0
+ !*latent heat of vaporization in m2/s2, or 540 cal/g, or 40.65 kJ/mol
+ !/(rho_atm(=1.0)*c_p)
+!
+!-- ...and convert it to a salinity flux at the sea surface (top)
+!-- following Steinhorn (1991), JPO 21, pp. 1681-1683:
+!-- S'w' = -S * evaporation / ( rho_water * ( 1 - S ) )
+ saswst = -1.0 * sa(nzt,:,:) * qswst_remote / &
+ ( rho(nzt,:,:) * ( 1.0 - sa(nzt,:,:) ) )
+ ENDIF
+
+!
+!-- Adjust the kinematic heat flux with respect to ocean density
+!-- (constants are the specific heat capacities for air and water)
+ !now tswst is the ocean top heat flux
+ tswst = tswst / rho(nzt,:,:) * 1005.0 / 4218.0
+
+!
+!-- Send sea surface temperature to the atmosphere model
+ WRITE ( 9, * ) '*** send pt to atmosphere'
+ CALL local_flush( 9 )
+ CALL MPI_SEND( pt(nzt,nys-1,nxl-1), 1, type_xy, myid, 14, comm_inter, &
+ ierr )
+ WRITE ( 9, * ) ' ready'
+ CALL local_flush( 9 )
+
+!
+!-- Receive momentum flux (u) at the sea surface (top) from the atmosphere
+!-- model
+ WRITE ( 9, * ) '*** receive uswst from atmosphere'
+ CALL local_flush( 9 )
+ CALL MPI_RECV( uswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 15, &
+ comm_inter, status, ierr )
+ WRITE ( 9, * ) ' ready'
+ CALL local_flush( 9 )
+
+!
+!-- Receive momentum flux (v) at the sea surface (top) from the atmosphere
+!-- model
+ WRITE ( 9, * ) '*** receive vswst from atmosphere'
+ CALL local_flush( 9 )
+ CALL MPI_RECV( vswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 16, &
+ comm_inter, status, ierr )
+ WRITE ( 9, * ) ' ready'
+ CALL local_flush( 9 )
+
+!
+!-- Adjust the momentum fluxes with respect to ocean density
+ uswst = uswst / rho(nzt,:,:)
+ vswst = vswst / rho(nzt,:,:)
+
+ ENDIF
+
+ CALL cpu_log( log_point(39), 'surface_coupler', 'stop' )
+
+#endif
+
+ END SUBROUTINE surface_coupler
Index: /palm/tags/release-3.4a/SOURCE/swap_timelevel.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/swap_timelevel.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/swap_timelevel.f90 (revision 141)
@@ -0,0 +1,212 @@
+ SUBROUTINE swap_timelevel
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 102 2007-07-27 09:09:17Z raasch
+! swaping of uswst, vswst included
+!
+! 95 2007-06-02 16:48:38Z raasch
+! Swaping of salinity
+!
+! 75 2007-03-22 09:54:05Z raasch
+! moisture renamed humidity
+!
+! 19 2007-02-23 04:53:48Z raasch
+! Swaping of top fluxes
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.8 2004/01/28 15:28:18 raasch
+! Swaping for Runge-Kutta schemes implemented
+!
+! Revision 1.1 2000/01/10 10:08:58 10:08:58 raasch (Siegfried Raasch)
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Swap of timelevels of variables after each timestep
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE cpulog
+ USE interfaces
+ USE control_parameters
+
+ IMPLICIT NONE
+
+
+ CALL cpu_log( log_point(28), 'swap_timelevel', 'start' )
+
+!
+!-- Incrementing timestep counter
+ timestep_count = timestep_count + 1
+
+!
+!-- Swap of 3-level variables
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+
+ SELECT CASE ( MOD( timestep_count, 3 ) )
+
+ CASE ( 0 )
+
+ u_m => u_1; u => u_2; u_p => u_3
+ v_m => v_1; v => v_2; v_p => v_3
+ w_m => w_1; w => w_2; w_p => w_3
+ pt_m => pt_1; pt => pt_2; pt_p => pt_3
+ IF ( .NOT. constant_diffusion ) THEN
+ e_m => e_1; e => e_2; e_p => e_3
+ ENDIF
+ IF ( humidity .OR. passive_scalar ) THEN
+ q_m => q_1; q => q_2; q_p => q_3
+ ENDIF
+
+ CASE ( 1 )
+
+ u_m => u_2; u => u_3; u_p => u_1
+ v_m => v_2; v => v_3; v_p => v_1
+ w_m => w_2; w => w_3; w_p => w_1
+ pt_m => pt_2; pt => pt_3; pt_p => pt_1
+ IF ( .NOT. constant_diffusion ) THEN
+ e_m => e_2; e => e_3; e_p => e_1
+ ENDIF
+ IF ( humidity .OR. passive_scalar ) THEN
+ q_m => q_2; q => q_3; q_p => q_1
+ ENDIF
+
+ CASE ( 2 )
+
+ u_m => u_3; u => u_1; u_p => u_2
+ v_m => v_3; v => v_1; v_p => v_2
+ w_m => w_3; w => w_1; w_p => w_2
+ pt_m => pt_3; pt => pt_1; pt_p => pt_2
+ IF ( .NOT. constant_diffusion ) THEN
+ e_m => e_3; e => e_1; e_p => e_2
+ ENDIF
+ IF ( humidity .OR. passive_scalar ) THEN
+ q_m => q_3; q => q_1; q_p => q_2
+ ENDIF
+
+ END SELECT
+
+ ENDIF
+
+!
+!-- Swap of 2-level variables
+ SELECT CASE ( MOD( timestep_count, 2 ) )
+
+ CASE ( 0 )
+
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+
+ u => u_1; u_p => u_2
+ v => v_1; v_p => v_2
+ w => w_1; w_p => w_2
+ pt => pt_1; pt_p => pt_2
+ IF ( .NOT. constant_diffusion ) THEN
+ e => e_1; e_p => e_2
+ ENDIF
+ IF ( ocean ) THEN
+ sa => sa_1; sa_p => sa_2
+ ENDIF
+ IF ( humidity .OR. passive_scalar ) THEN
+ q => q_1; q_p => q_2
+ ENDIF
+
+ ELSE
+!
+!-- Old timelevels are needed for explicit diffusion within leapfrog
+ IF ( .NOT. constant_diffusion ) THEN
+ kh_m => kh_1; kh => kh_2
+ km_m => km_1; km => km_2
+ IF ( use_surface_fluxes ) THEN
+ usws_m => usws_1; usws => usws_2
+ vsws_m => vsws_1; vsws => vsws_2
+ shf_m => shf_1; shf => shf_2
+ IF ( humidity .OR. passive_scalar ) THEN
+ qsws_m => qsws_1; qsws => qsws_2
+ ENDIF
+ ENDIF
+ IF ( prandtl_layer ) THEN
+ rif_m => rif_1; rif => rif_2
+ ENDIF
+ IF ( use_top_fluxes ) THEN
+ uswst_m => uswst_1; uswst => uswst_2
+ vswst_m => vswst_1; vswst => vswst_2
+ tswst_m => tswst_1; tswst => tswst_2
+ IF ( humidity .OR. passive_scalar ) THEN
+ qswst_m => qswst_1; qswst => qswst_2
+ ENDIF
+ ENDIF
+ ENDIF
+
+ IF ( humidity ) THEN
+ vpt_m => vpt_1; vpt => vpt_2
+ ENDIF
+
+ ENDIF
+
+ CASE ( 1 )
+
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+
+ u => u_2; u_p => u_1
+ v => v_2; v_p => v_1
+ w => w_2; w_p => w_1
+ pt => pt_2; pt_p => pt_1
+ IF ( .NOT. constant_diffusion ) THEN
+ e => e_2; e_p => e_1
+ ENDIF
+ IF ( ocean ) THEN
+ sa => sa_2; sa_p => sa_1
+ ENDIF
+ IF ( humidity .OR. passive_scalar ) THEN
+ q => q_2; q_p => q_1
+ ENDIF
+
+ ELSE
+
+ IF ( .NOT. constant_diffusion ) THEN
+ kh_m => kh_2; kh => kh_1
+ km_m => km_2; km => km_1
+ IF ( use_surface_fluxes ) THEN
+ usws_m => usws_2; usws => usws_1
+ vsws_m => vsws_2; vsws => vsws_1
+ shf_m => shf_2; shf => shf_1
+ IF ( humidity .OR. passive_scalar ) THEN
+ qsws_m => qsws_2; qsws => qsws_1
+ ENDIF
+ ENDIF
+ IF ( prandtl_layer ) THEN
+ rif_m => rif_2; rif => rif_1
+ ENDIF
+ IF ( use_top_fluxes ) THEN
+ uswst_m => uswst_2; uswst => uswst_1
+ vswst_m => vswst_2; vswst => vswst_1
+ tswst_m => tswst_2; tswst => tswst_1
+ IF ( humidity .OR. passive_scalar ) THEN
+ qswst_m => qswst_2; qswst => qswst_1
+ ENDIF
+ ENDIF
+ ENDIF
+
+ IF ( humidity ) THEN
+ vpt_m => vpt_2; vpt => vpt_1
+ ENDIF
+
+ ENDIF
+
+ END SELECT
+
+ CALL cpu_log( log_point(28), 'swap_timelevel', 'stop' )
+
+ END SUBROUTINE swap_timelevel
+
+
Index: /palm/tags/release-3.4a/SOURCE/temperton_fft.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/temperton_fft.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/temperton_fft.f90 (revision 141)
@@ -0,0 +1,1969 @@
+ MODULE temperton_fft
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.2 2003/04/16 12:49:25 raasch
+! Abort in case of illegal factors
+!
+! Revision 1.1 2003/03/12 16:41:59 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Fast Fourier transformation developed by Clive Temperton, ECMWF.
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ PRIVATE
+
+ PUBLIC set99, fft991cy
+
+
+ INTEGER :: nfax(10) ! array used by *fft991*.
+ REAL, ALLOCATABLE :: trig(:) ! array used by *fft991*.
+
+!
+!-- nfft: maximum length of calls to *fft.
+#if defined( __nec )
+ INTEGER, PARAMETER :: nfft = 256
+#else
+ INTEGER, PARAMETER :: nfft = 32
+#endif
+
+ INTEGER, PARAMETER :: nout = 6 ! standard output stream
+
+CONTAINS
+
+ SUBROUTINE fft991cy(a,work,trigs,ifax,inc,jump,n,lot,isign)
+
+ ! Description:
+ !
+ ! Calls fortran-versions of fft's.
+ !
+ ! Method:
+ !
+ ! Subroutine 'fft991cy' - multiple fast real periodic transform
+ ! supersedes previous routine 'fft991cy'.
+ !
+ ! Real transform of length n performed by removing redundant
+ ! operations from complex transform of length n.
+ !
+ ! a is the array containing input & output data.
+ ! work is an area of size (n+1)*min(lot,nfft).
+ ! trigs is a previously prepared list of trig function values.
+ ! ifax is a previously prepared list of factors of n.
+ ! inc is the increment within each data 'vector'
+ ! (e.g. inc=1 for consecutively stored data).
+ ! jump is the increment between the start of each data vector.
+ ! n is the length of the data vectors.
+ ! lot is the number of data vectors.
+ ! isign = +1 for transform from spectral to gridpoint
+ ! = -1 for transform from gridpoint to spectral.
+ !
+ ! ordering of coefficients:
+ ! a(0),b(0),a(1),b(1),a(2),b(2),.,a(n/2),b(n/2)
+ ! where b(0)=b(n/2)=0; (n+2) locations required.
+ !
+ ! ordering of data:
+ ! x(0),x(1),x(2),.,x(n-1), 0 , 0 ; (n+2) locations required.
+ !
+ ! Vectorization is achieved on cray by doing the transforms
+ ! in parallel.
+ !
+ ! n must be composed of factors 2,3 & 5 but does not have to be even.
+ !
+ ! definition of transforms:
+ !
+ ! isign=+1: x(j)=sum(k=0,.,n-1)(c(k)*exp(2*i*j*k*pi/n))
+ ! where c(k)=a(k)+i*b(k) and c(n-k)=a(k)-i*b(k)
+
+ ! isign=-1: a(k)=(1/n)*sum(j=0,.,n-1)(x(j)*cos(2*j*k*pi/n))
+ ! b(k)=-(1/n)*sum(j=0,.,n-1)(x(j)*sin(2*j*k*pi/n))
+
+ ! calls fortran-versions of fft's !!!
+ ! dimension a(n),work(n),trigs(n),ifax(1)
+
+
+ IMPLICIT NONE
+
+ ! Scalar arguments
+ INTEGER :: inc, isign, jump, lot, n
+
+ ! Array arguments
+ REAL :: a(*), trigs(*), work(*)
+ INTEGER :: ifax(*)
+
+ ! Local scalars:
+ INTEGER :: i, ia, ibase, ierr, ifac, igo, ii, istart, ix, iz, j, jbase, jj, &
+ & k, la, nb, nblox, nfax, nvex, nx
+
+ ! Intrinsic functions
+ INTRINSIC MOD
+
+
+ ! Executable statements
+
+ IF (ifax(10)/=n) CALL set99(trigs,ifax,n)
+ nfax = ifax(1)
+ nx = n + 1
+ IF (MOD(n,2)==1) nx = n
+ nblox = 1 + (lot-1)/nfft
+ nvex = lot - (nblox-1)*nfft
+ IF (isign==-1) GO TO 50
+
+ ! isign=+1, spectral to gridpoint transform
+
+ istart = 1
+ DO nb = 1, nblox
+ ia = istart
+ i = istart
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO j = 1, nvex
+ a(i+inc) = 0.5*a(i)
+ i = i + jump
+ END DO
+ IF (MOD(n,2)==1) GO TO 10
+ i = istart + n*inc
+ DO j = 1, nvex
+ a(i) = 0.5*a(i)
+ i = i + jump
+ END DO
+10 CONTINUE
+ ia = istart + inc
+ la = 1
+ igo = + 1
+
+ DO k = 1, nfax
+ ifac = ifax(k+1)
+ ierr = -1
+ IF (igo==-1) GO TO 20
+ CALL rpassm(a(ia),a(ia+la*inc),work(1),work(ifac*la+1),trigs,inc,1, &
+ & jump,nx,nvex,n,ifac,la,ierr)
+ GO TO 30
+20 CONTINUE
+ CALL rpassm(work(1),work(la+1),a(ia),a(ia+ifac*la*inc),trigs,1,inc,nx, &
+ & jump,nvex,n,ifac,la,ierr)
+30 CONTINUE
+ IF (ierr/=0) GO TO 100
+ la = ifac*la
+ igo = -igo
+ ia = istart
+ END DO
+
+ ! If necessary, copy results back to a
+
+ IF (MOD(nfax,2)==0) GO TO 40
+ ibase = 1
+ jbase = ia
+ DO jj = 1, nvex
+ i = ibase
+ j = jbase
+ DO ii = 1, n
+ a(j) = work(i)
+ i = i + 1
+ j = j + inc
+ END DO
+ ibase = ibase + nx
+ jbase = jbase + jump
+ END DO
+40 CONTINUE
+
+ ! Fill in zeros at end
+
+ ix = istart + n*inc
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO j = 1, nvex
+ a(ix) = 0.0
+ a(ix+inc) = 0.0
+ ix = ix + jump
+ END DO
+
+ istart = istart + nvex*jump
+ nvex = nfft
+ END DO
+ RETURN
+
+ ! isign=-1, gridpoint to spectral transform
+
+50 CONTINUE
+ istart = 1
+ DO nb = 1, nblox
+ ia = istart
+ la = n
+ igo = + 1
+
+ DO k = 1, nfax
+ ifac = ifax(nfax+2-k)
+ la = la/ifac
+ ierr = -1
+ IF (igo==-1) GO TO 60
+ CALL qpassm(a(ia),a(ia+ifac*la*inc),work(1),work(la+1),trigs,inc,1, &
+ & jump,nx,nvex,n,ifac,la,ierr)
+ GO TO 70
+60 CONTINUE
+ CALL qpassm(work(1),work(ifac*la+1),a(ia),a(ia+la*inc),trigs,1,inc,nx, &
+ & jump,nvex,n,ifac,la,ierr)
+70 CONTINUE
+ IF (ierr/=0) GO TO 100
+ igo = -igo
+ ia = istart + inc
+ END DO
+
+ ! If necessary, copy results back to a
+
+ IF (MOD(nfax,2)==0) GO TO 80
+ ibase = 1
+ jbase = ia
+ DO jj = 1, nvex
+ i = ibase
+ j = jbase
+ DO ii = 1, n
+ a(j) = work(i)
+ i = i + 1
+ j = j + inc
+ END DO
+ ibase = ibase + nx
+ jbase = jbase + jump
+ END DO
+80 CONTINUE
+
+ ! Shift a(0) & fill in zero imag parts
+
+ ix = istart
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO j = 1, nvex
+ a(ix) = a(ix+inc)
+ a(ix+inc) = 0.0
+ ix = ix + jump
+ END DO
+ IF (MOD(n,2)==1) GO TO 90
+ iz = istart + (n+1)*inc
+ DO j = 1, nvex
+ a(iz) = 0.0
+ iz = iz + jump
+ END DO
+90 CONTINUE
+
+ istart = istart + nvex*jump
+ nvex = nfft
+ END DO
+ RETURN
+
+ ! Error messages
+
+100 CONTINUE
+
+ SELECT CASE (ierr)
+ CASE (:-1)
+ WRITE (nout,'(A,I5,A)') ' Vector length =',nvex,', greater than nfft'
+ CASE (0)
+ WRITE (nout,'(A,I3,A)') ' Factor =',ifac,', not catered for'
+ CASE (1:)
+ WRITE (nout,'(A,I3,A)') ' Factor =',ifac,', only catered for if la*ifac=n'
+ END SELECT
+
+ RETURN
+ END SUBROUTINE fft991cy
+
+ SUBROUTINE qpassm(a,b,c,d,trigs,inc1,inc2,inc3,inc4,lot,n,ifac,la,ierr)
+
+ ! Description:
+ !
+ ! Performs one pass through data as part of
+ ! multiple real fft (fourier analysis) routine.
+ !
+ ! Method:
+ !
+ ! a is first real input vector
+ ! equivalence b(1) with a(ifac*la*inc1+1)
+ ! c is first real output vector
+ ! equivalence d(1) with c(la*inc2+1)
+ ! trigs is a precalculated list of sines & cosines
+ ! inc1 is the addressing increment for a
+ ! inc2 is the addressing increment for c
+ ! inc3 is the increment between input vectors a
+ ! inc4 is the increment between output vectors c
+ ! lot is the number of vectors
+ ! n is the length of the vectors
+ ! ifac is the current factor of n
+ ! la = n/(product of factors used so far)
+ ! ierr is an error indicator:
+ ! 0 - pass completed without error
+ ! 1 - lot greater than nfft
+ ! 2 - ifac not catered for
+ ! 3 - ifac only catered for if la=n/ifac
+ !
+
+ IMPLICIT NONE
+
+ ! Scalar arguments
+ INTEGER :: ierr, ifac, inc1, inc2, inc3, inc4, la, lot, n
+
+ ! Array arguments
+ ! REAL :: a(n),b(n),c(n),d(n),trigs(n)
+ REAL :: a(*), b(*), c(*), d(*), trigs(*)
+
+ ! Local scalars:
+ REAL :: a0, a1, a10, a11, a2, a20, a21, a3, a4, a5, a6, b0, b1, b10, b11, &
+ & b2, b20, b21, b3, b4, b5, b6, c1, c2, c3, c4, c5, qrt5, s1, s2, s3, s4, &
+ & s5, sin36, sin45, sin60, sin72, z, zqrt5, zsin36, zsin45, zsin60, &
+ & zsin72
+ INTEGER :: i, ia, ib, ibad, ibase, ic, id, ie, if, ig, igo, ih, iink, ijk, &
+ & ijump, j, ja, jb, jbase, jc, jd, je, jf, jink, k, kb, kc, kd, ke, kf, &
+ & kstop, l, m
+
+ ! Intrinsic functions
+ INTRINSIC REAL, SQRT
+
+ ! Data statements
+ DATA sin36/0.587785252292473/, sin72/0.951056516295154/, &
+ & qrt5/0.559016994374947/, sin60/0.866025403784437/
+
+
+ ! Executable statements
+
+ m = n/ifac
+ iink = la*inc1
+ jink = la*inc2
+ ijump = (ifac-1)*iink
+ kstop = (n-ifac)/(2*ifac)
+
+ ibad = 1
+ IF (lot>nfft) GO TO 180
+ ibase = 0
+ jbase = 0
+ igo = ifac - 1
+ IF (igo==7) igo = 6
+ ibad = 2
+ IF (igo<1 .OR. igo>6) GO TO 180
+ GO TO (10,40,70,100,130,160) igo
+
+ ! Coding for factor 2
+
+10 CONTINUE
+ ia = 1
+ ib = ia + iink
+ ja = 1
+ jb = ja + (2*m-la)*inc2
+
+ IF (la==m) GO TO 30
+
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = a(ia+i) + a(ib+i)
+ c(jb+j) = a(ia+i) - a(ib+i)
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ja = ja + jink
+ jink = 2*jink
+ jb = jb - jink
+ ibase = ibase + ijump
+ ijump = 2*ijump + iink
+ IF (ja==jb) GO TO 20
+ DO k = la, kstop, la
+ kb = k + k
+ c1 = trigs(kb+1)
+ s1 = trigs(kb+2)
+ jbase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = a(ia+i) + (c1*a(ib+i)+s1*b(ib+i))
+ c(jb+j) = a(ia+i) - (c1*a(ib+i)+s1*b(ib+i))
+ d(ja+j) = (c1*b(ib+i)-s1*a(ib+i)) + b(ia+i)
+ d(jb+j) = (c1*b(ib+i)-s1*a(ib+i)) - b(ia+i)
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ibase = ibase + ijump
+ ja = ja + jink
+ jb = jb - jink
+ END DO
+ IF (ja>jb) GO TO 170
+20 CONTINUE
+ jbase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = a(ia+i)
+ d(ja+j) = -a(ib+i)
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+
+ GO TO 170
+30 CONTINUE
+ z = 1.0/REAL(n)
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = z*(a(ia+i)+a(ib+i))
+ c(jb+j) = z*(a(ia+i)-a(ib+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ GO TO 170
+
+ ! Coding for factor 3
+
+40 CONTINUE
+ ia = 1
+ ib = ia + iink
+ ic = ib + iink
+ ja = 1
+ jb = ja + (2*m-la)*inc2
+ jc = jb
+
+ IF (la==m) GO TO 60
+
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = a(ia+i) + (a(ib+i)+a(ic+i))
+ c(jb+j) = a(ia+i) - 0.5*(a(ib+i)+a(ic+i))
+ d(jb+j) = sin60*(a(ic+i)-a(ib+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ja = ja + jink
+ jink = 2*jink
+ jb = jb + jink
+ jc = jc - jink
+ ibase = ibase + ijump
+ ijump = 2*ijump + iink
+ IF (ja==jc) GO TO 50
+ DO k = la, kstop, la
+ kb = k + k
+ kc = kb + kb
+ c1 = trigs(kb+1)
+ s1 = trigs(kb+2)
+ c2 = trigs(kc+1)
+ s2 = trigs(kc+2)
+ jbase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ a1 = (c1*a(ib+i)+s1*b(ib+i)) + (c2*a(ic+i)+s2*b(ic+i))
+ b1 = (c1*b(ib+i)-s1*a(ib+i)) + (c2*b(ic+i)-s2*a(ic+i))
+ a2 = a(ia+i) - 0.5*a1
+ b2 = b(ia+i) - 0.5*b1
+ a3 = sin60*((c1*a(ib+i)+s1*b(ib+i))-(c2*a(ic+i)+s2*b(ic+i)))
+ b3 = sin60*((c1*b(ib+i)-s1*a(ib+i))-(c2*b(ic+i)-s2*a(ic+i)))
+ c(ja+j) = a(ia+i) + a1
+ d(ja+j) = b(ia+i) + b1
+ c(jb+j) = a2 + b3
+ d(jb+j) = b2 - a3
+ c(jc+j) = a2 - b3
+ d(jc+j) = -(b2+a3)
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ibase = ibase + ijump
+ ja = ja + jink
+ jb = jb + jink
+ jc = jc - jink
+ END DO
+ IF (ja>jc) GO TO 170
+50 CONTINUE
+ jbase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = a(ia+i) + 0.5*(a(ib+i)-a(ic+i))
+ d(ja+j) = -sin60*(a(ib+i)+a(ic+i))
+ c(jb+j) = a(ia+i) - (a(ib+i)-a(ic+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+
+ GO TO 170
+60 CONTINUE
+ z = 1.0/REAL(n)
+ zsin60 = z*sin60
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = z*(a(ia+i)+(a(ib+i)+a(ic+i)))
+ c(jb+j) = z*(a(ia+i)-0.5*(a(ib+i)+a(ic+i)))
+ d(jb+j) = zsin60*(a(ic+i)-a(ib+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ GO TO 170
+
+ ! Coding for factor 4
+
+70 CONTINUE
+ ia = 1
+ ib = ia + iink
+ ic = ib + iink
+ id = ic + iink
+ ja = 1
+ jb = ja + (2*m-la)*inc2
+ jc = jb + 2*m*inc2
+ jd = jb
+
+ IF (la==m) GO TO 90
+
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = (a(ia+i)+a(ic+i)) + (a(ib+i)+a(id+i))
+ c(jc+j) = (a(ia+i)+a(ic+i)) - (a(ib+i)+a(id+i))
+ c(jb+j) = a(ia+i) - a(ic+i)
+ d(jb+j) = a(id+i) - a(ib+i)
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ja = ja + jink
+ jink = 2*jink
+ jb = jb + jink
+ jc = jc - jink
+ jd = jd - jink
+ ibase = ibase + ijump
+ ijump = 2*ijump + iink
+ IF (jb==jc) GO TO 80
+ DO k = la, kstop, la
+ kb = k + k
+ kc = kb + kb
+ kd = kc + kb
+ c1 = trigs(kb+1)
+ s1 = trigs(kb+2)
+ c2 = trigs(kc+1)
+ s2 = trigs(kc+2)
+ c3 = trigs(kd+1)
+ s3 = trigs(kd+2)
+ jbase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ a0 = a(ia+i) + (c2*a(ic+i)+s2*b(ic+i))
+ a2 = a(ia+i) - (c2*a(ic+i)+s2*b(ic+i))
+ a1 = (c1*a(ib+i)+s1*b(ib+i)) + (c3*a(id+i)+s3*b(id+i))
+ a3 = (c1*a(ib+i)+s1*b(ib+i)) - (c3*a(id+i)+s3*b(id+i))
+ b0 = b(ia+i) + (c2*b(ic+i)-s2*a(ic+i))
+ b2 = b(ia+i) - (c2*b(ic+i)-s2*a(ic+i))
+ b1 = (c1*b(ib+i)-s1*a(ib+i)) + (c3*b(id+i)-s3*a(id+i))
+ b3 = (c1*b(ib+i)-s1*a(ib+i)) - (c3*b(id+i)-s3*a(id+i))
+ c(ja+j) = a0 + a1
+ c(jc+j) = a0 - a1
+ d(ja+j) = b0 + b1
+ d(jc+j) = b1 - b0
+ c(jb+j) = a2 + b3
+ c(jd+j) = a2 - b3
+ d(jb+j) = b2 - a3
+ d(jd+j) = -(b2+a3)
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ibase = ibase + ijump
+ ja = ja + jink
+ jb = jb + jink
+ jc = jc - jink
+ jd = jd - jink
+ END DO
+ IF (jb>jc) GO TO 170
+80 CONTINUE
+ sin45 = SQRT(0.5)
+ jbase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = a(ia+i) + sin45*(a(ib+i)-a(id+i))
+ c(jb+j) = a(ia+i) - sin45*(a(ib+i)-a(id+i))
+ d(ja+j) = -a(ic+i) - sin45*(a(ib+i)+a(id+i))
+ d(jb+j) = a(ic+i) - sin45*(a(ib+i)+a(id+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+
+ GO TO 170
+90 CONTINUE
+ z = 1.0/REAL(n)
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = z*((a(ia+i)+a(ic+i))+(a(ib+i)+a(id+i)))
+ c(jc+j) = z*((a(ia+i)+a(ic+i))-(a(ib+i)+a(id+i)))
+ c(jb+j) = z*(a(ia+i)-a(ic+i))
+ d(jb+j) = z*(a(id+i)-a(ib+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ GO TO 170
+
+ ! Coding for factor 5
+
+100 CONTINUE
+ ia = 1
+ ib = ia + iink
+ ic = ib + iink
+ id = ic + iink
+ ie = id + iink
+ ja = 1
+ jb = ja + (2*m-la)*inc2
+ jc = jb + 2*m*inc2
+ jd = jc
+ je = jb
+
+ IF (la==m) GO TO 120
+
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ a1 = a(ib+i) + a(ie+i)
+ a3 = a(ib+i) - a(ie+i)
+ a2 = a(ic+i) + a(id+i)
+ a4 = a(ic+i) - a(id+i)
+ a5 = a(ia+i) - 0.25*(a1+a2)
+ a6 = qrt5*(a1-a2)
+ c(ja+j) = a(ia+i) + (a1+a2)
+ c(jb+j) = a5 + a6
+ c(jc+j) = a5 - a6
+ d(jb+j) = -sin72*a3 - sin36*a4
+ d(jc+j) = -sin36*a3 + sin72*a4
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ja = ja + jink
+ jink = 2*jink
+ jb = jb + jink
+ jc = jc + jink
+ jd = jd - jink
+ je = je - jink
+ ibase = ibase + ijump
+ ijump = 2*ijump + iink
+ IF (jb==jd) GO TO 110
+ DO k = la, kstop, la
+ kb = k + k
+ kc = kb + kb
+ kd = kc + kb
+ ke = kd + kb
+ c1 = trigs(kb+1)
+ s1 = trigs(kb+2)
+ c2 = trigs(kc+1)
+ s2 = trigs(kc+2)
+ c3 = trigs(kd+1)
+ s3 = trigs(kd+2)
+ c4 = trigs(ke+1)
+ s4 = trigs(ke+2)
+ jbase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ a1 = (c1*a(ib+i)+s1*b(ib+i)) + (c4*a(ie+i)+s4*b(ie+i))
+ a3 = (c1*a(ib+i)+s1*b(ib+i)) - (c4*a(ie+i)+s4*b(ie+i))
+ a2 = (c2*a(ic+i)+s2*b(ic+i)) + (c3*a(id+i)+s3*b(id+i))
+ a4 = (c2*a(ic+i)+s2*b(ic+i)) - (c3*a(id+i)+s3*b(id+i))
+ b1 = (c1*b(ib+i)-s1*a(ib+i)) + (c4*b(ie+i)-s4*a(ie+i))
+ b3 = (c1*b(ib+i)-s1*a(ib+i)) - (c4*b(ie+i)-s4*a(ie+i))
+ b2 = (c2*b(ic+i)-s2*a(ic+i)) + (c3*b(id+i)-s3*a(id+i))
+ b4 = (c2*b(ic+i)-s2*a(ic+i)) - (c3*b(id+i)-s3*a(id+i))
+ a5 = a(ia+i) - 0.25*(a1+a2)
+ a6 = qrt5*(a1-a2)
+ b5 = b(ia+i) - 0.25*(b1+b2)
+ b6 = qrt5*(b1-b2)
+ a10 = a5 + a6
+ a20 = a5 - a6
+ b10 = b5 + b6
+ b20 = b5 - b6
+ a11 = sin72*b3 + sin36*b4
+ a21 = sin36*b3 - sin72*b4
+ b11 = sin72*a3 + sin36*a4
+ b21 = sin36*a3 - sin72*a4
+ c(ja+j) = a(ia+i) + (a1+a2)
+ c(jb+j) = a10 + a11
+ c(je+j) = a10 - a11
+ c(jc+j) = a20 + a21
+ c(jd+j) = a20 - a21
+ d(ja+j) = b(ia+i) + (b1+b2)
+ d(jb+j) = b10 - b11
+ d(je+j) = -(b10+b11)
+ d(jc+j) = b20 - b21
+ d(jd+j) = -(b20+b21)
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ibase = ibase + ijump
+ ja = ja + jink
+ jb = jb + jink
+ jc = jc + jink
+ jd = jd - jink
+ je = je - jink
+ END DO
+ IF (jb>jd) GO TO 170
+110 CONTINUE
+ jbase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ a1 = a(ib+i) + a(ie+i)
+ a3 = a(ib+i) - a(ie+i)
+ a2 = a(ic+i) + a(id+i)
+ a4 = a(ic+i) - a(id+i)
+ a5 = a(ia+i) + 0.25*(a3-a4)
+ a6 = qrt5*(a3+a4)
+ c(ja+j) = a5 + a6
+ c(jb+j) = a5 - a6
+ c(jc+j) = a(ia+i) - (a3-a4)
+ d(ja+j) = -sin36*a1 - sin72*a2
+ d(jb+j) = -sin72*a1 + sin36*a2
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+
+ GO TO 170
+120 CONTINUE
+ z = 1.0/REAL(n)
+ zqrt5 = z*qrt5
+ zsin36 = z*sin36
+ zsin72 = z*sin72
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ a1 = a(ib+i) + a(ie+i)
+ a3 = a(ib+i) - a(ie+i)
+ a2 = a(ic+i) + a(id+i)
+ a4 = a(ic+i) - a(id+i)
+ a5 = z*(a(ia+i)-0.25*(a1+a2))
+ a6 = zqrt5*(a1-a2)
+ c(ja+j) = z*(a(ia+i)+(a1+a2))
+ c(jb+j) = a5 + a6
+ c(jc+j) = a5 - a6
+ d(jb+j) = -zsin72*a3 - zsin36*a4
+ d(jc+j) = -zsin36*a3 + zsin72*a4
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ GO TO 170
+
+ ! Coding for factor 6
+
+130 CONTINUE
+ ia = 1
+ ib = ia + iink
+ ic = ib + iink
+ id = ic + iink
+ ie = id + iink
+ if = ie + iink
+ ja = 1
+ jb = ja + (2*m-la)*inc2
+ jc = jb + 2*m*inc2
+ jd = jc + 2*m*inc2
+ je = jc
+ jf = jb
+
+ IF (la==m) GO TO 150
+
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ a11 = (a(ic+i)+a(if+i)) + (a(ib+i)+a(ie+i))
+ c(ja+j) = (a(ia+i)+a(id+i)) + a11
+ c(jc+j) = (a(ia+i)+a(id+i)-0.5*a11)
+ d(jc+j) = sin60*((a(ic+i)+a(if+i))-(a(ib+i)+a(ie+i)))
+ a11 = (a(ic+i)-a(if+i)) + (a(ie+i)-a(ib+i))
+ c(jb+j) = (a(ia+i)-a(id+i)) - 0.5*a11
+ d(jb+j) = sin60*((a(ie+i)-a(ib+i))-(a(ic+i)-a(if+i)))
+ c(jd+j) = (a(ia+i)-a(id+i)) + a11
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ja = ja + jink
+ jink = 2*jink
+ jb = jb + jink
+ jc = jc + jink
+ jd = jd - jink
+ je = je - jink
+ jf = jf - jink
+ ibase = ibase + ijump
+ ijump = 2*ijump + iink
+ IF (jc==jd) GO TO 140
+ DO k = la, kstop, la
+ kb = k + k
+ kc = kb + kb
+ kd = kc + kb
+ ke = kd + kb
+ kf = ke + kb
+ c1 = trigs(kb+1)
+ s1 = trigs(kb+2)
+ c2 = trigs(kc+1)
+ s2 = trigs(kc+2)
+ c3 = trigs(kd+1)
+ s3 = trigs(kd+2)
+ c4 = trigs(ke+1)
+ s4 = trigs(ke+2)
+ c5 = trigs(kf+1)
+ s5 = trigs(kf+2)
+ jbase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ a1 = c1*a(ib+i) + s1*b(ib+i)
+ b1 = c1*b(ib+i) - s1*a(ib+i)
+ a2 = c2*a(ic+i) + s2*b(ic+i)
+ b2 = c2*b(ic+i) - s2*a(ic+i)
+ a3 = c3*a(id+i) + s3*b(id+i)
+ b3 = c3*b(id+i) - s3*a(id+i)
+ a4 = c4*a(ie+i) + s4*b(ie+i)
+ b4 = c4*b(ie+i) - s4*a(ie+i)
+ a5 = c5*a(if+i) + s5*b(if+i)
+ b5 = c5*b(if+i) - s5*a(if+i)
+ a11 = (a2+a5) + (a1+a4)
+ a20 = (a(ia+i)+a3) - 0.5*a11
+ a21 = sin60*((a2+a5)-(a1+a4))
+ b11 = (b2+b5) + (b1+b4)
+ b20 = (b(ia+i)+b3) - 0.5*b11
+ b21 = sin60*((b2+b5)-(b1+b4))
+ c(ja+j) = (a(ia+i)+a3) + a11
+ d(ja+j) = (b(ia+i)+b3) + b11
+ c(jc+j) = a20 - b21
+ d(jc+j) = a21 + b20
+ c(je+j) = a20 + b21
+ d(je+j) = a21 - b20
+ a11 = (a2-a5) + (a4-a1)
+ a20 = (a(ia+i)-a3) - 0.5*a11
+ a21 = sin60*((a4-a1)-(a2-a5))
+ b11 = (b5-b2) - (b4-b1)
+ b20 = (b3-b(ia+i)) - 0.5*b11
+ b21 = sin60*((b5-b2)+(b4-b1))
+ c(jb+j) = a20 - b21
+ d(jb+j) = a21 - b20
+ c(jd+j) = a11 + (a(ia+i)-a3)
+ d(jd+j) = b11 + (b3-b(ia+i))
+ c(jf+j) = a20 + b21
+ d(jf+j) = a21 + b20
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ibase = ibase + ijump
+ ja = ja + jink
+ jb = jb + jink
+ jc = jc + jink
+ jd = jd - jink
+ je = je - jink
+ jf = jf - jink
+ END DO
+ IF (jc>jd) GO TO 170
+140 CONTINUE
+ jbase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = (a(ia+i)+0.5*(a(ic+i)-a(ie+i))) + sin60*(a(ib+i)-a(if+i))
+ d(ja+j) = -(a(id+i)+0.5*(a(ib+i)+a(if+i))) - sin60*(a(ic+i)+a(ie+i))
+ c(jb+j) = a(ia+i) - (a(ic+i)-a(ie+i))
+ d(jb+j) = a(id+i) - (a(ib+i)+a(if+i))
+ c(jc+j) = (a(ia+i)+0.5*(a(ic+i)-a(ie+i))) - sin60*(a(ib+i)-a(if+i))
+ d(jc+j) = -(a(id+i)+0.5*(a(ib+i)+a(if+i))) + sin60*(a(ic+i)+a(ie+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+
+ GO TO 170
+150 CONTINUE
+ z = 1.0/REAL(n)
+ zsin60 = z*sin60
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ a11 = (a(ic+i)+a(if+i)) + (a(ib+i)+a(ie+i))
+ c(ja+j) = z*((a(ia+i)+a(id+i))+a11)
+ c(jc+j) = z*((a(ia+i)+a(id+i))-0.5*a11)
+ d(jc+j) = zsin60*((a(ic+i)+a(if+i))-(a(ib+i)+a(ie+i)))
+ a11 = (a(ic+i)-a(if+i)) + (a(ie+i)-a(ib+i))
+ c(jb+j) = z*((a(ia+i)-a(id+i))-0.5*a11)
+ d(jb+j) = zsin60*((a(ie+i)-a(ib+i))-(a(ic+i)-a(if+i)))
+ c(jd+j) = z*((a(ia+i)-a(id+i))+a11)
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ GO TO 170
+
+ ! Coding for factor 8
+
+160 CONTINUE
+ ibad = 3
+ IF (la/=m) GO TO 180
+ ia = 1
+ ib = ia + iink
+ ic = ib + iink
+ id = ic + iink
+ ie = id + iink
+ if = ie + iink
+ ig = if + iink
+ ih = ig + iink
+ ja = 1
+ jb = ja + la*inc2
+ jc = jb + 2*m*inc2
+ jd = jc + 2*m*inc2
+ je = jd + 2*m*inc2
+ z = 1.0/REAL(n)
+ zsin45 = z*SQRT(0.5)
+
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = z*(((a(ia+i)+a(ie+i))+(a(ic+i)+a(ig+i)))+((a(id+i)+ &
+ & a(ih+i))+(a(ib+i)+a(if+i))))
+ c(je+j) = z*(((a(ia+i)+a(ie+i))+(a(ic+i)+a(ig+i)))-((a(id+i)+ &
+ & a(ih+i))+(a(ib+i)+a(if+i))))
+ c(jc+j) = z*((a(ia+i)+a(ie+i))-(a(ic+i)+a(ig+i)))
+ d(jc+j) = z*((a(id+i)+a(ih+i))-(a(ib+i)+a(if+i)))
+ c(jb+j) = z*(a(ia+i)-a(ie+i)) + zsin45*((a(ih+i)-a(id+i))-(a(if+ &
+ & i)-a(ib+i)))
+ c(jd+j) = z*(a(ia+i)-a(ie+i)) - zsin45*((a(ih+i)-a(id+i))-(a(if+ &
+ & i)-a(ib+i)))
+ d(jb+j) = zsin45*((a(ih+i)-a(id+i))+(a(if+i)-a(ib+i))) + &
+ & z*(a(ig+i)-a(ic+i))
+ d(jd+j) = zsin45*((a(ih+i)-a(id+i))+(a(if+i)-a(ib+i))) - &
+ & z*(a(ig+i)-a(ic+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+
+ ! Return
+
+170 CONTINUE
+ ibad = 0
+180 CONTINUE
+ ierr = ibad
+ RETURN
+ END SUBROUTINE qpassm
+
+ SUBROUTINE rpassm(a,b,c,d,trigs,inc1,inc2,inc3,inc4,lot,n,ifac,la,ierr)
+ ! Dimension a(n),b(n),c(n),d(n),trigs(n)
+
+ IMPLICIT NONE
+
+ ! Scalar arguments
+ INTEGER :: ierr, ifac, inc1, inc2, inc3, inc4, la, lot, n
+
+ ! Array arguments
+ REAL :: a(*), b(*), c(*), d(*), trigs(*)
+
+ ! Local scalars:
+ REAL :: c1, c2, c3, c4, c5, qqrt5, qrt5, s1, s2, s3, s4, s5, sin36, sin45, &
+ & sin60, sin72, ssin36, ssin45, ssin60, ssin72
+ INTEGER :: i, ia, ib, ibad, ibase, ic, id, ie, if, igo, iink, ijk, j, ja, &
+ & jb, jbase, jc, jd, je, jf, jg, jh, jink, jump, k, kb, kc, kd, ke, kf, &
+ & kstop, l, m
+
+ ! Local arrays:
+ REAL :: a10(nfft), a11(nfft), a20(nfft), a21(nfft), b10(nfft), b11(nfft), b20(nfft), &
+ & b21(nfft)
+
+ ! Intrinsic functions
+ INTRINSIC SQRT
+
+ ! Data statements
+ DATA sin36/0.587785252292473/, sin72/0.951056516295154/, &
+ & qrt5/0.559016994374947/, sin60/0.866025403784437/
+
+
+ ! Executable statements
+
+ m = n/ifac
+ iink = la*inc1
+ jink = la*inc2
+ jump = (ifac-1)*jink
+ kstop = (n-ifac)/(2*ifac)
+
+ ibad = 1
+ IF (lot>nfft) GO TO 180
+ ibase = 0
+ jbase = 0
+ igo = ifac - 1
+ IF (igo==7) igo = 6
+ ibad = 2
+ IF (igo<1 .OR. igo>6) GO TO 180
+ GO TO (10,40,70,100,130,160) igo
+
+ ! Coding for factor 2
+
+10 CONTINUE
+ ia = 1
+ ib = ia + (2*m-la)*inc1
+ ja = 1
+ jb = ja + jink
+
+ IF (la==m) GO TO 30
+
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = a(ia+i) + a(ib+i)
+ c(jb+j) = a(ia+i) - a(ib+i)
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ia = ia + iink
+ iink = 2*iink
+ ib = ib - iink
+ ibase = 0
+ jbase = jbase + jump
+ jump = 2*jump + jink
+ IF (ia==ib) GO TO 20
+ DO k = la, kstop, la
+ kb = k + k
+ c1 = trigs(kb+1)
+ s1 = trigs(kb+2)
+ ibase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = a(ia+i) + a(ib+i)
+ d(ja+j) = b(ia+i) - b(ib+i)
+ c(jb+j) = c1*(a(ia+i)-a(ib+i)) - s1*(b(ia+i)+b(ib+i))
+ d(jb+j) = s1*(a(ia+i)-a(ib+i)) + c1*(b(ia+i)+b(ib+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ia = ia + iink
+ ib = ib - iink
+ jbase = jbase + jump
+ END DO
+ IF (ia>ib) GO TO 170
+20 CONTINUE
+ ibase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = a(ia+i)
+ c(jb+j) = -b(ia+i)
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+
+ GO TO 170
+30 CONTINUE
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = 2.0*(a(ia+i)+a(ib+i))
+ c(jb+j) = 2.0*(a(ia+i)-a(ib+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ GO TO 170
+
+ ! Coding for factor 3
+
+40 CONTINUE
+ ia = 1
+ ib = ia + (2*m-la)*inc1
+ ic = ib
+ ja = 1
+ jb = ja + jink
+ jc = jb + jink
+
+ IF (la==m) GO TO 60
+
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = a(ia+i) + a(ib+i)
+ c(jb+j) = (a(ia+i)-0.5*a(ib+i)) - (sin60*(b(ib+i)))
+ c(jc+j) = (a(ia+i)-0.5*a(ib+i)) + (sin60*(b(ib+i)))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ia = ia + iink
+ iink = 2*iink
+ ib = ib + iink
+ ic = ic - iink
+ jbase = jbase + jump
+ jump = 2*jump + jink
+ IF (ia==ic) GO TO 50
+ DO k = la, kstop, la
+ kb = k + k
+ kc = kb + kb
+ c1 = trigs(kb+1)
+ s1 = trigs(kb+2)
+ c2 = trigs(kc+1)
+ s2 = trigs(kc+2)
+ ibase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = a(ia+i) + (a(ib+i)+a(ic+i))
+ d(ja+j) = b(ia+i) + (b(ib+i)-b(ic+i))
+ c(jb+j) = c1*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))-(sin60*(b(ib+i)+ &
+ & b(ic+i)))) - s1*((b(ia+i)-0.5*(b(ib+i)-b(ic+i)))+(sin60*(a(ib+i)- &
+ & a(ic+i))))
+ d(jb+j) = s1*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))-(sin60*(b(ib+i)+ &
+ & b(ic+i)))) + c1*((b(ia+i)-0.5*(b(ib+i)-b(ic+i)))+(sin60*(a(ib+i)- &
+ & a(ic+i))))
+ c(jc+j) = c2*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))+(sin60*(b(ib+i)+ &
+ & b(ic+i)))) - s2*((b(ia+i)-0.5*(b(ib+i)-b(ic+i)))-(sin60*(a(ib+i)- &
+ & a(ic+i))))
+ d(jc+j) = s2*((a(ia+i)-0.5*(a(ib+i)+a(ic+i)))+(sin60*(b(ib+i)+ &
+ & b(ic+i)))) + c2*((b(ia+i)-0.5*(b(ib+i)-b(ic+i)))-(sin60*(a(ib+i)- &
+ & a(ic+i))))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ia = ia + iink
+ ib = ib + iink
+ ic = ic - iink
+ jbase = jbase + jump
+ END DO
+ IF (ia>ic) GO TO 170
+50 CONTINUE
+ ibase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = a(ia+i) + a(ib+i)
+ c(jb+j) = (0.5*a(ia+i)-a(ib+i)) - (sin60*b(ia+i))
+ c(jc+j) = -(0.5*a(ia+i)-a(ib+i)) - (sin60*b(ia+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+
+ GO TO 170
+60 CONTINUE
+ ssin60 = 2.0*sin60
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = 2.0*(a(ia+i)+a(ib+i))
+ c(jb+j) = (2.0*a(ia+i)-a(ib+i)) - (ssin60*b(ib+i))
+ c(jc+j) = (2.0*a(ia+i)-a(ib+i)) + (ssin60*b(ib+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ GO TO 170
+
+ ! Coding for factor 4
+
+70 CONTINUE
+ ia = 1
+ ib = ia + (2*m-la)*inc1
+ ic = ib + 2*m*inc1
+ id = ib
+ ja = 1
+ jb = ja + jink
+ jc = jb + jink
+ jd = jc + jink
+
+ IF (la==m) GO TO 90
+
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = (a(ia+i)+a(ic+i)) + a(ib+i)
+ c(jb+j) = (a(ia+i)-a(ic+i)) - b(ib+i)
+ c(jc+j) = (a(ia+i)+a(ic+i)) - a(ib+i)
+ c(jd+j) = (a(ia+i)-a(ic+i)) + b(ib+i)
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ia = ia + iink
+ iink = 2*iink
+ ib = ib + iink
+ ic = ic - iink
+ id = id - iink
+ jbase = jbase + jump
+ jump = 2*jump + jink
+ IF (ib==ic) GO TO 80
+ DO k = la, kstop, la
+ kb = k + k
+ kc = kb + kb
+ kd = kc + kb
+ c1 = trigs(kb+1)
+ s1 = trigs(kb+2)
+ c2 = trigs(kc+1)
+ s2 = trigs(kc+2)
+ c3 = trigs(kd+1)
+ s3 = trigs(kd+2)
+ ibase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = (a(ia+i)+a(ic+i)) + (a(ib+i)+a(id+i))
+ d(ja+j) = (b(ia+i)-b(ic+i)) + (b(ib+i)-b(id+i))
+ c(jc+j) = c2*((a(ia+i)+a(ic+i))-(a(ib+i)+a(id+i))) - s2*((b(ia+ &
+ & i)-b(ic+i))-(b(ib+i)-b(id+i)))
+ d(jc+j) = s2*((a(ia+i)+a(ic+i))-(a(ib+i)+a(id+i))) + c2*((b(ia+ &
+ & i)-b(ic+i))-(b(ib+i)-b(id+i)))
+ c(jb+j) = c1*((a(ia+i)-a(ic+i))-(b(ib+i)+b(id+i))) - s1*((b(ia+ &
+ & i)+b(ic+i))+(a(ib+i)-a(id+i)))
+ d(jb+j) = s1*((a(ia+i)-a(ic+i))-(b(ib+i)+b(id+i))) + c1*((b(ia+ &
+ & i)+b(ic+i))+(a(ib+i)-a(id+i)))
+ c(jd+j) = c3*((a(ia+i)-a(ic+i))+(b(ib+i)+b(id+i))) - s3*((b(ia+ &
+ & i)+b(ic+i))-(a(ib+i)-a(id+i)))
+ d(jd+j) = s3*((a(ia+i)-a(ic+i))+(b(ib+i)+b(id+i))) + c3*((b(ia+ &
+ & i)+b(ic+i))-(a(ib+i)-a(id+i)))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ia = ia + iink
+ ib = ib + iink
+ ic = ic - iink
+ id = id - iink
+ jbase = jbase + jump
+ END DO
+ IF (ib>ic) GO TO 170
+80 CONTINUE
+ ibase = 0
+ sin45 = SQRT(0.5)
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = a(ia+i) + a(ib+i)
+ c(jb+j) = sin45*((a(ia+i)-a(ib+i))-(b(ia+i)+b(ib+i)))
+ c(jc+j) = b(ib+i) - b(ia+i)
+ c(jd+j) = -sin45*((a(ia+i)-a(ib+i))+(b(ia+i)+b(ib+i)))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+
+ GO TO 170
+90 CONTINUE
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = 2.0*((a(ia+i)+a(ic+i))+a(ib+i))
+ c(jb+j) = 2.0*((a(ia+i)-a(ic+i))-b(ib+i))
+ c(jc+j) = 2.0*((a(ia+i)+a(ic+i))-a(ib+i))
+ c(jd+j) = 2.0*((a(ia+i)-a(ic+i))+b(ib+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+
+ ! Coding for factor 5
+
+ GO TO 170
+100 CONTINUE
+ ia = 1
+ ib = ia + (2*m-la)*inc1
+ ic = ib + 2*m*inc1
+ id = ic
+ ie = ib
+ ja = 1
+ jb = ja + jink
+ jc = jb + jink
+ jd = jc + jink
+ je = jd + jink
+
+ IF (la==m) GO TO 120
+
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = a(ia+i) + (a(ib+i)+a(ic+i))
+ c(jb+j) = ((a(ia+i)-0.25*(a(ib+i)+a(ic+i)))+qrt5*(a(ib+i)-a(ic+i))) - &
+ & (sin72*b(ib+i)+sin36*b(ic+i))
+ c(jc+j) = ((a(ia+i)-0.25*(a(ib+i)+a(ic+i)))-qrt5*(a(ib+i)-a(ic+i))) - &
+ & (sin36*b(ib+i)-sin72*b(ic+i))
+ c(jd+j) = ((a(ia+i)-0.25*(a(ib+i)+a(ic+i)))-qrt5*(a(ib+i)-a(ic+i))) + &
+ & (sin36*b(ib+i)-sin72*b(ic+i))
+ c(je+j) = ((a(ia+i)-0.25*(a(ib+i)+a(ic+i)))+qrt5*(a(ib+i)-a(ic+i))) + &
+ & (sin72*b(ib+i)+sin36*b(ic+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ia = ia + iink
+ iink = 2*iink
+ ib = ib + iink
+ ic = ic + iink
+ id = id - iink
+ ie = ie - iink
+ jbase = jbase + jump
+ jump = 2*jump + jink
+ IF (ib==id) GO TO 110
+ DO k = la, kstop, la
+ kb = k + k
+ kc = kb + kb
+ kd = kc + kb
+ ke = kd + kb
+ c1 = trigs(kb+1)
+ s1 = trigs(kb+2)
+ c2 = trigs(kc+1)
+ s2 = trigs(kc+2)
+ c3 = trigs(kd+1)
+ s3 = trigs(kd+2)
+ c4 = trigs(ke+1)
+ s4 = trigs(ke+2)
+ ibase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+
+ a10(ijk) = (a(ia+i)-0.25*((a(ib+i)+a(ie+i))+(a(ic+i)+a(id+i)))) + &
+ & qrt5*((a(ib+i)+a(ie+i))-(a(ic+i)+a(id+i)))
+ a20(ijk) = (a(ia+i)-0.25*((a(ib+i)+a(ie+i))+(a(ic+i)+a(id+i)))) - &
+ & qrt5*((a(ib+i)+a(ie+i))-(a(ic+i)+a(id+i)))
+ b10(ijk) = (b(ia+i)-0.25*((b(ib+i)-b(ie+i))+(b(ic+i)-b(id+i)))) + &
+ & qrt5*((b(ib+i)-b(ie+i))-(b(ic+i)-b(id+i)))
+ b20(ijk) = (b(ia+i)-0.25*((b(ib+i)-b(ie+i))+(b(ic+i)-b(id+i)))) - &
+ & qrt5*((b(ib+i)-b(ie+i))-(b(ic+i)-b(id+i)))
+ a11(ijk) = sin72*(b(ib+i)+b(ie+i)) + sin36*(b(ic+i)+b(id+i))
+ a21(ijk) = sin36*(b(ib+i)+b(ie+i)) - sin72*(b(ic+i)+b(id+i))
+ b11(ijk) = sin72*(a(ib+i)-a(ie+i)) + sin36*(a(ic+i)-a(id+i))
+ b21(ijk) = sin36*(a(ib+i)-a(ie+i)) - sin72*(a(ic+i)-a(id+i))
+
+ c(ja+j) = a(ia+i) + ((a(ib+i)+a(ie+i))+(a(ic+i)+a(id+i)))
+ d(ja+j) = b(ia+i) + ((b(ib+i)-b(ie+i))+(b(ic+i)-b(id+i)))
+ c(jb+j) = c1*(a10(ijk)-a11(ijk)) - s1*(b10(ijk)+b11(ijk))
+ d(jb+j) = s1*(a10(ijk)-a11(ijk)) + c1*(b10(ijk)+b11(ijk))
+ c(je+j) = c4*(a10(ijk)+a11(ijk)) - s4*(b10(ijk)-b11(ijk))
+ d(je+j) = s4*(a10(ijk)+a11(ijk)) + c4*(b10(ijk)-b11(ijk))
+ c(jc+j) = c2*(a20(ijk)-a21(ijk)) - s2*(b20(ijk)+b21(ijk))
+ d(jc+j) = s2*(a20(ijk)-a21(ijk)) + c2*(b20(ijk)+b21(ijk))
+ c(jd+j) = c3*(a20(ijk)+a21(ijk)) - s3*(b20(ijk)-b21(ijk))
+ d(jd+j) = s3*(a20(ijk)+a21(ijk)) + c3*(b20(ijk)-b21(ijk))
+
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ia = ia + iink
+ ib = ib + iink
+ ic = ic + iink
+ id = id - iink
+ ie = ie - iink
+ jbase = jbase + jump
+ END DO
+ IF (ib>id) GO TO 170
+110 CONTINUE
+ ibase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = (a(ia+i)+a(ib+i)) + a(ic+i)
+ c(jb+j) = (qrt5*(a(ia+i)-a(ib+i))+(0.25*(a(ia+i)+a(ib+i))-a(ic+i))) - &
+ & (sin36*b(ia+i)+sin72*b(ib+i))
+ c(je+j) = -(qrt5*(a(ia+i)-a(ib+i))+(0.25*(a(ia+i)+a(ib+i))-a(ic+i))) - &
+ & (sin36*b(ia+i)+sin72*b(ib+i))
+ c(jc+j) = (qrt5*(a(ia+i)-a(ib+i))-(0.25*(a(ia+i)+a(ib+i))-a(ic+i))) - &
+ & (sin72*b(ia+i)-sin36*b(ib+i))
+ c(jd+j) = -(qrt5*(a(ia+i)-a(ib+i))-(0.25*(a(ia+i)+a(ib+i))-a(ic+i))) - &
+ & (sin72*b(ia+i)-sin36*b(ib+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+
+ GO TO 170
+120 CONTINUE
+ qqrt5 = 2.0*qrt5
+ ssin36 = 2.0*sin36
+ ssin72 = 2.0*sin72
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = 2.0*(a(ia+i)+(a(ib+i)+a(ic+i)))
+ c(jb+j) = (2.0*(a(ia+i)-0.25*(a(ib+i)+a(ic+i)))+qqrt5*(a(ib+i)-a(ic+ &
+ & i))) - (ssin72*b(ib+i)+ssin36*b(ic+i))
+ c(jc+j) = (2.0*(a(ia+i)-0.25*(a(ib+i)+a(ic+i)))-qqrt5*(a(ib+i)-a(ic+ &
+ & i))) - (ssin36*b(ib+i)-ssin72*b(ic+i))
+ c(jd+j) = (2.0*(a(ia+i)-0.25*(a(ib+i)+a(ic+i)))-qqrt5*(a(ib+i)-a(ic+ &
+ & i))) + (ssin36*b(ib+i)-ssin72*b(ic+i))
+ c(je+j) = (2.0*(a(ia+i)-0.25*(a(ib+i)+a(ic+i)))+qqrt5*(a(ib+i)-a(ic+ &
+ & i))) + (ssin72*b(ib+i)+ssin36*b(ic+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ GO TO 170
+
+ ! Coding for factor 6
+
+130 CONTINUE
+ ia = 1
+ ib = ia + (2*m-la)*inc1
+ ic = ib + 2*m*inc1
+ id = ic + 2*m*inc1
+ ie = ic
+ if = ib
+ ja = 1
+ jb = ja + jink
+ jc = jb + jink
+ jd = jc + jink
+ je = jd + jink
+ jf = je + jink
+
+ IF (la==m) GO TO 150
+
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = (a(ia+i)+a(id+i)) + (a(ib+i)+a(ic+i))
+ c(jd+j) = (a(ia+i)-a(id+i)) - (a(ib+i)-a(ic+i))
+ c(jb+j) = ((a(ia+i)-a(id+i))+0.5*(a(ib+i)-a(ic+i))) - (sin60*(b(ib+ &
+ & i)+b(ic+i)))
+ c(jf+j) = ((a(ia+i)-a(id+i))+0.5*(a(ib+i)-a(ic+i))) + (sin60*(b(ib+ &
+ & i)+b(ic+i)))
+ c(jc+j) = ((a(ia+i)+a(id+i))-0.5*(a(ib+i)+a(ic+i))) - (sin60*(b(ib+ &
+ & i)-b(ic+i)))
+ c(je+j) = ((a(ia+i)+a(id+i))-0.5*(a(ib+i)+a(ic+i))) + (sin60*(b(ib+ &
+ & i)-b(ic+i)))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ia = ia + iink
+ iink = 2*iink
+ ib = ib + iink
+ ic = ic + iink
+ id = id - iink
+ ie = ie - iink
+ if = if - iink
+ jbase = jbase + jump
+ jump = 2*jump + jink
+ IF (ic==id) GO TO 140
+ DO k = la, kstop, la
+ kb = k + k
+ kc = kb + kb
+ kd = kc + kb
+ ke = kd + kb
+ kf = ke + kb
+ c1 = trigs(kb+1)
+ s1 = trigs(kb+2)
+ c2 = trigs(kc+1)
+ s2 = trigs(kc+2)
+ c3 = trigs(kd+1)
+ s3 = trigs(kd+2)
+ c4 = trigs(ke+1)
+ s4 = trigs(ke+2)
+ c5 = trigs(kf+1)
+ s5 = trigs(kf+2)
+ ibase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+
+ a11(ijk) = (a(ie+i)+a(ib+i)) + (a(ic+i)+a(if+i))
+ a20(ijk) = (a(ia+i)+a(id+i)) - 0.5*a11(ijk)
+ a21(ijk) = sin60*((a(ie+i)+a(ib+i))-(a(ic+i)+a(if+i)))
+ b11(ijk) = (b(ib+i)-b(ie+i)) + (b(ic+i)-b(if+i))
+ b20(ijk) = (b(ia+i)-b(id+i)) - 0.5*b11(ijk)
+ b21(ijk) = sin60*((b(ib+i)-b(ie+i))-(b(ic+i)-b(if+i)))
+
+ c(ja+j) = (a(ia+i)+a(id+i)) + a11(ijk)
+ d(ja+j) = (b(ia+i)-b(id+i)) + b11(ijk)
+ c(jc+j) = c2*(a20(ijk)-b21(ijk)) - s2*(b20(ijk)+a21(ijk))
+ d(jc+j) = s2*(a20(ijk)-b21(ijk)) + c2*(b20(ijk)+a21(ijk))
+ c(je+j) = c4*(a20(ijk)+b21(ijk)) - s4*(b20(ijk)-a21(ijk))
+ d(je+j) = s4*(a20(ijk)+b21(ijk)) + c4*(b20(ijk)-a21(ijk))
+
+ a11(ijk) = (a(ie+i)-a(ib+i)) + (a(ic+i)-a(if+i))
+ b11(ijk) = (b(ie+i)+b(ib+i)) - (b(ic+i)+b(if+i))
+ a20(ijk) = (a(ia+i)-a(id+i)) - 0.5*a11(ijk)
+ a21(ijk) = sin60*((a(ie+i)-a(ib+i))-(a(ic+i)-a(if+i)))
+ b20(ijk) = (b(ia+i)+b(id+i)) + 0.5*b11(ijk)
+ b21(ijk) = sin60*((b(ie+i)+b(ib+i))+(b(ic+i)+b(if+i)))
+
+ c(jd+j) = c3*((a(ia+i)-a(id+i))+a11(ijk)) - s3*((b(ia+i)+b(id+ &
+ & i))-b11(ijk))
+ d(jd+j) = s3*((a(ia+i)-a(id+i))+a11(ijk)) + c3*((b(ia+i)+b(id+ &
+ & i))-b11(ijk))
+ c(jb+j) = c1*(a20(ijk)-b21(ijk)) - s1*(b20(ijk)-a21(ijk))
+ d(jb+j) = s1*(a20(ijk)-b21(ijk)) + c1*(b20(ijk)-a21(ijk))
+ c(jf+j) = c5*(a20(ijk)+b21(ijk)) - s5*(b20(ijk)+a21(ijk))
+ d(jf+j) = s5*(a20(ijk)+b21(ijk)) + c5*(b20(ijk)+a21(ijk))
+
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ ia = ia + iink
+ ib = ib + iink
+ ic = ic + iink
+ id = id - iink
+ ie = ie - iink
+ if = if - iink
+ jbase = jbase + jump
+ END DO
+ IF (ic>id) GO TO 170
+140 CONTINUE
+ ibase = 0
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = a(ib+i) + (a(ia+i)+a(ic+i))
+ c(jd+j) = b(ib+i) - (b(ia+i)+b(ic+i))
+ c(jb+j) = (sin60*(a(ia+i)-a(ic+i))) - (0.5*(b(ia+i)+b(ic+i))+b(ib+i))
+ c(jf+j) = -(sin60*(a(ia+i)-a(ic+i))) - (0.5*(b(ia+i)+b(ic+i))+b(ib+i))
+ c(jc+j) = sin60*(b(ic+i)-b(ia+i)) + (0.5*(a(ia+i)+a(ic+i))-a(ib+i))
+ c(je+j) = sin60*(b(ic+i)-b(ia+i)) - (0.5*(a(ia+i)+a(ic+i))-a(ib+i))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+
+ GO TO 170
+150 CONTINUE
+ ssin60 = 2.0*sin60
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = (2.0*(a(ia+i)+a(id+i))) + (2.0*(a(ib+i)+a(ic+i)))
+ c(jd+j) = (2.0*(a(ia+i)-a(id+i))) - (2.0*(a(ib+i)-a(ic+i)))
+ c(jb+j) = (2.0*(a(ia+i)-a(id+i))+(a(ib+i)-a(ic+i))) - (ssin60*(b(ib+ &
+ & i)+b(ic+i)))
+ c(jf+j) = (2.0*(a(ia+i)-a(id+i))+(a(ib+i)-a(ic+i))) + (ssin60*(b(ib+ &
+ & i)+b(ic+i)))
+ c(jc+j) = (2.0*(a(ia+i)+a(id+i))-(a(ib+i)+a(ic+i))) - (ssin60*(b(ib+ &
+ & i)-b(ic+i)))
+ c(je+j) = (2.0*(a(ia+i)+a(id+i))-(a(ib+i)+a(ic+i))) + (ssin60*(b(ib+ &
+ & i)-b(ic+i)))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+ GO TO 170
+
+ ! Coding for factor 8
+
+160 CONTINUE
+ ibad = 3
+ IF (la/=m) GO TO 180
+ ia = 1
+ ib = ia + la*inc1
+ ic = ib + 2*la*inc1
+ id = ic + 2*la*inc1
+ ie = id + 2*la*inc1
+ ja = 1
+ jb = ja + jink
+ jc = jb + jink
+ jd = jc + jink
+ je = jd + jink
+ jf = je + jink
+ jg = jf + jink
+ jh = jg + jink
+ ssin45 = SQRT(2.0)
+
+ DO l = 1, la
+ i = ibase
+ j = jbase
+!DIR$ IVDEP
+!CDIR NODEP
+!OCL NOVREC
+ DO ijk = 1, lot
+ c(ja+j) = 2.0*(((a(ia+i)+a(ie+i))+a(ic+i))+(a(ib+i)+a(id+i)))
+ c(je+j) = 2.0*(((a(ia+i)+a(ie+i))+a(ic+i))-(a(ib+i)+a(id+i)))
+ c(jc+j) = 2.0*(((a(ia+i)+a(ie+i))-a(ic+i))-(b(ib+i)-b(id+i)))
+ c(jg+j) = 2.0*(((a(ia+i)+a(ie+i))-a(ic+i))+(b(ib+i)-b(id+i)))
+ c(jb+j) = 2.0*((a(ia+i)-a(ie+i))-b(ic+i)) + ssin45*((a(ib+i)-a(id+ &
+ & i))-(b(ib+i)+b(id+i)))
+ c(jf+j) = 2.0*((a(ia+i)-a(ie+i))-b(ic+i)) - ssin45*((a(ib+i)-a(id+ &
+ & i))-(b(ib+i)+b(id+i)))
+ c(jd+j) = 2.0*((a(ia+i)-a(ie+i))+b(ic+i)) - ssin45*((a(ib+i)-a(id+ &
+ & i))+(b(ib+i)+b(id+i)))
+ c(jh+j) = 2.0*((a(ia+i)-a(ie+i))+b(ic+i)) + ssin45*((a(ib+i)-a(id+ &
+ & i))+(b(ib+i)+b(id+i)))
+ i = i + inc3
+ j = j + inc4
+ END DO
+ ibase = ibase + inc1
+ jbase = jbase + inc2
+ END DO
+
+ ! Return
+
+170 CONTINUE
+ ibad = 0
+180 CONTINUE
+ ierr = ibad
+ RETURN
+ END SUBROUTINE rpassm
+
+ SUBROUTINE set99(trigs,ifax,n)
+
+ ! Description:
+ !
+ ! Computes factors of n & trigonometric functins required by fft99 & fft991cy
+ !
+ ! Method:
+ !
+ ! Dimension trigs(n),ifax(1),jfax(10),lfax(7)
+ !
+ ! subroutine 'set99' - computes factors of n & trigonometric
+ ! functins required by fft99 & fft991cy
+
+
+ USE pegrid
+
+ IMPLICIT NONE
+
+ ! Scalar arguments
+ INTEGER :: n
+
+ ! Array arguments
+ REAL :: trigs(*)
+ INTEGER :: ifax(*)
+
+ ! Local scalars:
+ REAL :: angle, del
+ INTEGER :: i, ifac, ixxx, k, l, nfax, nhl, nil, nu
+
+ ! Local arrays:
+ INTEGER :: jfax(10), lfax(7)
+
+ ! Intrinsic functions
+ INTRINSIC ASIN, COS, MOD, REAL, SIN
+
+ ! Data statements
+ DATA lfax/6, 8, 5, 4, 3, 2, 1/
+
+
+ ! Executable statements
+ ixxx = 1
+
+ del = 4.0*ASIN(1.0)/REAL(n)
+ nil = 0
+ nhl = (n/2) - 1
+ DO k = nil, nhl
+ angle = REAL(k)*del
+ trigs(2*k+1) = COS(angle)
+ trigs(2*k+2) = SIN(angle)
+ END DO
+
+ ! Find factors of n (8,6,5,4,3,2; only one 8 allowed)
+ ! Look for sixes first, store factors in descending order
+ nu = n
+ ifac = 6
+ k = 0
+ l = 1
+10 CONTINUE
+ IF (MOD(nu,ifac)/=0) GO TO 30
+ k = k + 1
+ jfax(k) = ifac
+ IF (ifac/=8) GO TO 20
+ IF (k==1) GO TO 20
+ jfax(1) = 8
+ jfax(k) = 6
+20 CONTINUE
+ nu = nu/ifac
+ IF (nu==1) GO TO 40
+ IF (ifac/=8) GO TO 10
+30 CONTINUE
+ l = l + 1
+ ifac = lfax(l)
+ IF (ifac>1) GO TO 10
+
+! WRITE (nout,'(A,I4,A)') ' n =',n,' - Contains illegal factors'
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ temperton_fft:'
+ PRINT*, ' number of gridpoints along x or/and y contain illegal ', &
+ 'factors'
+ PRINT*, ' only factors 8,6,5,4,3,2 are allowed'
+ ENDIF
+ CALL local_stop
+
+
+ RETURN
+
+ ! Now reverse order of factors
+40 CONTINUE
+ nfax = k
+ ifax(1) = nfax
+ DO i = 1, nfax
+ ifax(nfax+2-i) = jfax(i)
+ END DO
+ ifax(10) = n
+ RETURN
+ END SUBROUTINE set99
+
+ END MODULE temperton_fft
Index: /palm/tags/release-3.4a/SOURCE/time_integration.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/time_integration.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/time_integration.f90 (revision 141)
@@ -0,0 +1,525 @@
+ SUBROUTINE time_integration
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 108 2007-08-24 15:10:38Z letzel
+! Call of new routine surface_coupler,
+! presure solver is called after the first Runge-Kutta substep instead of the
+! last in case that call_psolver_at_all_substeps = .F.; for this case, the
+! random perturbation has to be added to the velocity fields also after the
+! first substep
+!
+! 97 2007-06-21 08:23:15Z raasch
+! diffusivities is called with argument rho in case of ocean runs,
+! new argument pt_/prho_reference in calls of diffusivities,
+! ghostpoint exchange for salinity and density
+!
+! 87 2007-05-22 15:46:47Z raasch
+! var_hom renamed pr_palm
+!
+! 75 2007-03-22 09:54:05Z raasch
+! Move call of user_actions( 'after_integration' ) below increment of times
+! and counters,
+! calls of prognostic_equations_.. changed to .._noopt, .._cache, and
+! .._vector, these calls are now controlled by switch loop_optimization,
+! uxrp, vynp eliminated, 2nd+3rd argument removed from exchange horiz,
+! moisture renamed humidity
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.8 2006/08/22 14:16:05 raasch
+! Disturbances are imposed only for the last Runge-Kutta-substep
+!
+! Revision 1.2 2004/04/30 13:03:40 raasch
+! decalpha-specific warning removed, routine name changed to time_integration,
+! particle advection is carried out only once during the intermediate steps,
+! impulse_advec renamed momentum_advec
+!
+! Revision 1.1 1997/08/11 06:19:04 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Integration in time of the model equations, statistical analysis and graphic
+! output
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE averaging
+ USE control_parameters
+ USE cpulog
+#if defined( __dvrp_graphics )
+ USE DVRP
+#endif
+ USE grid_variables
+ USE indices
+ USE interaction_droplets_ptq_mod
+ USE interfaces
+ USE particle_attributes
+ USE pegrid
+ USE prognostic_equations_mod
+ USE statistics
+ USE user_actions_mod
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=9) :: time_to_string
+ INTEGER :: i, j, k
+
+!
+!-- At the beginning of a simulation determine the time step as well as
+!-- determine and print out the run control parameters
+ IF ( simulated_time == 0.0 ) CALL timestep
+ CALL run_control
+
+!
+!-- Data exchange between coupled models in case that a call has been omitted
+!-- at the end of the previous run of a job chain.
+ IF ( coupling_mode /= 'uncoupled' ) THEN
+!
+!-- In case of model termination initiated by the local model the coupler
+!-- must not be called because this would again cause an MPI hang.
+ DO WHILE ( time_coupling >= dt_coupling .AND. terminate_coupled == 0 )
+ CALL surface_coupler
+ time_coupling = time_coupling - dt_coupling
+ ENDDO
+ ENDIF
+
+
+#if defined( __dvrp_graphics )
+!
+!-- Time measurement with dvrp software
+ CALL DVRP_LOG_EVENT( 2, current_timestep_number )
+#endif
+
+!
+!-- Start of the time loop
+ DO WHILE ( simulated_time < end_time .AND. .NOT. stop_dt .AND. &
+ .NOT. terminate_run )
+
+ CALL cpu_log( log_point_s(10), 'timesteps', 'start' )
+
+!
+!-- Determine size of next time step
+ IF ( simulated_time /= 0.0 ) CALL timestep
+
+!
+!-- Execute the user-defined actions
+ CALL user_actions( 'before_timestep' )
+
+!
+!-- Start of intermediate step loop
+ intermediate_timestep_count = 0
+ DO WHILE ( intermediate_timestep_count < &
+ intermediate_timestep_count_max )
+
+ intermediate_timestep_count = intermediate_timestep_count + 1
+
+!
+!-- Set the steering factors for the prognostic equations which depend
+!-- on the timestep scheme
+ CALL timestep_scheme_steering
+
+!
+!-- Solve the prognostic equations. A fast cache optimized version with
+!-- only one single loop is used in case of Piascek-Williams advection
+!-- scheme. NEC vector machines use a different version, because
+!-- in the other versions a good vectorization is prohibited due to
+!-- inlining problems.
+ IF ( loop_optimization == 'vector' ) THEN
+ CALL prognostic_equations_vector
+ ELSE
+ IF ( momentum_advec == 'ups-scheme' .OR. &
+ scalar_advec == 'ups-scheme' .OR. &
+ scalar_advec == 'bc-scheme' ) &
+ THEN
+ CALL prognostic_equations_noopt
+ ELSE
+ CALL prognostic_equations_cache
+ ENDIF
+ ENDIF
+
+!
+!-- Particle advection (only once during intermediate steps, because
+!-- it uses an Euler-step)
+ IF ( particle_advection .AND. &
+ simulated_time >= particle_advection_start .AND. &
+ intermediate_timestep_count == 1 ) THEN
+ CALL advec_particles
+ first_call_advec_particles = .FALSE.
+ ENDIF
+
+!
+!-- Interaction of droplets with temperature and specific humidity.
+!-- Droplet condensation and evaporation is calculated within
+!-- advec_particles.
+ IF ( cloud_droplets .AND. &
+ intermediate_timestep_count == intermediate_timestep_count_max )&
+ THEN
+ CALL interaction_droplets_ptq
+ ENDIF
+
+!
+!-- Exchange of ghost points (lateral boundary conditions)
+ CALL cpu_log( log_point(26), 'exchange-horiz-progn', 'start' )
+ CALL exchange_horiz( u_p )
+ CALL exchange_horiz( v_p )
+ CALL exchange_horiz( w_p )
+ CALL exchange_horiz( pt_p )
+ IF ( .NOT. constant_diffusion ) CALL exchange_horiz( e_p )
+ IF ( ocean ) THEN
+ CALL exchange_horiz( sa_p )
+ CALL exchange_horiz( rho )
+ ENDIF
+ IF ( humidity .OR. passive_scalar ) CALL exchange_horiz( q_p )
+ IF ( cloud_droplets ) THEN
+ CALL exchange_horiz( ql )
+ CALL exchange_horiz( ql_c )
+ CALL exchange_horiz( ql_v )
+ CALL exchange_horiz( ql_vp )
+ ENDIF
+
+ CALL cpu_log( log_point(26), 'exchange-horiz-progn', 'stop' )
+
+!
+!-- Apply time filter in case of leap-frog timestep
+ IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN
+ CALL asselin_filter
+ ENDIF
+
+!
+!-- Boundary conditions for the prognostic quantities (except of the
+!-- velocities at the outflow in case of a non-cyclic lateral wall)
+ CALL boundary_conds( 'main' )
+
+!
+!-- Swap the time levels in preparation for the next time step.
+ CALL swap_timelevel
+
+!
+!-- Temperature offset must be imposed at cyclic boundaries in x-direction
+!-- when a sloping surface is used
+ IF ( sloping_surface ) THEN
+ IF ( nxl == 0 ) pt(:,:,nxl-1) = pt(:,:,nxl-1) - pt_slope_offset
+ IF ( nxr == nx ) pt(:,:,nxr+1) = pt(:,:,nxr+1) + pt_slope_offset
+ ENDIF
+
+!
+!-- Impose a random perturbation on the horizontal velocity field
+ IF ( create_disturbances .AND. &
+ ( call_psolver_at_all_substeps .AND. &
+ intermediate_timestep_count == intermediate_timestep_count_max )&
+ .OR. ( .NOT. call_psolver_at_all_substeps .AND. &
+ intermediate_timestep_count == 1 ) ) &
+ THEN
+ time_disturb = time_disturb + dt_3d
+ IF ( time_disturb >= dt_disturb ) THEN
+ IF ( hom(nzb+5,1,pr_palm,0) < disturbance_energy_limit ) THEN
+ CALL disturb_field( nzb_u_inner, tend, u )
+ CALL disturb_field( nzb_v_inner, tend, v )
+ ELSEIF ( bc_lr /= 'cyclic' .OR. bc_ns /= 'cyclic' ) THEN
+!
+!-- Runs with a non-cyclic lateral wall need perturbations
+!-- near the inflow throughout the whole simulation
+ dist_range = 1
+ CALL disturb_field( nzb_u_inner, tend, u )
+ CALL disturb_field( nzb_v_inner, tend, v )
+ dist_range = 0
+ ENDIF
+ time_disturb = time_disturb - dt_disturb
+ ENDIF
+ ENDIF
+
+!
+!-- Reduce the velocity divergence via the equation for perturbation
+!-- pressure.
+ IF ( intermediate_timestep_count == 1 .OR. &
+ call_psolver_at_all_substeps ) THEN
+ CALL pres
+ ENDIF
+
+!
+!-- If required, compute virtuell potential temperature
+ IF ( humidity ) CALL compute_vpt
+
+!
+!-- If required, compute liquid water content
+ IF ( cloud_physics ) CALL calc_liquid_water_content
+
+!
+!-- Compute the diffusion quantities
+ IF ( .NOT. constant_diffusion ) THEN
+
+!
+!-- First the vertical fluxes in the Prandtl layer are being computed
+ IF ( prandtl_layer ) THEN
+ CALL cpu_log( log_point(19), 'prandtl_fluxes', 'start' )
+ CALL prandtl_fluxes
+ CALL cpu_log( log_point(19), 'prandtl_fluxes', 'stop' )
+ ENDIF
+
+!
+!-- Compute the diffusion coefficients
+ CALL cpu_log( log_point(17), 'diffusivities', 'start' )
+ IF ( .NOT. humidity ) THEN
+ IF ( ocean ) THEN
+ CALL diffusivities( rho, prho_reference )
+ ELSE
+ CALL diffusivities( pt, pt_reference )
+ ENDIF
+ ELSE
+ CALL diffusivities( vpt, pt_reference )
+ ENDIF
+ CALL cpu_log( log_point(17), 'diffusivities', 'stop' )
+
+ ENDIF
+
+ ENDDO ! Intermediate step loop
+
+!
+!-- Increase simulation time and output times
+ current_timestep_number = current_timestep_number + 1
+ simulated_time = simulated_time + dt_3d
+ simulated_time_chr = time_to_string( simulated_time )
+ IF ( simulated_time >= skip_time_data_output_av ) THEN
+ time_do_av = time_do_av + dt_3d
+ ENDIF
+ IF ( simulated_time >= skip_time_do2d_xy ) THEN
+ time_do2d_xy = time_do2d_xy + dt_3d
+ ENDIF
+ IF ( simulated_time >= skip_time_do2d_xz ) THEN
+ time_do2d_xz = time_do2d_xz + dt_3d
+ ENDIF
+ IF ( simulated_time >= skip_time_do2d_yz ) THEN
+ time_do2d_yz = time_do2d_yz + dt_3d
+ ENDIF
+ IF ( simulated_time >= skip_time_do3d ) THEN
+ time_do3d = time_do3d + dt_3d
+ ENDIF
+ time_dvrp = time_dvrp + dt_3d
+ IF ( simulated_time >= skip_time_dosp ) THEN
+ time_dosp = time_dosp + dt_3d
+ ENDIF
+ time_dots = time_dots + dt_3d
+ IF ( .NOT. first_call_advec_particles ) THEN
+ time_dopts = time_dopts + dt_3d
+ ENDIF
+ IF ( simulated_time >= skip_time_dopr ) THEN
+ time_dopr = time_dopr + dt_3d
+ ENDIF
+ time_dopr_listing = time_dopr_listing + dt_3d
+ time_run_control = time_run_control + dt_3d
+
+!
+!-- Data exchange between coupled models
+ IF ( coupling_mode /= 'uncoupled' ) THEN
+ time_coupling = time_coupling + dt_3d
+!
+!-- In case of model termination initiated by the local model
+!-- (terminate_coupled > 0), the coupler must be skipped because it would
+!-- cause an MPI intercomminucation hang.
+!-- If necessary, the coupler will be called at the beginning of the
+!-- next restart run.
+ DO WHILE ( time_coupling >= dt_coupling .AND. terminate_coupled == 0 )
+ CALL surface_coupler
+ time_coupling = time_coupling - dt_coupling
+ ENDDO
+ ENDIF
+
+!
+!-- Execute user-defined actions
+ CALL user_actions( 'after_integration' )
+
+!
+!-- If Galilei transformation is used, determine the distance that the
+!-- model has moved so far
+ IF ( galilei_transformation ) THEN
+ advected_distance_x = advected_distance_x + u_gtrans * dt_3d
+ advected_distance_y = advected_distance_y + v_gtrans * dt_3d
+ ENDIF
+
+!
+!-- Check, if restart is necessary (because cpu-time is expiring or
+!-- because it is forced by user) and set stop flag
+!-- This call is skipped if the remote model has already initiated a restart.
+ IF ( .NOT. terminate_run ) CALL check_for_restart
+
+!
+!-- Carry out statistical analysis and output at the requested output times.
+!-- The MOD function is used for calculating the output time counters (like
+!-- time_dopr) in order to regard a possible decrease of the output time
+!-- interval in case of restart runs
+
+!
+!-- Set a flag indicating that so far no statistics have been created
+!-- for this time step
+ flow_statistics_called = .FALSE.
+
+!
+!-- If required, call flow_statistics for averaging in time
+ IF ( averaging_interval_pr /= 0.0 .AND. &
+ ( dt_dopr - time_dopr ) <= averaging_interval_pr .AND. &
+ simulated_time >= skip_time_dopr ) THEN
+ time_dopr_av = time_dopr_av + dt_3d
+ IF ( time_dopr_av >= dt_averaging_input_pr ) THEN
+ do_sum = .TRUE.
+ time_dopr_av = MOD( time_dopr_av, &
+ MAX( dt_averaging_input_pr, dt_3d ) )
+ ENDIF
+ ENDIF
+ IF ( do_sum ) CALL flow_statistics
+
+!
+!-- Sum-up 3d-arrays for later output of time-averaged data
+ IF ( averaging_interval /= 0.0 .AND. &
+ ( dt_data_output_av - time_do_av ) <= averaging_interval .AND. &
+ simulated_time >= skip_time_data_output_av ) &
+ THEN
+ time_do_sla = time_do_sla + dt_3d
+ IF ( time_do_sla >= dt_averaging_input ) THEN
+ CALL sum_up_3d_data
+ average_count_3d = average_count_3d + 1
+ time_do_sla = MOD( time_do_sla, MAX( dt_averaging_input, dt_3d ) )
+ ENDIF
+ ENDIF
+
+!
+!-- Calculate spectra for time averaging
+ IF ( averaging_interval_sp /= 0.0 .AND. &
+ ( dt_dosp - time_dosp ) <= averaging_interval_sp .AND. &
+ simulated_time >= skip_time_dosp ) THEN
+ time_dosp_av = time_dosp_av + dt_3d
+ IF ( time_dosp_av >= dt_averaging_input_pr ) THEN
+ CALL calc_spectra
+ time_dosp_av = MOD( time_dosp_av, &
+ MAX( dt_averaging_input_pr, dt_3d ) )
+ ENDIF
+ ENDIF
+
+!
+!-- Computation and output of run control parameters.
+!-- This is also done whenever the time step has changed or perturbations
+!-- have been imposed
+ IF ( time_run_control >= dt_run_control .OR. &
+ ( dt_changed .AND. timestep_scheme(1:5) /= 'runge' ) .OR. &
+ disturbance_created ) &
+ THEN
+ CALL run_control
+ IF ( time_run_control >= dt_run_control ) THEN
+ time_run_control = MOD( time_run_control, &
+ MAX( dt_run_control, dt_3d ) )
+ ENDIF
+ ENDIF
+
+!
+!-- Profile output (ASCII) on file
+ IF ( time_dopr_listing >= dt_dopr_listing ) THEN
+ CALL print_1d
+ time_dopr_listing = MOD( time_dopr_listing, MAX( dt_dopr_listing, &
+ dt_3d ) )
+ ENDIF
+
+!
+!-- Graphic output for PROFIL
+ IF ( time_dopr >= dt_dopr ) THEN
+ IF ( dopr_n /= 0 ) CALL data_output_profiles
+ time_dopr = MOD( time_dopr, MAX( dt_dopr, dt_3d ) )
+ time_dopr_av = 0.0 ! due to averaging (see above)
+ ENDIF
+
+!
+!-- Graphic output for time series
+ IF ( time_dots >= dt_dots ) THEN
+ CALL data_output_tseries
+ time_dots = MOD( time_dots, MAX( dt_dots, dt_3d ) )
+ ENDIF
+
+!
+!-- Output of spectra (formatted for use with PROFIL), in case of no
+!-- time averaging, spectra has to be calculated before
+ IF ( time_dosp >= dt_dosp ) THEN
+ IF ( average_count_sp == 0 ) CALL calc_spectra
+ CALL data_output_spectra
+ time_dosp = MOD( time_dosp, MAX( dt_dosp, dt_3d ) )
+ ENDIF
+
+!
+!-- 2d-data output (cross-sections)
+ IF ( time_do2d_xy >= dt_do2d_xy ) THEN
+ CALL data_output_2d( 'xy', 0 )
+ time_do2d_xy = MOD( time_do2d_xy, MAX( dt_do2d_xy, dt_3d ) )
+ ENDIF
+ IF ( time_do2d_xz >= dt_do2d_xz ) THEN
+ CALL data_output_2d( 'xz', 0 )
+ time_do2d_xz = MOD( time_do2d_xz, MAX( dt_do2d_xz, dt_3d ) )
+ ENDIF
+ IF ( time_do2d_yz >= dt_do2d_yz ) THEN
+ CALL data_output_2d( 'yz', 0 )
+ time_do2d_yz = MOD( time_do2d_yz, MAX( dt_do2d_yz, dt_3d ) )
+ ENDIF
+
+!
+!-- 3d-data output (volume data)
+ IF ( time_do3d >= dt_do3d ) THEN
+ CALL data_output_3d( 0 )
+ time_do3d = MOD( time_do3d, MAX( dt_do3d, dt_3d ) )
+ ENDIF
+
+!
+!-- Output of time-averaged 2d/3d-data
+ IF ( time_do_av >= dt_data_output_av ) THEN
+ CALL average_3d_data
+ CALL data_output_2d( 'xy', 1 )
+ CALL data_output_2d( 'xz', 1 )
+ CALL data_output_2d( 'yz', 1 )
+ CALL data_output_3d( 1 )
+ time_do_av = MOD( time_do_av, MAX( dt_data_output_av, dt_3d ) )
+ ENDIF
+
+!
+!-- Output of particle time series
+ IF ( time_dopts >= dt_dopts .OR. &
+ ( simulated_time >= particle_advection_start .AND. &
+ first_call_advec_particles ) ) THEN
+ CALL data_output_ptseries
+ time_dopts = MOD( time_dopts, MAX( dt_dopts, dt_3d ) )
+ ENDIF
+
+!
+!-- Output of dvrp-graphics (isosurface, particles, slicer)
+#if defined( __dvrp_graphics )
+ CALL DVRP_LOG_EVENT( -2, current_timestep_number-1 )
+#endif
+ IF ( time_dvrp >= dt_dvrp ) THEN
+ CALL data_output_dvrp
+ time_dvrp = MOD( time_dvrp, MAX( dt_dvrp, dt_3d ) )
+ ENDIF
+#if defined( __dvrp_graphics )
+ CALL DVRP_LOG_EVENT( 2, current_timestep_number )
+#endif
+
+!
+!-- If required, set the heat flux for the next time step at a random value
+ IF ( constant_heatflux .AND. random_heatflux ) CALL disturb_heatflux
+
+!
+!-- Execute user-defined actions
+ CALL user_actions( 'after_timestep' )
+
+ CALL cpu_log( log_point_s(10), 'timesteps', 'stop' )
+
+ ENDDO ! time loop
+
+#if defined( __dvrp_graphics )
+ CALL DVRP_LOG_EVENT( -2, current_timestep_number )
+#endif
+
+ END SUBROUTINE time_integration
Index: /palm/tags/release-3.4a/SOURCE/time_to_string.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/time_to_string.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/time_to_string.f90 (revision 141)
@@ -0,0 +1,48 @@
+ FUNCTION time_to_string( time )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.3 2001/01/22 08:16:04 raasch
+! Comments translated into English
+!
+! Revision 1.1 1997/08/11 06:26:08 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Transforming the time from real to character-string hh:mm:ss
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=9) :: time_to_string
+ INTEGER :: hours, minutes, seconds
+ REAL :: rest_time, time
+
+!
+!-- Calculate the number of hours, minutes, and seconds
+ hours = INT( time / 3600.0 )
+ rest_time = time - hours * 3600
+ minutes = INT( rest_time / 60.0 )
+ seconds = rest_time - minutes * 60
+
+!
+!-- Build the string
+ IF ( hours < 100 ) THEN
+ WRITE (time_to_string,'(I2.2,'':'',I2.2,'':'',I2.2)') hours, minutes, &
+ seconds
+ ELSE
+ WRITE (time_to_string,'(I3.3,'':'',I2.2,'':'',I2.2)') hours, minutes, &
+ seconds
+ ENDIF
+
+ END FUNCTION time_to_string
Index: /palm/tags/release-3.4a/SOURCE/timestep.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/timestep.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/timestep.f90 (revision 141)
@@ -0,0 +1,292 @@
+ SUBROUTINE timestep
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 108 2007-08-24 15:10:38Z letzel
+! modifications to terminate coupled runs
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.21 2006/02/23 12:59:44 raasch
+! nt_anz renamed current_timestep_number
+!
+! Revision 1.1 1997/08/11 06:26:19 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Compute the time step under consideration of the FCL and diffusion criterion.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE cpulog
+ USE grid_variables
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k
+
+ REAL :: div, dt_diff, dt_diff_l, dt_u, dt_v, dt_w, percent_change, &
+ u_gtrans_l, value, v_gtrans_l
+
+ REAL, DIMENSION(2) :: uv_gtrans, uv_gtrans_l
+ REAL, DIMENSION(nzb+1:nzt) :: dxyz2_min
+
+
+ CALL cpu_log( log_point(12), 'calculate_timestep', 'start' )
+
+!
+!-- Determine the maxima of the velocity components.
+ CALL global_min_max( nzb, nzt+1, nys-1, nyn+1, nxl-1, nxr+1, u, 'abs', &
+ u_max, u_max_ijk )
+ CALL global_min_max( nzb, nzt+1, nys-1, nyn+1, nxl-1, nxr+1, v, 'abs', &
+ v_max, v_max_ijk )
+ CALL global_min_max( nzb, nzt+1, nys-1, nyn+1, nxl-1, nxr+1, w, 'abs', &
+ w_max, w_max_ijk )
+
+!
+!-- In case maxima of the horizontal velocity components have been found at the
+!-- bottom boundary (k=nzb), the corresponding maximum at level k=1 is chosen
+!-- if the Dirichlet-boundary condition ('mirror') has been set. This is
+!-- necessary, because otherwise in case of Galilei-transform a far too large
+!-- velocity (having the respective opposite sign) would be used for the time
+!-- step determination (almost double the mean flow velocity).
+ IF ( ibc_uv_b == 0 ) THEN
+ IF ( u_max_ijk(1) == nzb ) THEN
+ u_max = -u_max
+ u_max_ijk(1) = nzb + 1
+ ENDIF
+ IF ( v_max_ijk(1) == nzb ) THEN
+ v_max = -v_max
+ v_max_ijk(1) = nzb + 1
+ ENDIF
+ ENDIF
+
+!
+!-- In case of Galilei-transform not using the geostrophic wind as translation
+!-- velocity, compute the volume-averaged horizontal velocity components, which
+!-- will then be subtracted from the horizontal wind for the time step and
+!-- horizontal advection routines.
+ IF ( galilei_transformation .AND. .NOT. use_ug_for_galilei_tr ) THEN
+ IF ( flow_statistics_called ) THEN
+!
+!-- Horizontal averages already existent, just need to average them
+!-- vertically.
+ u_gtrans = 0.0
+ v_gtrans = 0.0
+ DO k = nzb+1, nzt
+ u_gtrans = u_gtrans + hom(k,1,1,0)
+ v_gtrans = v_gtrans + hom(k,1,2,0)
+ ENDDO
+ u_gtrans = u_gtrans / REAL( nzt - nzb )
+ v_gtrans = v_gtrans / REAL( nzt - nzb )
+ ELSE
+!
+!-- Averaging over the entire model domain.
+ uv_gtrans_l = 0.0
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ uv_gtrans_l(1) = uv_gtrans_l(1) + u(k,j,i)
+ uv_gtrans_l(2) = uv_gtrans_l(2) + v(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ uv_gtrans_l = uv_gtrans_l / REAL( (nxr-nxl+1)*(nyn-nys+1)*(nzt-nzb) )
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( uv_gtrans_l, uv_gtrans, 2, MPI_REAL, MPI_SUM, &
+ comm2d, ierr )
+ u_gtrans = uv_gtrans(1) / REAL( numprocs )
+ v_gtrans = uv_gtrans(2) / REAL( numprocs )
+#else
+ u_gtrans = uv_gtrans_l(1)
+ v_gtrans = uv_gtrans_l(2)
+#endif
+ ENDIF
+ ENDIF
+
+ IF ( .NOT. dt_fixed ) THEN
+!
+!-- Variable time step:
+!
+!-- For each component, compute the maximum time step according to the
+!-- FCL-criterion.
+ dt_u = dx / ( ABS( u_max - u_gtrans ) + 1.0E-10 )
+ dt_v = dy / ( ABS( v_max - v_gtrans ) + 1.0E-10 )
+ dt_w = dzu(MAX( 1, w_max_ijk(1) )) / ( ABS( w_max ) + 1.0E-10 )
+
+!
+!-- Compute time step according to the diffusion criterion.
+!-- First calculate minimum grid spacing which only depends on index k
+!-- Note: also at k=nzb+1 a full grid length is being assumed, although
+!-- in the Prandtl-layer friction term only dz/2 is used.
+!-- Experience from the old model seems to justify this.
+ dt_diff_l = 999999.0
+
+ DO k = nzb+1, nzt
+ dxyz2_min(k) = MIN( dx2, dy2, dzu(k)*dzu(k) ) * 0.125
+ ENDDO
+
+!$OMP PARALLEL private(i,j,k,value) reduction(MIN: dt_diff_l)
+!$OMP DO
+ DO i = nxl, nxr
+ DO j = nys, nyn
+ DO k = nzb+1, nzt
+ value = dxyz2_min(k) / ( MAX( kh(k,j,i), km(k,j,i) ) + 1E-20 )
+
+ dt_diff_l = MIN( value, dt_diff_l )
+ ENDDO
+ ENDDO
+ ENDDO
+!$OMP END PARALLEL
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( dt_diff_l, dt_diff, 1, MPI_REAL, MPI_MIN, comm2d, &
+ ierr )
+#else
+ dt_diff = dt_diff_l
+#endif
+
+!
+!-- In case of non-cyclic lateral boundaries, the diffusion time step
+!-- may be further restricted by the lateral damping layer (damping only
+!-- along x and y)
+ IF ( bc_lr /= 'cyclic' ) THEN
+ dt_diff = MIN( dt_diff, 0.125 * dx2 / ( km_damp_max + 1E-20 ) )
+ ELSEIF ( bc_ns /= 'cyclic' ) THEN
+ dt_diff = MIN( dt_diff, 0.125 * dy2 / ( km_damp_max + 1E-20 ) )
+ ENDIF
+
+!
+!-- The time step is the minimum of the 3 components and the diffusion time
+!-- step minus a reduction to be on the safe side. Factor 0.5 is necessary
+!-- since the leap-frog scheme always progresses by 2 * delta t.
+!-- The user has to set the cfl_factor small enough to ensure that the
+!-- divergences do not become too large.
+!-- The time step must not exceed the maximum allowed value.
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+ dt_3d = cfl_factor * MIN( dt_diff, dt_u, dt_v, dt_w )
+ ELSE
+ dt_3d = cfl_factor * 0.5 * MIN( dt_diff, dt_u, dt_v, dt_w )
+ ENDIF
+ dt_3d = MIN( dt_3d, dt_max )
+
+!
+!-- Remember the restricting time step criterion for later output.
+ IF ( dt_diff > MIN( dt_u, dt_v, dt_w ) ) THEN
+ timestep_reason = 'A'
+ ELSE
+ timestep_reason = 'D'
+ ENDIF
+
+!
+!-- Set flag if the time step becomes too small.
+ IF ( dt_3d < ( 0.00001 * dt_max ) ) THEN
+ stop_dt = .TRUE.
+
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ time_step: Time step has reached minimum limit.'
+ PRINT*,' dt = ', dt_3d, ' s Simulation is terminated.'
+ PRINT*,' old_dt = ', old_dt, ' s'
+ PRINT*,' dt_u = ', dt_u, ' s'
+ PRINT*,' dt_v = ', dt_v, ' s'
+ PRINT*,' dt_w = ', dt_w, ' s'
+ PRINT*,' dt_diff = ', dt_diff, ' s'
+ PRINT*,' u_max = ', u_max, ' m/s k=', u_max_ijk(1), &
+ ' j=', u_max_ijk(2), ' i=', u_max_ijk(3)
+ PRINT*,' v_max = ', v_max, ' m/s k=', v_max_ijk(1), &
+ ' j=', v_max_ijk(2), ' i=', v_max_ijk(3)
+ PRINT*,' w_max = ', w_max, ' m/s k=', w_max_ijk(1), &
+ ' j=', w_max_ijk(2), ' i=', w_max_ijk(3)
+ ENDIF
+!
+!-- In case of coupled runs inform the remote model of the termination
+!-- and its reason, provided the remote model has not already been
+!-- informed of another termination reason (terminate_coupled > 0) before.
+ IF ( coupling_mode /= 'uncoupled' .AND. terminate_coupled == 0 ) THEN
+ terminate_coupled = 2
+ CALL MPI_SENDRECV( &
+ terminate_coupled, 1, MPI_INTEGER, myid, 0, &
+ terminate_coupled_remote, 1, MPI_INTEGER, myid, 0, &
+ comm_inter, status, ierr )
+ ENDIF
+
+ ENDIF
+
+!
+!-- Ensure a smooth value (two significant digits) of the timestep. For
+!-- other schemes than Runge-Kutta, the following restrictions appear:
+!-- The current timestep is only then changed, if the change relative to
+!-- its previous value exceeds +5 % or -2 %. In case of a timestep
+!-- reduction, at least 30 iterations have to be performed before a timestep
+!-- enlargement is permitted again.
+ percent_change = dt_3d / old_dt - 1.0
+ IF ( percent_change > 0.05 .OR. percent_change < -0.02 .OR. &
+ timestep_scheme(1:5) == 'runge' ) THEN
+
+!
+!-- Time step enlargement by no more than 2 %.
+ IF ( percent_change > 0.0 .AND. simulated_time /= 0.0 .AND. &
+ timestep_scheme(1:5) /= 'runge' ) THEN
+ dt_3d = 1.02 * old_dt
+ ENDIF
+
+!
+!-- A relatively smooth value of the time step is ensured by taking
+!-- only the first two significant digits.
+ div = 1000.0
+ DO WHILE ( dt_3d < div )
+ div = div / 10.0
+ ENDDO
+ dt_3d = NINT( dt_3d * 100.0 / div ) * div / 100.0
+
+!
+!-- Now the time step can be adjusted.
+ IF ( percent_change < 0.0 .OR. timestep_scheme(1:5) == 'runge' ) &
+ THEN
+!
+!-- Time step reduction.
+ old_dt = dt_3d
+ dt_changed = .TRUE.
+ ELSE
+!
+!-- For other timestep schemes , the time step is only enlarged
+!-- after at least 30 iterations since the previous time step
+!-- change or, of course, after model initialization.
+ IF ( current_timestep_number >= last_dt_change + 30 .OR. &
+ simulated_time == 0.0 ) THEN
+ old_dt = dt_3d
+ dt_changed = .TRUE.
+ ELSE
+ dt_3d = old_dt
+ dt_changed = .FALSE.
+ ENDIF
+
+ ENDIF
+ ELSE
+!
+!-- No time step change since the difference is too small.
+ dt_3d = old_dt
+ dt_changed = .FALSE.
+ ENDIF
+
+ IF ( dt_changed ) last_dt_change = current_timestep_number
+
+ ENDIF
+
+ CALL cpu_log( log_point(12), 'calculate_timestep', 'stop' )
+
+
+ END SUBROUTINE timestep
Index: /palm/tags/release-3.4a/SOURCE/timestep_scheme_steering.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/timestep_scheme_steering.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/timestep_scheme_steering.f90 (revision 141)
@@ -0,0 +1,101 @@
+ SUBROUTINE timestep_scheme_steering
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.2 2005/03/26 21:17:06 raasch
+! No pressure term for Runge-Kutta-schemes (tsc(4)=0.0)
+!
+! Revision 1.1 2004/01/28 15:34:47 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Depending on the timestep scheme set the steering factors for the prognostic
+! equations.
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+
+ IMPLICIT NONE
+
+
+ IF ( timestep_scheme(1:5) == 'runge' ) THEN
+!
+!-- Runge-Kutta schemes (here the factors depend on the respective
+!-- intermediate step)
+ IF ( timestep_scheme == 'runge-kutta-2' ) THEN
+ IF ( intermediate_timestep_count == 1 ) THEN
+ tsc(1:5) = (/ 1.0, 1.0, 0.0, 0.0, 0.0 /)
+ ELSE
+ tsc(1:5) = (/ 1.0, 0.5, -0.5, 0.0, 1.0 /)
+ ENDIF
+ ELSE
+ IF ( intermediate_timestep_count == 1 ) THEN
+ tsc(1:5) = (/ 1.0, 1.0/3.0, 0.0, 0.0, 0.0 /)
+ ELSEIF ( intermediate_timestep_count == 2 ) THEN
+ tsc(1:5) = (/ 1.0, 15.0/16.0, -25.0/48.0, 0.0, 0.0 /)
+ ELSE
+ tsc(1:5) = (/ 1.0, 8.0/15.0, 1.0/15.0, 0.0, 1.0 /)
+ ENDIF
+ ENDIF
+
+ ELSE
+
+ IF ( .NOT. dt_fixed ) THEN
+!
+!-- Leapfrog and Euler schemes
+!-- Determine whether after the time step adjustment the Euler- or the
+!-- leapfrog scheme will be applied. The very first time step must always
+!-- be an Euler step.
+ IF ( dt_changed ) THEN
+ IF ( timestep_scheme == 'leapfrog+euler' .OR. &
+ timestep_scheme == 'euler' .OR. simulated_time == 0.0 ) THEN
+ tsc(1:5) = (/ 1.0, 1.0, 0.0, 1.0, 1.0 /)
+ ELSE
+ tsc(1:5) = (/ 0.0, 2.0, 0.0, 1.0, 2.0 /)
+ ENDIF
+ ELSE
+!
+!-- No time step change, hence continue with the scheme set by the
+!-- user.
+ IF ( timestep_scheme == 'euler' ) THEN
+ tsc(1:5) = (/ 1.0, 1.0, 0.0, 1.0, 1.0 /)
+ ELSE
+ tsc(1:5) = (/ 0.0, 2.0, 0.0, 1.0, 2.0 /)
+ ENDIF
+ ENDIF
+
+ ELSE
+
+!
+!-- Fixed time step:
+!
+!-- In any case, the very first time step must always be an Euler step.
+ timestep_reason = 'F'
+ IF ( simulated_time == 0.0 ) THEN
+ dt_changed = .TRUE.
+ tsc(1:5) = (/ 1.0, 1.0, 0.0, 1.0, 1.0 /)
+ ELSE
+ dt_changed = .FALSE.
+ IF ( timestep_scheme == 'euler' ) THEN
+ tsc(1:5) = (/ 1.0, 1.0, 0.0, 1.0, 1.0 /)
+ ELSE
+ tsc(1:5) = (/ 0.0, 2.0, 0.0, 1.0, 2.0 /)
+ ENDIF
+ ENDIF
+
+ ENDIF
+
+ ENDIF
+
+
+ END SUBROUTINE timestep_scheme_steering
Index: /palm/tags/release-3.4a/SOURCE/transpose.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/transpose.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/transpose.f90 (revision 141)
@@ -0,0 +1,700 @@
+ SUBROUTINE transpose_xy( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.2 2004/04/30 13:12:17 raasch
+! Switched from mpi_alltoallv to the simpler mpi_alltoall,
+! all former transpose-routine files collected in this file, enlarged
+! transposition arrays introduced
+!
+! Revision 1.1 2004/04/30 13:08:16 raasch
+! Initial revision (collection of former routines transpose_xy, transpose_xz,
+! transpose_yx, transpose_yz, transpose_zx, transpose_zy)
+!
+! Revision 1.1 1997/07/24 11:25:18 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Transposition of input array (f_in) from x to y. For the input array, all
+! elements along x reside on the same PE, while after transposition, all
+! elements along y reside on the same PE.
+!------------------------------------------------------------------------------!
+
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, l, m, ys
+
+ REAL :: f_in(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa), &
+ f_inv(nys_x:nyn_xa,nzb_x:nzt_xa,0:nxa), &
+ f_out(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya), &
+ work1(nys_x:nyn_xa,nzb_x:nzt_xa,0:nxa), work2(nnx*nny*nnz)
+
+#if defined( __parallel )
+
+!
+!-- Rearrange indices of input array in order to make data to be send
+!-- by MPI contiguous
+ DO k = nzb_x, nzt_xa
+ DO j = nys_x, nyn_xa
+ DO i = 0, nxa
+ work1(j,k,i) = f_in(i,j,k)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Move data to different array, because memory location of work1 is
+!-- needed further below (work1 = work2)
+ DO i = 0, nxa
+ DO k = nzb_x, nzt_xa
+ DO j = nys_x, nyn_xa
+ f_inv(j,k,i) = work1(j,k,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Transpose array
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+ CALL MPI_ALLTOALL( f_inv(nys_x,nzb_x,0), sendrecvcount_xy, MPI_REAL, &
+ work2(1), sendrecvcount_xy, MPI_REAL, &
+ comm1dy, ierr )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!-- Reorder transposed array
+ m = 0
+ DO l = 0, pdims(2) - 1
+ ys = 0 + l * ( nyn_xa - nys_x + 1 )
+ DO i = nxl_y, nxr_ya
+ DO k = nzb_y, nzt_ya
+ DO j = ys, ys + nyn_xa - nys_x
+ m = m + 1
+ f_out(j,i,k) = work2(m)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+
+#endif
+
+ END SUBROUTINE transpose_xy
+
+
+ SUBROUTINE transpose_xz( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Transposition of input array (f_in) from x to z. For the input array, all
+! elements along x reside on the same PE, while after transposition, all
+! elements along z reside on the same PE.
+!------------------------------------------------------------------------------!
+
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, l, m, xs
+
+ REAL :: f_in(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa), &
+ f_inv(nxl:nxra,nys:nyna,1:nza), &
+ f_out(1:nza,nys:nyna,nxl:nxra), &
+ work1(1:nza,nys:nyna,nxl:nxra), work2(nnx*nny*nnz)
+
+#if defined( __parallel )
+
+!
+!-- If the PE grid is one-dimensional along y, the array has only to be
+!-- reordered locally and therefore no transposition has to be done.
+ IF ( pdims(1) /= 1 ) THEN
+!
+!-- Reorder input array for transposition
+ m = 0
+ DO l = 0, pdims(1) - 1
+ xs = 0 + l * nnx
+ DO k = nzb_x, nzt_xa
+ DO j = nys_x, nyn_xa
+ DO i = xs, xs + nnx - 1
+ m = m + 1
+ work2(m) = f_in(i,j,k)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Transpose array
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+ CALL MPI_ALLTOALL( work2(1), sendrecvcount_zx, MPI_REAL, &
+ f_inv(nxl,nys,1), sendrecvcount_zx, MPI_REAL, &
+ comm1dx, ierr )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!-- Reorder transposed array in a way that the z index is in first position
+ DO i = nxl, nxra
+ DO j = nys, nyna
+ DO k = 1, nza
+ work1(k,j,i) = f_inv(i,j,k)
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSE
+!
+!-- Reorder the array in a way that the z index is in first position
+ DO i = nxl, nxra
+ DO j = nys, nyna
+ DO k = 1, nza
+ work1(k,j,i) = f_in(i,j,k)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Move data to output array
+ DO i = nxl, nxra
+ DO j = nys, nyna
+ DO k = 1, nza
+ f_out(k,j,i) = work1(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+#endif
+
+ END SUBROUTINE transpose_xz
+
+
+ SUBROUTINE transpose_yx( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Transposition of input array (f_in) from y to x. For the input array, all
+! elements along y reside on the same PE, while after transposition, all
+! elements along x reside on the same PE.
+!------------------------------------------------------------------------------!
+
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, l, m, ys
+
+ REAL :: f_in(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya), &
+ f_inv(nys_x:nyn_xa,nzb_x:nzt_xa,0:nxa), &
+ f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa), &
+ work1(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa), work2(nnx*nny*nnz)
+
+#if defined( __parallel )
+
+!
+!-- Reorder input array for transposition
+ m = 0
+ DO l = 0, pdims(2) - 1
+ ys = 0 + l * ( nyn_xa - nys_x + 1 )
+ DO i = nxl_y, nxr_ya
+ DO k = nzb_y, nzt_ya
+ DO j = ys, ys + nyn_xa - nys_x
+ m = m + 1
+ work2(m) = f_in(j,i,k)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Transpose array
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+ CALL MPI_ALLTOALL( work2(1), sendrecvcount_xy, MPI_REAL, &
+ f_inv(nys_x,nzb_x,0), sendrecvcount_xy, MPI_REAL, &
+ comm1dy, ierr )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!-- Reorder transposed array in a way that the x index is in first position
+ DO i = 0, nxa
+ DO k = nzb_x, nzt_xa
+ DO j = nys_x, nyn_xa
+ work1(i,j,k) = f_inv(j,k,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Move data to output array
+ DO k = nzb_x, nzt_xa
+ DO j = nys_x, nyn_xa
+ DO i = 0, nxa
+ f_out(i,j,k) = work1(i,j,k)
+ ENDDO
+ ENDDO
+ ENDDO
+
+#endif
+
+ END SUBROUTINE transpose_yx
+
+
+ SUBROUTINE transpose_yxd( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Transposition of input array (f_in) from y to x. For the input array, all
+! elements along y reside on the same PE, while after transposition, all
+! elements along x reside on the same PE.
+! This is a direct transposition for arrays with indices in regular order
+! (k,j,i) (cf. transpose_yx).
+!------------------------------------------------------------------------------!
+
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, l, m, recvcount_yx, sendcount_yx, xs
+
+ REAL :: f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nxl:nxra,1:nza,nys:nyna), &
+ f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa), &
+ work1(nxl:nxra,1:nza,nys:nyna), work2(nnx*nny*nnz)
+
+#if defined( __parallel )
+
+!
+!-- Rearrange indices of input array in order to make data to be send
+!-- by MPI contiguous
+ DO k = 1, nza
+ DO j = nys, nyna
+ DO i = nxl, nxra
+ work1(i,k,j) = f_in(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Move data to different array, because memory location of work1 is
+!-- needed further below (work1 = work2)
+ DO j = nys, nyna
+ DO k = 1, nza
+ DO i = nxl, nxra
+ f_inv(i,k,j) = work1(i,k,j)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Transpose array
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+ CALL MPI_ALLTOALL( f_inv(nxl,1,nys), sendrecvcount_xy, MPI_REAL, &
+ work2(1), sendrecvcount_xy, MPI_REAL, &
+ comm1dx, ierr )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!-- Reorder transposed array
+ m = 0
+ DO l = 0, pdims(1) - 1
+ xs = 0 + l * nnx
+ DO j = nys_x, nyn_xa
+ DO k = 1, nza
+ DO i = xs, xs + nnx - 1
+ m = m + 1
+ f_out(i,j,k) = work2(m)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+
+#endif
+
+ END SUBROUTINE transpose_yxd
+
+
+ SUBROUTINE transpose_yz( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Transposition of input array (f_in) from y to z. For the input array, all
+! elements along y reside on the same PE, while after transposition, all
+! elements along z reside on the same PE.
+!------------------------------------------------------------------------------!
+
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, l, m, zs
+
+ REAL :: f_in(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya), &
+ f_inv(nxl_y:nxr_ya,nzb_y:nzt_ya,0:nya), &
+ f_out(nxl_z:nxr_za,nys_z:nyn_za,1:nza), &
+ work1(nxl_y:nxr_ya,nzb_y:nzt_ya,0:nya), work2(nnx*nny*nnz)
+
+#if defined( __parallel )
+
+!
+!-- Rearrange indices of input array in order to make data to be send
+!-- by MPI contiguous
+ DO k = nzb_y, nzt_ya
+ DO i = nxl_y, nxr_ya
+ DO j = 0, nya
+ work1(i,k,j) = f_in(j,i,k)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Move data to different array, because memory location of work1 is
+!-- needed further below (work1 = work2).
+!-- If the PE grid is one-dimensional along y, only local reordering
+!-- of the data is necessary and no transposition has to be done.
+ IF ( pdims(1) == 1 ) THEN
+ DO j = 0, nya
+ DO k = nzb_y, nzt_ya
+ DO i = nxl_y, nxr_ya
+ f_out(i,j,k) = work1(i,k,j)
+ ENDDO
+ ENDDO
+ ENDDO
+ RETURN
+ ELSE
+ DO j = 0, nya
+ DO k = nzb_y, nzt_ya
+ DO i = nxl_y, nxr_ya
+ f_inv(i,k,j) = work1(i,k,j)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Transpose array
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+ CALL MPI_ALLTOALL( f_inv(nxl_y,nzb_y,0), sendrecvcount_yz, MPI_REAL, &
+ work2(1), sendrecvcount_yz, MPI_REAL, &
+ comm1dx, ierr )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!-- Reorder transposed array
+ m = 0
+ DO l = 0, pdims(1) - 1
+ zs = 1 + l * ( nzt_ya - nzb_y + 1 )
+ DO j = nys_z, nyn_za
+ DO k = zs, zs + nzt_ya - nzb_y
+ DO i = nxl_z, nxr_za
+ m = m + 1
+ f_out(i,j,k) = work2(m)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+
+#endif
+
+ END SUBROUTINE transpose_yz
+
+
+ SUBROUTINE transpose_zx( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Transposition of input array (f_in) from z to x. For the input array, all
+! elements along z reside on the same PE, while after transposition, all
+! elements along x reside on the same PE.
+!------------------------------------------------------------------------------!
+
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, l, m, xs
+
+ REAL :: f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nxl:nxra,nys:nyna,1:nza), &
+ f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa), &
+ work1(nxl:nxra,nys:nyna,1:nza), work2(nnx*nny*nnz)
+
+#if defined( __parallel )
+
+!
+!-- Rearrange indices of input array in order to make data to be send
+!-- by MPI contiguous
+ DO i = nxl, nxra
+ DO j = nys, nyna
+ DO k = 1,nza
+ work1(i,j,k) = f_in(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Move data to different array, because memory location of work1 is
+!-- needed further below (work1 = work2).
+!-- If the PE grid is one-dimensional along y, only local reordering
+!-- of the data is necessary and no transposition has to be done.
+ IF ( pdims(1) == 1 ) THEN
+ DO k = 1, nza
+ DO j = nys, nyna
+ DO i = nxl, nxra
+ f_out(i,j,k) = work1(i,j,k)
+ ENDDO
+ ENDDO
+ ENDDO
+ RETURN
+ ELSE
+ DO k = 1, nza
+ DO j = nys, nyna
+ DO i = nxl, nxra
+ f_inv(i,j,k) = work1(i,j,k)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Transpose array
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+ CALL MPI_ALLTOALL( f_inv(nxl,nys,1), sendrecvcount_zx, MPI_REAL, &
+ work2(1), sendrecvcount_zx, MPI_REAL, &
+ comm1dx, ierr )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!-- Reorder transposed array
+ m = 0
+ DO l = 0, pdims(1) - 1
+ xs = 0 + l * nnx
+ DO k = nzb_x, nzt_xa
+ DO j = nys_x, nyn_xa
+ DO i = xs, xs + nnx - 1
+ m = m + 1
+ f_out(i,j,k) = work2(m)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+
+#endif
+
+ END SUBROUTINE transpose_zx
+
+
+ SUBROUTINE transpose_zy( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Transposition of input array (f_in) from z to y. For the input array, all
+! elements along z reside on the same PE, while after transposition, all
+! elements along y reside on the same PE.
+!------------------------------------------------------------------------------!
+
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, l, m, zs
+
+ REAL :: f_in(nxl_z:nxr_za,nys_z:nyn_za,1:nza), &
+ f_inv(nxl_y:nxr_ya,nzb_y:nzt_ya,0:nya), &
+ f_out(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya), &
+ work1(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya), work2(nnx*nny*nnz)
+
+#if defined( __parallel )
+
+!
+!-- If the PE grid is one-dimensional along y, the array has only to be
+!-- reordered locally and therefore no transposition has to be done.
+ IF ( pdims(1) /= 1 ) THEN
+!
+!-- Reorder input array for transposition
+ m = 0
+ DO l = 0, pdims(1) - 1
+ zs = 1 + l * ( nzt_ya - nzb_y + 1 )
+ DO j = nys_z, nyn_za
+ DO k = zs, zs + nzt_ya - nzb_y
+ DO i = nxl_z, nxr_za
+ m = m + 1
+ work2(m) = f_in(i,j,k)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Transpose array
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+ CALL MPI_ALLTOALL( work2(1), sendrecvcount_yz, MPI_REAL, &
+ f_inv(nxl_y,nzb_y,0), sendrecvcount_yz, MPI_REAL, &
+ comm1dx, ierr )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!-- Reorder transposed array in a way that the y index is in first position
+ DO k = nzb_y, nzt_ya
+ DO i = nxl_y, nxr_ya
+ DO j = 0, nya
+ work1(j,i,k) = f_inv(i,k,j)
+ ENDDO
+ ENDDO
+ ENDDO
+ ELSE
+!
+!-- Reorder the array in a way that the y index is in first position
+ DO k = nzb_y, nzt_ya
+ DO i = nxl_y, nxr_ya
+ DO j = 0, nya
+ work1(j,i,k) = f_in(i,j,k)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Move data to output array
+ DO k = nzb_y, nzt_ya
+ DO i = nxl_y, nxr_ya
+ DO j = 0, nya
+ f_out(j,i,k) = work1(j,i,k)
+ ENDDO
+ ENDDO
+ ENDDO
+
+#endif
+
+ END SUBROUTINE transpose_zy
+
+
+ SUBROUTINE transpose_zyd( f_in, work1, f_inv, work2, f_out )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Transposition of input array (f_in) from z to y. For the input array, all
+! elements along z reside on the same PE, while after transposition, all
+! elements along y reside on the same PE.
+! This is a direct transposition for arrays with indices in regular order
+! (k,j,i) (cf. transpose_zy).
+!------------------------------------------------------------------------------!
+
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE transpose_indices
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, l, m, ys
+
+ REAL :: f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nys:nyna,nxl:nxra,1:nza), &
+ f_out(0:nya,nxl_yd:nxr_yda,nzb_yd:nzt_yda), &
+ work1(nys:nyna,nxl:nxra,1:nza), work2(nnx*nny*nnz)
+
+#if defined( __parallel )
+
+!
+!-- Rearrange indices of input array in order to make data to be send
+!-- by MPI contiguous
+ DO i = nxl, nxra
+ DO j = nys, nyna
+ DO k = 1, nza
+ work1(j,i,k) = f_in(k,j,i)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!
+!-- Move data to different array, because memory location of work1 is
+!-- needed further below (work1 = work2).
+!-- If the PE grid is one-dimensional along x, only local reordering
+!-- of the data is necessary and no transposition has to be done.
+ IF ( pdims(2) == 1 ) THEN
+ DO k = 1, nza
+ DO i = nxl, nxra
+ DO j = nys, nyna
+ f_out(j,i,k) = work1(j,i,k)
+ ENDDO
+ ENDDO
+ ENDDO
+ RETURN
+ ELSE
+ DO k = 1, nza
+ DO i = nxl, nxra
+ DO j = nys, nyna
+ f_inv(j,i,k) = work1(j,i,k)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+!
+!-- Transpose array
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
+ CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zyd, MPI_REAL, &
+ work2(1), sendrecvcount_zyd, MPI_REAL, &
+ comm1dy, ierr )
+ CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
+
+!
+!-- Reorder transposed array
+ m = 0
+ DO l = 0, pdims(2) - 1
+ ys = 0 + l * nny
+ DO k = nzb_yd, nzt_yda
+ DO i = nxl_yd, nxr_yda
+ DO j = ys, ys + nny - 1
+ m = m + 1
+ f_out(j,i,k) = work2(m)
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+
+#endif
+
+ END SUBROUTINE transpose_zyd
Index: /palm/tags/release-3.4a/SOURCE/user_interface.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/user_interface.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/user_interface.f90 (revision 141)
@@ -0,0 +1,1184 @@
+ MODULE user
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 138 2007-11-28 10:03:58Z letzel
+! new subroutines user_init_plant_canopy, user_data_output_dvrp
+! +argument gls in user_init_grid
+!
+! 105 2007-08-08 07:12:55Z raasch
+! +dots_num_palm in module user, +module netcdf_control in user_init
+!
+! 95 2007-06-02 16:48:38Z raasch
+! user action for salinity added
+!
+! 89 2007-05-25 12:08:31Z raasch
+! Calculation and output of user-defined profiles: new routine
+! user_check_data_output_pr, +data_output_pr_user, max_pr_user in userpar,
+! routine user_statistics has got two more arguments
+! Bugfix: field_chr renamed field_char
+!
+! 60 2007-03-11 11:50:04Z raasch
+! New routine user_init_3d_model which allows the initial setting of all 3d
+! arrays under control of the user, new routine user_advec_particles,
+! routine user_statistics now has one argument (sr),
+! sample for generating time series quantities added
+! Bugfix in sample for reading user defined data from restart file (user_init)
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.18 2006/06/02 15:25:00 raasch
+! +change of grid-defining arguments in routine user_define_netcdf_grid,
+! new argument "found" in user_data_output_2d and user_data_output_3d
+!
+! Revision 1.1 1998/03/24 15:29:04 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Declaration of user-defined variables. This module may only be used
+! in the user-defined routines (contained in user_interface.f90).
+!------------------------------------------------------------------------------!
+
+ INTEGER :: dots_num_palm, user_idummy
+ LOGICAL :: user_defined_namelist_found = .FALSE.
+ REAL :: user_dummy
+
+!
+!-- Sample for user-defined output
+! REAL, DIMENSION(:,:,:), ALLOCATABLE :: u2, u2_av
+
+ SAVE
+
+ END MODULE user
+
+
+ SUBROUTINE user_parin
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Interface to read user-defined namelist-parameters.
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE pegrid
+ USE statistics
+ USE user
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=80) :: zeile
+
+ INTEGER :: i, j
+
+
+ NAMELIST /userpar/ data_output_pr_user, data_output_user, region
+
+!
+!-- Position the namelist-file at the beginning (it was already opened in
+!-- parin), search for user-defined namelist-group ("userpar", but any other
+!-- name can be choosed) and position the file at this line.
+ REWIND ( 11 )
+
+ zeile = ' '
+ DO WHILE ( INDEX( zeile, '&userpar' ) == 0 )
+ READ ( 11, '(A)', END=100 ) zeile
+ ENDDO
+ BACKSPACE ( 11 )
+
+!
+!-- Read user-defined namelist
+ READ ( 11, userpar )
+ user_defined_namelist_found = .TRUE.
+
+!
+!-- Determine the number of user-defined profiles and append them to the
+!-- standard data output (data_output_pr)
+ IF ( data_output_pr_user(1) /= ' ' ) THEN
+ i = 1
+ DO WHILE ( data_output_pr(i) /= ' ' .AND. i <= 100 )
+ i = i + 1
+ ENDDO
+ j = 1
+ DO WHILE ( data_output_pr_user(j) /= ' ' .AND. j <= 100 )
+ data_output_pr(i) = data_output_pr_user(j)
+ max_pr_user = max_pr_user + 1
+ i = i + 1
+ j = j + 1
+ ENDDO
+ ENDIF
+
+100 RETURN
+
+ END SUBROUTINE user_parin
+
+
+
+ SUBROUTINE user_header( io )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Print a header with user-defined informations.
+!------------------------------------------------------------------------------!
+
+ USE statistics
+ USE user
+
+ IMPLICIT NONE
+
+ INTEGER :: i, io
+
+!
+!-- If no user-defined variables are read from the namelist-file, no
+!-- informations will be printed.
+ IF ( .NOT. user_defined_namelist_found ) THEN
+ WRITE ( io, 100 )
+ RETURN
+ ENDIF
+
+!
+!-- Printing the informations.
+ WRITE ( io, 110 )
+
+ IF ( statistic_regions /= 0 ) THEN
+ WRITE ( io, 200 )
+ DO i = 0, statistic_regions
+ WRITE ( io, 201 ) i, region(i)
+ ENDDO
+ ENDIF
+
+
+
+!
+!-- Format-descriptors
+100 FORMAT (//' *** no user-defined variables found'/)
+110 FORMAT (//1X,78('#') &
+ //' User-defined variables and actions:'/ &
+ ' -----------------------------------'//)
+200 FORMAT (' Output of profiles and time series for following regions:' /)
+201 FORMAT (4X,'Region ',I1,': ',A)
+
+
+ END SUBROUTINE user_header
+
+
+
+ SUBROUTINE user_init
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Execution of user-defined initializing actions
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE indices
+ USE netcdf_control
+ USE pegrid
+ USE user
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=20) :: field_char
+!
+!-- Here the user-defined initializing actions follow:
+!-- Sample for user-defined output
+! ALLOCATE( u2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+!
+! IF ( initializing_actions == 'read_restart_data' ) THEN
+! READ ( 13 ) field_char
+! DO WHILE ( TRIM( field_char ) /= '*** end user ***' )
+!
+! SELECT CASE ( TRIM( field_char ) )
+!
+! CASE ( 'u2_av' )
+! ALLOCATE( u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+! READ ( 13 ) u2_av
+!
+! CASE DEFAULT
+! PRINT*, '+++ user_init: unknown variable named "', &
+! TRIM( field_char ), '" found in'
+! PRINT*, ' data from prior run on PE ', myid
+! CALL local_stop
+!
+! END SELECT
+!
+! READ ( 13 ) field_char
+!
+! ENDDO
+! ENDIF
+
+!
+!-- Sample for user-defined time series
+!-- For each time series quantity you have to give a label and a unit,
+!-- which will be used for the NetCDF file. They must not contain more than
+!-- seven characters. The value of dots_num has to be increased by the
+!-- number of new time series quantities. Its old value has to be store in
+!-- dots_num_palm. See routine user_statistics on how to output calculate
+!-- and output these quantities.
+! dots_label(dots_num+1) = 'abs_umx'
+! dots_unit(dots_num+1) = 'm/s'
+! dots_label(dots_num+2) = 'abs_vmx'
+! dots_unit(dots_num+2) = 'm/s'
+!
+! dots_num_palm = dots_num
+! dots_num = dots_num + 2
+
+ END SUBROUTINE user_init
+
+
+
+ SUBROUTINE user_init_grid( gls, nzb_local )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Execution of user-defined grid initializing actions
+! First argument gls contains the number of ghost layers, which is > 1 if the
+! multigrid method for the pressure solver is used
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE indices
+ USE user
+
+ IMPLICIT NONE
+
+ INTEGER :: gls
+
+ INTEGER, DIMENSION(-gls:ny+gls,-gls:nx+gls) :: nzb_local
+
+!
+!-- Here the user-defined grid initializing actions follow:
+
+!
+!-- Set the index array nzb_local for non-flat topography.
+!-- Here consistency checks concerning domain size and periodicity are necessary
+ SELECT CASE ( TRIM( topography ) )
+
+ CASE ( 'flat', 'single_building' )
+!
+!-- Not allowed here since these are the standard cases used in init_grid.
+
+ CASE ( 'user_defined_topography_1' )
+!
+!-- Here the user can define his own topography. After definition, please
+!-- remove the following three lines!
+ PRINT*, '+++ user_init_grid: topography "', &
+ topography, '" not available yet'
+ CALL local_stop
+
+ CASE DEFAULT
+!
+!-- The DEFAULT case is reached if the parameter topography contains a
+!-- wrong character string that is neither recognized in init_grid nor
+!-- here in user_init_grid.
+ PRINT*, '+++ (user_)init_grid: unknown topography "', &
+ topography, '"'
+ CALL local_stop
+
+ END SELECT
+
+
+ END SUBROUTINE user_init_grid
+
+
+
+ SUBROUTINE user_init_plant_canopy
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Initialisation of the leaf area density array (for scalar grid points) and
+! the array of the canopy drag coefficient, if the user has not chosen any
+! of the default cases
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE indices
+ USE user
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j
+
+!
+!-- Here the user-defined grid initializing actions follow:
+
+!
+!-- Set the 3D-arrays lad_s and cdc for user defined canopies
+ SELECT CASE ( TRIM( canopy_mode ) )
+
+ CASE ( 'block' )
+!
+!-- Not allowed here since this is the standard case used in init_3d_model.
+
+ CASE ( 'user_defined_canopy_1' )
+!
+!-- Here the user can define his own topography.
+!-- The following lines contain an example in that the
+!-- plant canopy extends only over the second half of the
+!-- model domain along x
+! DO i = nxl-1, nxr+1
+! IF ( i >= INT(nx+1/2) ) THEN
+! DO j = nys-1, nyn+1
+! lad_s(:,j,i) = lad(:)
+! cdc(:,j,i) = drag_coefficient
+! ENDDO
+! ELSE
+! lad_s(:,:,i) = 0.0
+! cdc(:,:,i) = 0.0
+! ENDIF
+! ENDDO
+!-- After definition, please
+!-- remove the following three lines!
+ PRINT*, '+++ user_init_plant_canopy: canopy_mode "', &
+ canopy_mode, '" not available yet'
+
+ CASE DEFAULT
+!
+!-- The DEFAULT case is reached if the parameter canopy_mode contains a
+!-- wrong character string that is neither recognized in init_3d_model nor
+!-- here in user_init_plant_canopy.
+ PRINT*, '+++ user_init_plant_canopy: unknown canopy_mode "', &
+ canopy_mode, '"'
+ CALL local_stop
+
+ END SELECT
+
+
+ END SUBROUTINE user_init_plant_canopy
+
+
+
+ SUBROUTINE user_init_3d_model
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Allows the complete initialization of the 3d model.
+!
+! CAUTION: The user is responsible to set at least all those quantities which
+! ------ are normally set within init_3d_model!
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE indices
+ USE user
+
+ IMPLICIT NONE
+
+
+ END SUBROUTINE user_init_3d_model
+
+
+
+ MODULE user_actions_mod
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Execution of user-defined actions before or after single timesteps
+!------------------------------------------------------------------------------!
+
+ PRIVATE
+ PUBLIC user_actions
+
+ INTERFACE user_actions
+ MODULE PROCEDURE user_actions
+ MODULE PROCEDURE user_actions_ij
+ END INTERFACE user_actions
+
+ CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE user_actions( location )
+
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE pegrid
+ USE user
+ USE arrays_3d
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: location
+
+ INTEGER :: i, j, k
+
+ CALL cpu_log( log_point(24), 'user_actions', 'start' )
+
+!
+!-- Here the user-defined actions follow
+!-- No calls for single grid points are allowed at locations before and
+!-- after the timestep, since these calls are not within an i,j-loop
+ SELECT CASE ( location )
+
+ CASE ( 'before_timestep' )
+!
+!-- Enter actions to be done before every timestep here
+
+
+ CASE ( 'after_integration' )
+!
+!-- Enter actions to be done after every time integration (before
+!-- data output)
+!-- Sample for user-defined output:
+! DO i = nxl-1, nxr+1
+! DO j = nys-1, nyn+1
+! DO k = nzb, nzt+1
+! u2(k,j,i) = u(k,j,i)**2
+! ENDDO
+! ENDDO
+! ENDDO
+
+
+ CASE ( 'after_timestep' )
+!
+!-- Enter actions to be done after every timestep here
+
+
+ CASE ( 'u-tendency' )
+!
+!-- Enter actions to be done in the u-tendency term here
+
+
+ CASE ( 'v-tendency' )
+
+
+ CASE ( 'w-tendency' )
+
+
+ CASE ( 'pt-tendency' )
+
+
+ CASE ( 'sa-tendency' )
+
+
+ CASE ( 'e-tendency' )
+
+
+ CASE ( 'q-tendency' )
+
+
+ CASE DEFAULT
+ IF ( myid == 0 ) PRINT*, '+++ user_actions: unknown location "', &
+ location, '"'
+ CALL local_stop
+
+ END SELECT
+
+ CALL cpu_log( log_point(24), 'user_actions', 'stop' )
+
+ END SUBROUTINE user_actions
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE user_actions_ij( i, j, location )
+
+ USE control_parameters
+ USE pegrid
+ USE user
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: location
+
+ INTEGER :: i, idum, j
+
+
+!
+!-- Here the user-defined actions follow
+ SELECT CASE ( location )
+
+ CASE ( 'u-tendency' )
+!
+!-- Enter actions to be done in the u-tendency term here
+
+
+ CASE ( 'v-tendency' )
+
+
+ CASE ( 'w-tendency' )
+
+
+ CASE ( 'pt-tendency' )
+
+
+ CASE ( 'sa-tendency' )
+
+
+ CASE ( 'e-tendency' )
+
+
+ CASE ( 'q-tendency' )
+
+
+ CASE ( 'before_timestep', 'after_integration', 'after_timestep' )
+ IF ( myid == 0 ) THEN
+ PRINT*, '+++ user_actions: location "', location, '" is not ', &
+ 'allowed to be called with parameters "i" and "j"'
+ ENDIF
+ CALL local_stop
+
+
+ CASE DEFAULT
+ IF ( myid == 0 ) PRINT*, '+++ user_actions: unknown location "', &
+ location, '"'
+ CALL local_stop
+
+
+ END SELECT
+
+ END SUBROUTINE user_actions_ij
+
+ END MODULE user_actions_mod
+
+
+
+ SUBROUTINE user_statistics( mode, sr, tn )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Calculation of user-defined statistics, i.e. horizontally averaged profiles
+! and time series.
+! This routine is called for every statistic region sr defined by the user,
+! but at least for the region "total domain" (sr=0).
+! See section 3.5.4 on how to define, calculate, and output user defined
+! quantities.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE indices
+ USE statistics
+ USE user
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: mode
+
+ INTEGER :: i, j, k, sr, tn
+
+
+ IF ( mode == 'profiles' ) THEN
+
+!
+!-- Sample on how to calculate horizontally averaged profiles of user-
+!-- defined quantities. Each quantity is identified by the index
+!-- "pr_palm+#" where "#" is an integer starting from 1. These
+!-- user-profile-numbers must also be assigned to the respective strings
+!-- given by data_output_pr_user in routine user_check_data_output_pr.
+! !$OMP DO
+! DO i = nxl, nxr
+! DO j = nys, nyn
+! DO k = nzb_s_outer(j,i)+1, nzt
+!!
+!!-- Sample on how to calculate the profile of the resolved-scale
+!!-- horizontal momentum flux u*v*
+! sums_l(k,pr_palm+1,tn) = sums_l(k,pr_palm+1,tn) + &
+! ( 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,sr) ) * &
+! ( 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,sr) ) * &
+! * rmask(j,i,sr)
+!!
+!!-- Further profiles can be defined and calculated by increasing
+!!-- the second index of array sums_l (replace ... appropriately)
+! sums_l(k,pr_palm+2,tn) = sums_l(k,pr_palm+2,tn) + ... &
+! * rmask(j,i,sr)
+! ENDDO
+! ENDDO
+! ENDDO
+
+ ELSEIF ( mode == 'time_series' ) THEN
+
+!
+!-- Sample on how to add values for the user-defined time series quantities.
+!-- These have to be defined before in routine user_init. This sample
+!-- creates two time series for the absolut values of the horizontal
+!-- velocities u and v.
+! ts_value(dots_num_palm+1,sr) = ABS( u_max )
+! ts_value(dots_num_palm+2,sr) = ABS( v_max )
+
+ ENDIF
+
+ END SUBROUTINE user_statistics
+
+
+
+ SUBROUTINE user_last_actions
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Execution of user-defined actions at the end of a job.
+!------------------------------------------------------------------------------!
+
+ USE user
+
+ IMPLICIT NONE
+
+!
+!-- Here the user-defined actions at the end of a job follow.
+!-- Sample for user-defined output:
+! IF ( ALLOCATED( u2_av ) ) THEN
+! WRITE ( 14 ) 'u2_av '; WRITE ( 14 ) u2_av
+! ENDIF
+
+ WRITE ( 14 ) '*** end user *** '
+
+ END SUBROUTINE user_last_actions
+
+
+
+ SUBROUTINE user_init_particles
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Modification of initial particles by the user.
+!------------------------------------------------------------------------------!
+
+ USE particle_attributes
+ USE user
+
+ IMPLICIT NONE
+
+ INTEGER :: n
+
+!
+!-- Here the user-defined actions follow
+! DO n = 1, number_of_initial_particles
+! ENDDO
+
+ END SUBROUTINE user_init_particles
+
+
+
+ SUBROUTINE user_advec_particles
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Modification of initial particles by the user.
+!------------------------------------------------------------------------------!
+
+ USE particle_attributes
+ USE user
+
+ IMPLICIT NONE
+
+ INTEGER :: n
+
+!
+!-- Here the user-defined actions follow
+! DO n = 1, number_of_initial_particles
+! ENDDO
+
+ END SUBROUTINE user_advec_particles
+
+
+
+ SUBROUTINE user_particle_attributes
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Define the actual particle attributes (size, colour) by the user.
+!------------------------------------------------------------------------------!
+
+ USE particle_attributes
+ USE user
+
+ IMPLICIT NONE
+
+ INTEGER :: n
+
+!
+!-- Here the user-defined actions follow
+! DO n = 1, number_of_initial_particles
+! ENDDO
+
+ END SUBROUTINE user_particle_attributes
+
+
+
+ SUBROUTINE user_dvrp_coltab( mode, variable )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Definition of the colour table to be used by the dvrp software.
+!------------------------------------------------------------------------------!
+
+ USE dvrp_variables
+ USE pegrid
+ USE user
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: mode
+ CHARACTER (LEN=*) :: variable
+
+
+!
+!-- Here the user-defined actions follow
+ SELECT CASE ( mode )
+
+ CASE ( 'particles' )
+
+ CASE ( 'slicer' )
+
+ CASE DEFAULT
+ IF ( myid == 0 ) PRINT*, '+++ user_dvrp_coltab: unknown mode "', &
+ mode, '"'
+ CALL local_stop
+
+ END SELECT
+
+ END SUBROUTINE user_dvrp_coltab
+
+
+
+ SUBROUTINE user_check_data_output( variable, unit )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Set the unit of user defined output quantities. For those variables
+! not recognized by the user, the parameter unit is set to "illegal", which
+! tells the calling routine that the output variable is not defined and leads
+! to a program abort.
+!------------------------------------------------------------------------------!
+
+ USE user
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: unit, variable
+
+
+ SELECT CASE ( TRIM( variable ) )
+
+!
+!-- Uncomment and extend the following lines, if necessary
+! CASE ( 'u2' )
+! unit = 'm2/s2'
+!
+ CASE DEFAULT
+ unit = 'illegal'
+
+ END SELECT
+
+
+ END SUBROUTINE user_check_data_output
+
+
+
+ SUBROUTINE user_check_data_output_pr( variable, var_count, unit )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Set the unit of user defined profile output quantities. For those variables
+! not recognized by the user, the parameter unit is set to "illegal", which
+! tells the calling routine that the output variable is not defined and leads
+! to a program abort.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE indices
+ USE netcdf_control
+ USE profil_parameter
+ USE statistics
+ USE user
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: unit, variable
+
+ INTEGER :: index, var_count
+
+
+ SELECT CASE ( TRIM( variable ) )
+
+!
+!-- Uncomment and extend the following lines, if necessary.
+!-- Add additional CASE statements depending on the number of quantities
+!-- for which profiles are to be calculated. The respective calculations
+!-- to be performed have to be added in routine user_statistics.
+!-- The quantities are (internally) identified by a user-profile-number
+!-- (see variable "index" below). The first user-profile must be assigned
+!-- the number "pr_palm+1", the second one "pr_palm+2", etc. The respective
+!-- user-profile-numbers have also to be used in routine user_statistics!
+! CASE ( 'u*v*' ) ! quantity string as given in
+! ! data_output_pr_user
+! index = pr_palm + 1
+! dopr_index(var_count) = index ! quantities' user-profile-number
+! dopr_unit(var_count) = 'm2/s2' ! quantity unit
+! hom(:,2,index,:) = SPREAD( zu, 2, statistic_regions+1 )
+! ! grid on which the quantity is
+! ! defined (use zu or zw)
+
+ CASE DEFAULT
+ unit = 'illegal'
+
+ END SELECT
+
+
+ END SUBROUTINE user_check_data_output_pr
+
+
+
+ SUBROUTINE user_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Set the grids on which user-defined output quantities are defined.
+! Allowed values for grid_x are "x" and "xu", for grid_y "y" and "yv", and
+! for grid_z "zu" and "zw".
+!------------------------------------------------------------------------------!
+
+ USE user
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: grid_x, grid_y, grid_z, variable
+
+ LOGICAL :: found
+
+
+ SELECT CASE ( TRIM( variable ) )
+
+!
+!-- Uncomment and extend the following lines, if necessary
+! CASE ( 'u2', 'u2_xy', 'u2_xz', 'u2_yz' )
+! grid_x = 'xu'
+! grid_y = 'y'
+! grid_z = 'zu'
+
+ CASE DEFAULT
+ found = .FALSE.
+ grid_x = 'none'
+ grid_y = 'none'
+ grid_z = 'none'
+
+ END SELECT
+
+
+ END SUBROUTINE user_define_netcdf_grid
+
+
+
+ SUBROUTINE user_data_output_dvrp( output_variable, local_pf )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Execution of user-defined dvrp output
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE indices
+ USE pegrid
+ USE user
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: output_variable
+
+ INTEGER :: i, j, k
+
+ REAL, DIMENSION(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) :: local_pf
+
+!
+!-- Here the user-defined DVRP output follows:
+
+!
+!-- Move original array to intermediate array
+ SELECT CASE ( output_variable )
+
+! CASE ( 'u2', 'u2_xy', 'u2_xz', 'u2_yz' )
+!!
+!!-- Here the user can add user_defined output quantities.
+!!-- Uncomment and extend the following lines, if necessary.
+! DO i = nxl, nxr+1
+! DO j = nys, nyn+1
+! DO k = nzb, nz_do3d
+! local_pf(i,j,k) = u2(k,j,i)
+! ENDDO
+! ENDDO
+! ENDDO
+
+
+ CASE DEFAULT
+!
+!-- The DEFAULT case is reached if output_variable contains a
+!-- wrong character string that is neither recognized in data_output_dvrp
+!-- nor here in user_data_output_dvrp.
+ IF ( myid == 0 ) THEN
+ PRINT*,'+++ (user_)data_output_dvrp: no output possible for: ', &
+ output_variable
+ ENDIF
+
+ END SELECT
+
+
+ END SUBROUTINE user_data_output_dvrp
+
+
+
+ SUBROUTINE user_data_output_2d( av, variable, found, grid, local_pf )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Resorts the user-defined output quantity with indices (k,j,i) to a
+! temporary array with indices (i,j,k) and sets the grid on which it is defined.
+! Allowed values for grid are "zu" and "zw".
+!------------------------------------------------------------------------------!
+
+ USE indices
+ USE user
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: grid, variable
+
+ INTEGER :: av, i, j, k
+
+ LOGICAL :: found
+
+ REAL, DIMENSION(nxl-1:nxr+1,nys-1:nyn+1,nzb:nzt+1) :: local_pf
+
+
+ found = .TRUE.
+
+ SELECT CASE ( TRIM( variable ) )
+
+!
+!-- Uncomment and extend the following lines, if necessary.
+!-- The arrays for storing the user defined quantities (here u2 and u2_av)
+!-- have to be declared and defined by the user!
+!-- Sample for user-defined output:
+! CASE ( 'u2_xy', 'u2_xz', 'u2_yz' )
+! IF ( av == 0 ) THEN
+! DO i = nxl-1, nxr+1
+! DO j = nys-1, nyn+1
+! DO k = nzb, nzt+1
+! local_pf(i,j,k) = u2(k,j,i)
+! ENDDO
+! ENDDO
+! ENDDO
+! ELSE
+! DO i = nxl-1, nxr+1
+! DO j = nys-1, nyn+1
+! DO k = nzb, nzt+1
+! local_pf(i,j,k) = u2_av(k,j,i)
+! ENDDO
+! ENDDO
+! ENDDO
+! ENDIF
+!
+! grid = 'zu'
+
+ CASE DEFAULT
+ found = .FALSE.
+ grid = 'none'
+
+ END SELECT
+
+
+ END SUBROUTINE user_data_output_2d
+
+
+
+ SUBROUTINE user_data_output_3d( av, variable, found, local_pf, nz_do )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Resorts the user-defined output quantity with indices (k,j,i) to a
+! temporary array with indices (i,j,k).
+!------------------------------------------------------------------------------!
+
+ USE array_kind
+ USE indices
+ USE user
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: variable
+
+ INTEGER :: av, i, j, k, nz_do
+
+ LOGICAL :: found
+
+ REAL(spk), DIMENSION(nxl-1:nxr+1,nys-1:nyn+1,nzb:nz_do) :: local_pf
+
+
+ found = .TRUE.
+
+ SELECT CASE ( TRIM( variable ) )
+
+!
+!-- Uncomment and extend the following lines, if necessary.
+!-- The arrays for storing the user defined quantities (here u2 and u2_av)
+!-- have to be declared and defined by the user!
+!-- Sample for user-defined output:
+! CASE ( 'u2' )
+! IF ( av == 0 ) THEN
+! DO i = nxl-1, nxr+1
+! DO j = nys-1, nyn+1
+! DO k = nzb, nz_do
+! local_pf(i,j,k) = u2(k,j,i)
+! ENDDO
+! ENDDO
+! ENDDO
+! ELSE
+! DO i = nxl-1, nxr+1
+! DO j = nys-1, nyn+1
+! DO k = nzb, nz_do
+! local_pf(i,j,k) = u2_av(k,j,i)
+! ENDDO
+! ENDDO
+! ENDDO
+! ENDIF
+!
+
+ CASE DEFAULT
+ found = .FALSE.
+
+ END SELECT
+
+
+ END SUBROUTINE user_data_output_3d
+
+
+
+ SUBROUTINE user_3d_data_averaging( mode, variable )
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+! Sum up and time-average user-defined output quantities as well as allocate
+! the array necessary for storing the average.
+!------------------------------------------------------------------------------!
+
+ USE control_parameters
+ USE indices
+ USE user
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=*) :: mode, variable
+
+ INTEGER :: i, j, k
+
+
+ IF ( mode == 'allocate' ) THEN
+
+ SELECT CASE ( TRIM( variable ) )
+
+!
+!-- Uncomment and extend the following lines, if necessary.
+!-- The arrays for storing the user defined quantities (here u2_av) have
+!-- to be declared and defined by the user!
+!-- Sample for user-defined output:
+! CASE ( 'u2' )
+! IF ( .NOT. ALLOCATED( u2_av ) ) THEN
+! ALLOCATE( u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+! ENDIF
+! u2_av = 0.0
+
+ CASE DEFAULT
+ CONTINUE
+
+ END SELECT
+
+ ELSEIF ( mode == 'sum' ) THEN
+
+ SELECT CASE ( TRIM( variable ) )
+
+!
+!-- Uncomment and extend the following lines, if necessary.
+!-- The arrays for storing the user defined quantities (here u2 and
+!-- u2_av) have to be declared and defined by the user!
+!-- Sample for user-defined output:
+! CASE ( 'u2' )
+! DO i = nxl-1, nxr+1
+! DO j = nys-1, nyn+1
+! DO k = nzb, nzt+1
+! u2_av(k,j,i) = u2_av(k,j,i) + u2(k,j,i)
+! ENDDO
+! ENDDO
+! ENDDO
+
+ CASE DEFAULT
+ CONTINUE
+
+ END SELECT
+
+ ELSEIF ( mode == 'average' ) THEN
+
+ SELECT CASE ( TRIM( variable ) )
+
+!
+!-- Uncomment and extend the following lines, if necessary.
+!-- The arrays for storing the user defined quantities (here u2_av) have
+!-- to be declared and defined by the user!
+!-- Sample for user-defined output:
+! CASE ( 'u2' )
+! DO i = nxl-1, nxr+1
+! DO j = nys-1, nyn+1
+! DO k = nzb, nzt+1
+! u2_av(k,j,i) = u2_av(k,j,i) / REAL( average_count_3d )
+! ENDDO
+! ENDDO
+! ENDDO
+
+ END SELECT
+
+ ENDIF
+
+
+ END SUBROUTINE user_3d_data_averaging
Index: /palm/tags/release-3.4a/SOURCE/wall_fluxes.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/wall_fluxes.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/wall_fluxes.f90 (revision 141)
@@ -0,0 +1,557 @@
+ MODULE wall_fluxes_mod
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+! Initial version (2007/03/07)
+!
+! Description:
+! ------------
+! Calculates momentum fluxes at vertical walls assuming Monin-Obukhov
+! similarity.
+! Indices: usvs a=1, vsus b=1, wsvs c1=1, wsus c2=1 (other=0).
+! The all-gridpoint version of wall_fluxes_e is not used so far, because
+! it gives slightly different results from the ij-version for some unknown
+! reason.
+!------------------------------------------------------------------------------!
+ PRIVATE
+ PUBLIC wall_fluxes, wall_fluxes_e
+
+ INTERFACE wall_fluxes
+ MODULE PROCEDURE wall_fluxes
+ MODULE PROCEDURE wall_fluxes_ij
+ END INTERFACE wall_fluxes
+
+ INTERFACE wall_fluxes_e
+ MODULE PROCEDURE wall_fluxes_e
+ MODULE PROCEDURE wall_fluxes_e_ij
+ END INTERFACE wall_fluxes_e
+
+ CONTAINS
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE wall_fluxes( wall_flux, a, b, c1, c2, nzb_uvw_inner, &
+ nzb_uvw_outer, wall )
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, wall_index
+
+ INTEGER, DIMENSION(nys-1:nyn+1,nxl-1:nxr+1) :: nzb_uvw_inner, &
+ nzb_uvw_outer
+ REAL :: a, b, c1, c2, h1, h2, zp
+ REAL :: pts, pt_i, rifs, u_i, v_i, us_wall, vel_total, ws, wspts
+
+ REAL, DIMENSION(nys-1:nyn+1,nxl-1:nxr+1) :: wall
+ REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wall_flux
+
+
+ zp = 0.5 * ( (a+c1) * dy + (b+c2) * dx )
+ wall_flux = 0.0
+ wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+
+ IF ( wall(j,i) /= 0.0 ) THEN
+!
+!-- All subsequent variables are computed for the respective
+!-- location where the relevant variable is defined
+ DO k = nzb_uvw_inner(j,i)+1, nzb_uvw_outer(j,i)
+
+!
+!-- (1) Compute rifs, u_i, v_i, ws, pt' and w'pt'
+ rifs = rif_wall(k,j,i,wall_index)
+
+ u_i = a * u(k,j,i) + c1 * 0.25 * &
+ ( u(k+1,j,i+1) + u(k+1,j,i) + u(k,j,i+1) + u(k,j,i) )
+
+ v_i = b * v(k,j,i) + c2 * 0.25 * &
+ ( v(k+1,j+1,i) + v(k+1,j,i) + v(k,j+1,i) + v(k,j,i) )
+
+ ws = ( c1 + c2 ) * w(k,j,i) + 0.25 * ( &
+ a * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) ) &
+ + b * ( w(k-1,j-1,i) + w(k-1,j,i) + w(k,j-1,i) + w(k,j,i) ) &
+ )
+ pt_i = 0.5 * ( pt(k,j,i) + a * pt(k,j,i-1) + &
+ b * pt(k,j-1,i) + ( c1 + c2 ) * pt(k+1,j,i) )
+
+ pts = pt_i - hom(k,1,4,0)
+ wspts = ws * pts
+
+!
+!-- (2) Compute wall-parallel absolute velocity vel_total
+ vel_total = SQRT( ws**2 + (a+c1) * u_i**2 + (b+c2) * v_i**2 )
+
+!
+!-- (3) Compute wall friction velocity us_wall
+ IF ( rifs >= 0.0 ) THEN
+
+!
+!-- Stable stratification (and neutral)
+ us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) + &
+ 5.0 * rifs * ( zp - z0(j,i) ) / zp &
+ )
+ ELSE
+
+!
+!-- Unstable stratification
+ h1 = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifs ) )
+ h2 = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifs / zp * z0(j,i) ))
+
+!
+!-- If a borderline case occurs, the formula for stable
+!-- stratification must be used anyway, or else a zero
+!-- division would occur in the argument of the logarithm.
+ IF ( h1 == 1.0 .OR. h2 == 1.0 ) THEN
+ us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) + &
+ 5.0 * rifs * ( zp - z0(j,i) ) / zp &
+ )
+ ELSE
+ us_wall = kappa * vel_total / ( &
+ LOG( (1.0+h2) / (1.0-h2) * (1.0-h1) / (1.0+h1) ) + &
+ 2.0 * ( ATAN( h2 ) - ATAN( h1 ) ) &
+ )
+ ENDIF
+
+ ENDIF
+
+!
+!-- (4) Compute zp/L (corresponds to neutral Richardson flux
+!-- number rifs)
+ rifs = -1.0 * zp * kappa * g * wspts / ( pt_i * &
+ ( us_wall**3 + 1E-30 ) )
+
+!
+!-- Limit the value range of the Richardson numbers.
+!-- This is necessary for very small velocities (u,w --> 0),
+!-- because the absolute value of rif can then become very
+!-- large, which in consequence would result in very large
+!-- shear stresses and very small momentum fluxes (both are
+!-- generally unrealistic).
+ IF ( rifs < rif_min ) rifs = rif_min
+ IF ( rifs > rif_max ) rifs = rif_max
+
+!
+!-- (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
+ IF ( rifs >= 0.0 ) THEN
+
+!
+!-- Stable stratification (and neutral)
+ wall_flux(k,j,i) = kappa * &
+ ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / &
+ ( LOG( zp / z0(j,i) ) + &
+ 5.0 * rifs * ( zp - z0(j,i) ) / zp &
+ )
+ ELSE
+
+!
+!-- Unstable stratification
+ h1 = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifs ) )
+ h2 = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifs / zp * z0(j,i) ))
+
+!
+!-- If a borderline case occurs, the formula for stable
+!-- stratification must be used anyway, or else a zero
+!-- division would occur in the argument of the logarithm.
+ IF ( h1 == 1.0 .OR. h2 == 1.0 ) THEN
+ wall_flux(k,j,i) = kappa * &
+ ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / &
+ ( LOG( zp / z0(j,i) ) + &
+ 5.0 * rifs * ( zp - z0(j,i) ) / zp &
+ )
+ ELSE
+ wall_flux(k,j,i) = kappa * &
+ ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / &
+ ( LOG( (1.0+h2) / (1.0-h2) * (1.0-h1) / (1.0+h1) )&
+ + 2.0 * ( ATAN( h2 ) - ATAN( h1 ) ) &
+ )
+ ENDIF
+
+ ENDIF
+ wall_flux(k,j,i) = -wall_flux(k,j,i) * ABS(wall_flux(k,j,i))
+
+!
+!-- store rifs for next time step
+ rif_wall(k,j,i,wall_index) = rifs
+
+ ENDDO
+
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE wall_fluxes
+
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE wall_fluxes_ij( i, j, nzb_w, nzt_w, wall_flux, a, b, c1, c2 )
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, nzb_w, nzt_w, wall_index
+ REAL :: a, b, c1, c2, h1, h2, zp
+
+ REAL :: pts, pt_i, rifs, u_i, v_i, us_wall, vel_total, ws, wspts
+
+ REAL, DIMENSION(nzb:nzt+1) :: wall_flux
+
+
+ zp = 0.5 * ( (a+c1) * dy + (b+c2) * dx )
+ wall_flux = 0.0
+ wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
+
+!
+!-- All subsequent variables are computed for the respective location where
+!-- the relevant variable is defined
+ DO k = nzb_w, nzt_w
+
+!
+!-- (1) Compute rifs, u_i, v_i, ws, pt' and w'pt'
+ rifs = rif_wall(k,j,i,wall_index)
+
+ u_i = a * u(k,j,i) + c1 * 0.25 * &
+ ( u(k+1,j,i+1) + u(k+1,j,i) + u(k,j,i+1) + u(k,j,i) )
+
+ v_i = b * v(k,j,i) + c2 * 0.25 * &
+ ( v(k+1,j+1,i) + v(k+1,j,i) + v(k,j+1,i) + v(k,j,i) )
+
+ ws = ( c1 + c2 ) * w(k,j,i) + 0.25 * ( &
+ a * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) ) &
+ + b * ( w(k-1,j-1,i) + w(k-1,j,i) + w(k,j-1,i) + w(k,j,i) ) &
+ )
+ pt_i = 0.5 * ( pt(k,j,i) + a * pt(k,j,i-1) + b * pt(k,j-1,i) &
+ + ( c1 + c2 ) * pt(k+1,j,i) )
+
+ pts = pt_i - hom(k,1,4,0)
+ wspts = ws * pts
+
+!
+!-- (2) Compute wall-parallel absolute velocity vel_total
+ vel_total = SQRT( ws**2 + ( a+c1 ) * u_i**2 + ( b+c2 ) * v_i**2 )
+
+!
+!-- (3) Compute wall friction velocity us_wall
+ IF ( rifs >= 0.0 ) THEN
+
+!
+!-- Stable stratification (and neutral)
+ us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) + &
+ 5.0 * rifs * ( zp - z0(j,i) ) / zp &
+ )
+ ELSE
+
+!
+!-- Unstable stratification
+ h1 = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifs ) )
+ h2 = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifs / zp * z0(j,i) ) )
+
+!
+!-- If a borderline case occurs, the formula for stable stratification
+!-- must be used anyway, or else a zero division would occur in the
+!-- argument of the logarithm.
+ IF ( h1 == 1.0 .OR. h2 == 1.0 ) THEN
+ us_wall = kappa * vel_total / ( LOG( zp / z0(j,i) ) + &
+ 5.0 * rifs * ( zp - z0(j,i) ) / zp &
+ )
+ ELSE
+ us_wall = kappa * vel_total / ( &
+ LOG( (1.0+h2) / (1.0-h2) * (1.0-h1) / (1.0+h1) ) + &
+ 2.0 * ( ATAN( h2 ) - ATAN( h1 ) ) &
+ )
+ ENDIF
+
+ ENDIF
+
+!
+!-- (4) Compute zp/L (corresponds to neutral Richardson flux number
+!-- rifs)
+ rifs = -1.0 * zp * kappa * g * wspts / ( pt_i * (us_wall**3 + 1E-30) )
+
+!
+!-- Limit the value range of the Richardson numbers.
+!-- This is necessary for very small velocities (u,w --> 0), because
+!-- the absolute value of rif can then become very large, which in
+!-- consequence would result in very large shear stresses and very
+!-- small momentum fluxes (both are generally unrealistic).
+ IF ( rifs < rif_min ) rifs = rif_min
+ IF ( rifs > rif_max ) rifs = rif_max
+
+!
+!-- (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
+ IF ( rifs >= 0.0 ) THEN
+
+!
+!-- Stable stratification (and neutral)
+ wall_flux(k) = kappa * &
+ ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / &
+ ( LOG( zp / z0(j,i) ) + &
+ 5.0 * rifs * ( zp - z0(j,i) ) / zp &
+ )
+ ELSE
+
+!
+!-- Unstable stratification
+ h1 = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifs ) )
+ h2 = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifs / zp * z0(j,i) ) )
+
+!
+!-- If a borderline case occurs, the formula for stable stratification
+!-- must be used anyway, or else a zero division would occur in the
+!-- argument of the logarithm.
+ IF ( h1 == 1.0 .OR. h2 == 1.0 ) THEN
+ wall_flux(k) = kappa * &
+ ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / &
+ ( LOG( zp / z0(j,i) ) + &
+ 5.0 * rifs * ( zp - z0(j,i) ) / zp &
+ )
+ ELSE
+ wall_flux(k) = kappa * &
+ ( a*u(k,j,i) + b*v(k,j,i) + (c1+c2)*w(k,j,i) ) / &
+ ( LOG( (1.0+h2) / (1.0-h2) * (1.0-h1) / (1.0+h1) )&
+ + 2.0 * ( ATAN( h2 ) - ATAN( h1 ) ) &
+ )
+ ENDIF
+
+ ENDIF
+ wall_flux(k) = -wall_flux(k) * ABS( wall_flux(k) )
+
+!
+!-- store rifs for next time step
+ rif_wall(k,j,i,wall_index) = rifs
+
+ ENDDO
+
+ END SUBROUTINE wall_fluxes_ij
+
+
+
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
+ SUBROUTINE wall_fluxes_e( wall_flux, a, b, c1, c2, wall )
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+! Calculates momentum fluxes at vertical walls for routine production_e
+! assuming Monin-Obukhov similarity.
+! Indices: usvs a=1, vsus b=1, wsvs c1=1, wsus c2=1 (other=0).
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, kk, wall_index
+ REAL :: a, b, c1, c2, h1, h2, vel_zp, zp
+
+ REAL :: rifs
+
+ REAL, DIMENSION(nys-1:nyn+1,nxl-1:nxr+1) :: wall
+ REAL, DIMENSION(nzb:nzt+1,nys:nyn,nxl:nxr) :: wall_flux
+
+
+ zp = 0.5 * ( (a+c1) * dy + (b+c2) * dx )
+ wall_flux = 0.0
+ wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
+
+ DO i = nxl, nxr
+ DO j = nys, nyn
+
+ IF ( wall(j,i) /= 0.0 ) THEN
+!
+!-- All subsequent variables are computed for the respective
+!-- location where the relevant variable is defined
+ DO k = nzb_diff_s_inner(j,i)-1, nzb_diff_s_outer(j,i)-2
+
+!
+!-- (1) Compute rifs
+ IF ( k == nzb_diff_s_inner(j,i)-1 ) THEN
+ kk = nzb_diff_s_inner(j,i)-1
+ ELSE
+ kk = k-1
+ ENDIF
+ rifs = 0.5 * ( rif_wall(k,j,i,wall_index) + &
+ a * rif_wall(k,j,i+1,1) + b * rif_wall(k,j+1,i,2) + &
+ c1 * rif_wall(kk,j,i,3) + c2 * rif_wall(kk,j,i,4) &
+ )
+
+!
+!-- Skip (2) to (4) of wall_fluxes, because here rifs is
+!-- already available from (1)
+
+!
+!-- (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
+ vel_zp = 0.5 * ( a * ( u(k,j,i) + u(k,j,i+1) ) + &
+ b * ( v(k,j,i) + v(k,j+1,i) ) + &
+ (c1+c2) * ( w(k,j,i) + w(k-1,j,i) ) &
+ )
+
+ IF ( rifs >= 0.0 ) THEN
+
+!
+!-- Stable stratification (and neutral)
+ wall_flux(k,j,i) = kappa * vel_zp / &
+ ( LOG( zp/z0(j,i) ) + 5.0*rifs * ( zp-z0(j,i) ) / zp )
+ ELSE
+
+!
+!-- Unstable stratification
+ h1 = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifs ) )
+ h2 = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifs / zp * z0(j,i) ))
+
+!
+!-- If a borderline case occurs, the formula for stable
+!-- stratification must be used anyway, or else a zero
+!-- division would occur in the argument of the logarithm.
+ IF ( h1 == 1.0 .OR. h2 == 1.0 ) THEN
+ wall_flux(k,j,i) = kappa * vel_zp / &
+ ( LOG( zp / z0(j,i) ) + &
+ 5.0 * rifs * ( zp - z0(j,i) ) / zp &
+ )
+ ELSE
+ wall_flux(k,j,i) = kappa * vel_zp / &
+ ( LOG( (1.0+h2) / (1.0-h2) * (1.0-h1) / (1.0+h1) ) &
+ + 2.0 * ( ATAN( h2 ) - ATAN( h1 ) ) &
+ )
+ ENDIF
+
+ ENDIF
+ wall_flux(k,j,i) = wall_flux(k,j,i) * ABS( wall_flux(k,j,i) )
+
+!
+!-- Store rifs for next time step
+ rif_wall(k,j,i,wall_index) = rifs
+
+ ENDDO
+
+ ENDIF
+
+ ENDDO
+ ENDDO
+
+ END SUBROUTINE wall_fluxes_e
+
+
+
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
+ SUBROUTINE wall_fluxes_e_ij( i, j, nzb_w, nzt_w, wall_flux, a, b, c1, c2 )
+
+ USE arrays_3d
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE statistics
+
+ IMPLICIT NONE
+
+ INTEGER :: i, j, k, kk, nzb_w, nzt_w, wall_index
+ REAL :: a, b, c1, c2, h1, h2, vel_zp, zp
+
+ REAL :: rifs
+
+ REAL, DIMENSION(nzb:nzt+1) :: wall_flux
+
+
+ zp = 0.5 * ( (a+c1) * dy + (b+c2) * dx )
+ wall_flux = 0.0
+ wall_index = NINT( a+ 2*b + 3*c1 + 4*c2 )
+
+!
+!-- All subsequent variables are computed for the respective location where
+!-- the relevant variable is defined
+ DO k = nzb_w, nzt_w
+
+!
+!-- (1) Compute rifs
+ IF ( k == nzb_w ) THEN
+ kk = nzb_w
+ ELSE
+ kk = k-1
+ ENDIF
+ rifs = 0.5 * ( rif_wall(k,j,i,wall_index) + &
+ a * rif_wall(k,j,i+1,1) + b * rif_wall(k,j+1,i,2) + &
+ c1 * rif_wall(kk,j,i,3) + c2 * rif_wall(kk,j,i,4) &
+ )
+
+!
+!-- Skip (2) to (4) of wall_fluxes, because here rifs is already available
+!-- from (1)
+
+!
+!-- (5) Compute wall_flux (u'v', v'u', w'v', or w'u')
+ vel_zp = 0.5 * ( a * ( u(k,j,i) + u(k,j,i+1) ) + &
+ b * ( v(k,j,i) + v(k,j+1,i) ) + &
+ (c1+c2) * ( w(k,j,i) + w(k-1,j,i) ) &
+ )
+
+ IF ( rifs >= 0.0 ) THEN
+
+!
+!-- Stable stratification (and neutral)
+ wall_flux(k) = kappa * vel_zp / &
+ ( LOG( zp/z0(j,i) ) + 5.0*rifs * ( zp-z0(j,i) ) / zp )
+ ELSE
+
+!
+!-- Unstable stratification
+ h1 = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifs ) )
+ h2 = 1.0 / SQRT( SQRT( 1.0 - 16.0 * rifs / zp * z0(j,i) ) )
+
+!
+!-- If a borderline case occurs, the formula for stable stratification
+!-- must be used anyway, or else a zero division would occur in the
+!-- argument of the logarithm.
+ IF ( h1 == 1.0 .OR. h2 == 1.0 ) THEN
+ wall_flux(k) = kappa * vel_zp / &
+ ( LOG( zp / z0(j,i) ) + &
+ 5.0 * rifs * ( zp - z0(j,i) ) / zp &
+ )
+ ELSE
+ wall_flux(k) = kappa * vel_zp / &
+ ( LOG( (1.0+h2) / (1.0-h2) * (1.0-h1) / (1.0+h1) ) &
+ + 2.0 * ( ATAN( h2 ) - ATAN( h1 ) ) &
+ )
+ ENDIF
+
+ ENDIF
+ wall_flux(k) = wall_flux(k) * ABS( wall_flux(k) )
+
+!
+!-- Store rifs for next time step
+ rif_wall(k,j,i,wall_index) = rifs
+
+ ENDDO
+
+ END SUBROUTINE wall_fluxes_e_ij
+
+ END MODULE wall_fluxes_mod
Index: /palm/tags/release-3.4a/SOURCE/write_3d_binary.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/write_3d_binary.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/write_3d_binary.f90 (revision 141)
@@ -0,0 +1,312 @@
+ SUBROUTINE write_3d_binary
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 102 2007-07-27 09:09:17Z raasch
+! +uswst, uswst_m, vswst, vswst_m
+!
+! 96 2007-06-04 08:07:41Z raasch
+! +rho_av, sa, sa_av, saswsb, saswst
+!
+! 75 2007-03-22 09:54:05Z raasch
+! +precipitation_amount, precipitation_rate_av, rif_wall, u_m_l, u_m_r, etc.,
+! z0_av, moisture renamed humidity
+!
+! 19 2007-02-23 04:53:48Z raasch
+! +qswst, qswst_m, tswst, tswst_m
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.21 2006/08/04 15:05:11 raasch
+! +iran, iran_part
+!
+! Revision 1.1 1998/03/18 20:20:21 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Binary output of variables and arrays for restarts.
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE averaging
+ USE cloud_parameters
+ USE control_parameters
+ USE cpulog
+ USE indices
+ USE interfaces
+ USE particle_attributes
+ USE pegrid
+ USE profil_parameter
+ USE random_function_mod
+ USE statistics
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=10) :: binary_version
+
+
+ CALL cpu_log( log_point(22), 'write_3d_binary', 'start' )
+
+ CALL check_open( 14 )
+
+!
+!-- Write control parameters and other variables for restart.
+ CALL write_var_list
+
+!
+!-- Write arrays.
+ binary_version = '3.0'
+
+ WRITE ( 14 ) binary_version
+
+ WRITE ( 14 ) numprocs, myid, nxl, nxr, nys, nyn, nzb, nzt
+
+!
+!-- Attention: After changes to the following output commands the version number
+!-- --------- of the variable binary_version must be changed!
+!-- Also, the list of arrays to be read in read_3d_binary must be
+!-- adjusted accordingly.
+
+ WRITE ( 14 ) 'e '; WRITE ( 14 ) e
+ IF ( ALLOCATED( e_av ) ) THEN
+ WRITE ( 14 ) 'e_av '; WRITE ( 14 ) e_av
+ ENDIF
+ WRITE ( 14 ) 'e_m '; WRITE ( 14 ) e_m
+ WRITE ( 14 ) 'iran '; WRITE ( 14 ) iran, iran_part
+ WRITE ( 14 ) 'kh '; WRITE ( 14 ) kh
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+ WRITE ( 14 ) 'kh_m '; WRITE ( 14 ) kh_m
+ ENDIF
+ WRITE ( 14 ) 'km '; WRITE ( 14 ) km
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+ WRITE ( 14 ) 'km_m '; WRITE ( 14 ) km_m
+ ENDIF
+ IF ( ALLOCATED( lwp_av ) ) THEN
+ WRITE ( 14 ) 'lwp_av '; WRITE ( 14 ) lwp_av
+ ENDIF
+ WRITE ( 14 ) 'p '; WRITE ( 14 ) p
+ IF ( ALLOCATED( p_av ) ) THEN
+ WRITE ( 14 ) 'p_av '; WRITE ( 14 ) p_av
+ ENDIF
+ IF ( ALLOCATED( pc_av ) ) THEN
+ WRITE ( 14 ) 'pc_av '; WRITE ( 14 ) pc_av
+ ENDIF
+ IF ( ALLOCATED( pr_av ) ) THEN
+ WRITE ( 14 ) 'pr_av '; WRITE ( 14 ) pr_av
+ ENDIF
+ IF ( ALLOCATED( precipitation_amount ) ) THEN
+ WRITE ( 14 ) 'precipitation_amount'; WRITE ( 14 ) precipitation_amount
+ ENDIF
+ IF ( ALLOCATED( precipitation_rate_av ) ) THEN
+ WRITE ( 14 ) 'precipitation_rate_a'; WRITE ( 14 ) &
+ precipitation_rate_av
+ ENDIF
+ WRITE ( 14 ) 'pt '; WRITE ( 14 ) pt
+ IF ( ALLOCATED( pt_av ) ) THEN
+ WRITE ( 14 ) 'pt_av '; WRITE ( 14 ) pt_av
+ ENDIF
+ WRITE ( 14 ) 'pt_m '; WRITE ( 14 ) pt_m
+ IF ( humidity .OR. passive_scalar ) THEN
+ WRITE ( 14 ) 'q '; WRITE ( 14 ) q
+ IF ( ALLOCATED( q_av ) ) THEN
+ WRITE ( 14 ) 'q_av '; WRITE ( 14 ) q_av
+ ENDIF
+ WRITE ( 14 ) 'q_m '; WRITE ( 14 ) q_m
+ IF ( cloud_physics ) THEN
+ WRITE ( 14 ) 'ql '; WRITE ( 14 ) ql
+ IF ( ALLOCATED( ql_av ) ) THEN
+ WRITE ( 14 ) 'ql_av '; WRITE ( 14 ) ql_av
+ ENDIF
+ ENDIF
+ WRITE ( 14 ) 'qs '; WRITE ( 14 ) qs
+ WRITE ( 14 ) 'qsws '; WRITE ( 14 ) qsws
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+ WRITE ( 14 ) 'qsws_m '; WRITE ( 14 ) qsws_m
+ ENDIF
+ WRITE ( 14 ) 'qswst '; WRITE ( 14 ) qswst
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+ WRITE ( 14 ) 'qswst_m '; WRITE ( 14 ) qswst_m
+ ENDIF
+ ENDIF
+ IF ( ocean ) THEN
+ IF ( ALLOCATED( rho_av ) ) THEN
+ WRITE ( 14 ) 'rho_av '; WRITE ( 14 ) rho_av
+ ENDIF
+ WRITE ( 14 ) 'sa '; WRITE ( 14 ) sa
+ IF ( ALLOCATED( sa_av ) ) THEN
+ WRITE ( 14 ) 'sa_av '; WRITE ( 14 ) sa_av
+ ENDIF
+ WRITE ( 14 ) 'saswsb '; WRITE ( 14 ) saswsb
+ WRITE ( 14 ) 'saswst '; WRITE ( 14 ) saswst
+ ENDIF
+ IF ( ALLOCATED( ql_c_av ) ) THEN
+ WRITE ( 14 ) 'ql_c_av '; WRITE ( 14 ) ql_c_av
+ ENDIF
+ IF ( ALLOCATED( ql_v_av ) ) THEN
+ WRITE ( 14 ) 'ql_v_av '; WRITE ( 14 ) ql_v_av
+ ENDIF
+ IF ( ALLOCATED( ql_vp_av ) ) THEN
+ WRITE ( 14 ) 'ql_vp_av '; WRITE ( 14 ) ql_vp_av
+ ENDIF
+ IF ( ALLOCATED( qv_av ) ) THEN
+ WRITE ( 14 ) 'qv_av '; WRITE ( 14 ) qv_av
+ ENDIF
+ WRITE ( 14 ) 'random_iv '; WRITE ( 14 ) random_iv
+ WRITE ( 14 ) random_iy
+ WRITE ( 14 ) 'rif '; WRITE ( 14 ) rif
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+ WRITE ( 14 ) 'rif_m '; WRITE ( 14 ) rif_m
+ ENDIF
+ IF ( topography /= 'flat' ) THEN
+ WRITE ( 14 ) 'rif_wall '; WRITE ( 14 ) rif_wall
+ ENDIF
+ IF ( ALLOCATED( s_av ) ) THEN
+ WRITE ( 14 ) 's_av '; WRITE ( 14 ) s_av
+ ENDIF
+ WRITE ( 14 ) 'shf '; WRITE ( 14 ) shf
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+ WRITE ( 14 ) 'shf_m '; WRITE ( 14 ) shf_m
+ ENDIF
+ WRITE ( 14 ) 'ts '; WRITE ( 14 ) ts
+ IF ( ALLOCATED( ts_av ) ) THEN
+ WRITE ( 14 ) 'ts_av '; WRITE ( 14 ) ts_av
+ ENDIF
+ WRITE ( 14 ) 'tswst '; WRITE ( 14 ) tswst
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+ WRITE ( 14 ) 'tswst_m '; WRITE ( 14 ) tswst_m
+ ENDIF
+ WRITE ( 14 ) 'u '; WRITE ( 14 ) u
+ IF ( ALLOCATED( u_av ) ) THEN
+ WRITE ( 14 ) 'u_av '; WRITE ( 14 ) u_av
+ ENDIF
+ WRITE ( 14 ) 'u_m '; WRITE ( 14 ) u_m
+ IF ( ALLOCATED( u_m_l ) ) THEN
+ WRITE ( 14 ) 'u_m_l '; WRITE ( 14 ) u_m_l
+ ENDIF
+ IF ( ALLOCATED( u_m_n ) ) THEN
+ WRITE ( 14 ) 'u_m_n '; WRITE ( 14 ) u_m_n
+ ENDIF
+ IF ( ALLOCATED( u_m_r ) ) THEN
+ WRITE ( 14 ) 'u_m_r '; WRITE ( 14 ) u_m_r
+ ENDIF
+ IF ( ALLOCATED( u_m_s ) ) THEN
+ WRITE ( 14 ) 'u_m_s '; WRITE ( 14 ) u_m_s
+ ENDIF
+ WRITE ( 14 ) 'us '; WRITE ( 14 ) us
+ WRITE ( 14 ) 'usws '; WRITE ( 14 ) usws
+ WRITE ( 14 ) 'uswst '; WRITE ( 14 ) uswst
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+ WRITE ( 14 ) 'usws_m '; WRITE ( 14 ) usws_m
+ WRITE ( 14 ) 'uswst_m '; WRITE ( 14 ) uswst_m
+ ENDIF
+ IF ( ALLOCATED( us_av ) ) THEN
+ WRITE ( 14 ) 'us_av '; WRITE ( 14 ) us_av
+ ENDIF
+ WRITE ( 14 ) 'v '; WRITE ( 14 ) v
+ WRITE ( 14 ) 'volume_flow_area '; WRITE ( 14 ) volume_flow_area
+ WRITE ( 14 ) 'volume_flow_initial '; WRITE ( 14 ) volume_flow_initial
+ IF ( ALLOCATED( v_av ) ) THEN
+ WRITE ( 14 ) 'v_av '; WRITE ( 14 ) v_av
+ ENDIF
+ WRITE ( 14 ) 'v_m '; WRITE ( 14 ) v_m
+ IF ( ALLOCATED( v_m_l ) ) THEN
+ WRITE ( 14 ) 'v_m_l '; WRITE ( 14 ) v_m_l
+ ENDIF
+ IF ( ALLOCATED( v_m_n ) ) THEN
+ WRITE ( 14 ) 'v_m_n '; WRITE ( 14 ) v_m_n
+ ENDIF
+ IF ( ALLOCATED( v_m_r ) ) THEN
+ WRITE ( 14 ) 'v_m_r '; WRITE ( 14 ) v_m_r
+ ENDIF
+ IF ( ALLOCATED( v_m_s ) ) THEN
+ WRITE ( 14 ) 'v_m_s '; WRITE ( 14 ) v_m_s
+ ENDIF
+ IF ( humidity ) THEN
+ WRITE ( 14 ) 'vpt '; WRITE ( 14 ) vpt
+ IF ( ALLOCATED( vpt_av ) ) THEN
+ WRITE ( 14 ) 'vpt_av '; WRITE ( 14 ) vpt_av
+ ENDIF
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+ WRITE ( 14 ) 'vpt_m '; WRITE ( 14 ) vpt_m
+ ENDIF
+ ENDIF
+ WRITE ( 14 ) 'vsws '; WRITE ( 14 ) vsws
+ WRITE ( 14 ) 'vswst '; WRITE ( 14 ) vswst
+ IF ( timestep_scheme(1:5) /= 'runge' ) THEN
+ WRITE ( 14 ) 'vsws_m '; WRITE ( 14 ) vsws_m
+ WRITE ( 14 ) 'vswst_m '; WRITE ( 14 ) vswst_m
+ ENDIF
+ WRITE ( 14 ) 'w '; WRITE ( 14 ) w
+ IF ( ALLOCATED( w_av ) ) THEN
+ WRITE ( 14 ) 'w_av '; WRITE ( 14 ) w_av
+ ENDIF
+ WRITE ( 14 ) 'w_m '; WRITE ( 14 ) w_m
+ IF ( ALLOCATED( w_m_l ) ) THEN
+ WRITE ( 14 ) 'w_m_l '; WRITE ( 14 ) w_m_l
+ ENDIF
+ IF ( ALLOCATED( w_m_n ) ) THEN
+ WRITE ( 14 ) 'w_m_n '; WRITE ( 14 ) w_m_n
+ ENDIF
+ IF ( ALLOCATED( w_m_r ) ) THEN
+ WRITE ( 14 ) 'w_m_r '; WRITE ( 14 ) w_m_r
+ ENDIF
+ IF ( ALLOCATED( w_m_s ) ) THEN
+ WRITE ( 14 ) 'w_m_s '; WRITE ( 14 ) w_m_s
+ ENDIF
+ WRITE ( 14 ) 'z0 '; WRITE ( 14 ) z0
+ IF ( ALLOCATED( z0_av ) ) THEN
+ WRITE ( 14 ) 'z0_av '; WRITE ( 14 ) z0_av
+ ENDIF
+
+ WRITE ( 14 ) 'cross_linecolors '; WRITE ( 14 ) cross_linecolors
+ WRITE ( 14 ) 'cross_linestyles '; WRITE ( 14 ) cross_linestyles
+ WRITE ( 14 ) 'cross_normalized_x '; WRITE ( 14 ) cross_normalized_x
+ WRITE ( 14 ) 'cross_normalized_y '; WRITE ( 14 ) cross_normalized_y
+ WRITE ( 14 ) 'cross_normx_factor '; WRITE ( 14 ) cross_normx_factor
+ WRITE ( 14 ) 'cross_normy_factor '; WRITE ( 14 ) cross_normy_factor
+ WRITE ( 14 ) 'cross_profiles '; WRITE ( 14 ) cross_profiles
+ WRITE ( 14 ) 'cross_profile_n_coun'
+ WRITE ( 14 ) cross_profile_number_count
+ WRITE ( 14 ) 'cross_profile_number'; WRITE ( 14 ) cross_profile_numbers
+ WRITE ( 14 ) 'cross_uxmax '; WRITE ( 14 ) cross_uxmax
+ WRITE ( 14 ) 'cross_uxmax_computed'; WRITE ( 14 ) cross_uxmax_computed
+ WRITE ( 14 ) 'cross_uxmax_normaliz'; WRITE ( 14 ) cross_uxmax_normalized
+ WRITE ( 14 ) 'cross_uxmax_norm_com'
+ WRITE ( 14 ) cross_uxmax_normalized_computed
+ WRITE ( 14 ) 'cross_uxmin '; WRITE ( 14 ) cross_uxmin
+ WRITE ( 14 ) 'cross_uxmin_computed'; WRITE ( 14 ) cross_uxmin_computed
+ WRITE ( 14 ) 'cross_uxmin_normaliz'; WRITE ( 14 ) cross_uxmin_normalized
+ WRITE ( 14 ) 'cross_uxmin_norm_com'
+ WRITE ( 14 ) cross_uxmin_normalized_computed
+ WRITE ( 14 ) 'cross_uymax '; WRITE ( 14 ) cross_uymax
+ WRITE ( 14 ) 'cross_uymin '; WRITE ( 14 ) cross_uymin
+ WRITE ( 14 ) 'cross_xtext '; WRITE ( 14 ) cross_xtext
+ WRITE ( 14 ) 'dopr_crossindex '; WRITE ( 14 ) dopr_crossindex
+ WRITE ( 14 ) 'dopr_time_count '; WRITE ( 14 ) dopr_time_count
+ WRITE ( 14 ) 'hom_sum '; WRITE ( 14 ) hom_sum
+ WRITE ( 14 ) 'profile_columns '; WRITE ( 14 ) profile_columns
+ WRITE ( 14 ) 'profile_number '; WRITE ( 14 ) profile_number
+ WRITE ( 14 ) 'profile_rows '; WRITE ( 14 ) profile_rows
+ IF ( ALLOCATED( spectrum_x ) ) THEN
+ WRITE ( 14 ) 'spectrum_x '; WRITE ( 14 ) spectrum_x
+ WRITE ( 14 ) 'spectrum_y '; WRITE ( 14 ) spectrum_y
+ ENDIF
+
+!
+!-- Write end label. Unit 14 is closed in the main program.
+ WRITE ( 14 ) '*** end *** '
+
+
+ CALL cpu_log( log_point(22), 'write_3d_binary', 'stop' )
+
+
+ END SUBROUTINE write_3d_binary
Index: /palm/tags/release-3.4a/SOURCE/write_compressed.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/write_compressed.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/write_compressed.f90 (revision 141)
@@ -0,0 +1,211 @@
+ SUBROUTINE write_compressed( field, fid_avs, fid_fld, my_id, nxl, nxr, nyn, &
+ nys, nzb, nz_do3d, prec )
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! ---------------------
+! $Id$
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.4 2006/02/23 13:15:09 raasch
+! nz_plot3d renamed nz_do3d
+!
+! Revision 1.1 1999/03/02 09:25:21 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! In this routine, 3D-data (to be plotted) are scaled and compressed by
+! the method of bit shifting. It is designed for the use outside of PALM
+! also, which is the reason why most of the data is passed by subroutine
+! arguments. Nevertheless, the module pegrid is needed by MPI calls.
+!
+! Arguments:
+! field = data array to be compressed
+! fid_avs = file-ID of AVS-data-file
+! fid_fld = file-ID of AVS-header-file
+! my_id = ID of the calling PE
+! nxl, nxr = index bounds of the subdomain along x
+! nyn, nys = index bounds of the subdomain along y
+! nzb,nz_do3d = index bounds of the domain along z (can be smaller than
+! the total domain)
+! prec = precision of packed data (number of digits after decimal
+! point)
+!------------------------------------------------------------------------------!
+
+ USE pegrid ! needed for MPI_ALLREDUCE
+
+ IMPLICIT NONE
+
+ INTEGER, PARAMETER :: ip4 = SELECTED_INT_KIND ( 9 )
+ INTEGER, PARAMETER :: spk = SELECTED_REAL_KIND( 6 )
+
+ INTEGER :: ampl, dummy1, dummy2, factor, i, ifieldmax, ifieldmax_l, &
+ ifieldmin, ifieldmin_l, ii, j, k, length, nfree, npack, nsize, &
+ nx, ny, nz, pos, startpos
+ INTEGER(ip4) :: imask (32)
+ INTEGER(ip4), DIMENSION(:), ALLOCATABLE :: ifield, packed_ifield
+
+ INTEGER, INTENT(IN) :: fid_avs, fid_fld, my_id, nxl, nxr, nyn, nys, nzb, &
+ nz_do3d, prec
+
+ REAL(spk), INTENT(IN) :: field(1:((nxr-nxl+3)*(nyn-nys+3)*(nz_do3d-nzb+1)))
+
+!
+!-- Initialise local variables
+ ampl = 0
+ ifieldmax = 0
+ ifieldmin = 0
+ npack = 0
+ nsize = 0
+ DO i = 1,32
+ imask(i) = (2**i) - 1
+ ENDDO
+
+ nx = nxr - nxl + 2
+ ny = nyn - nys + 2
+ nz = nz_do3d - nzb
+ length = (nx+1) * (ny+1) * (nz+1)
+
+!
+!-- Allocate memory for integer array
+ ALLOCATE ( ifield(1:length) )
+
+!
+!-- Store data on integer (in desired precision)
+ factor = 10**prec
+ DO i = 1, length
+ ifield(i) = NINT( field(i) * factor )
+ ENDDO
+
+!
+!-- Find minimum and maximum
+ ifieldmax_l = MAXVAL( ifield )
+ ifieldmin_l = MINVAL( ifield )
+
+#if defined( __parallel )
+ CALL MPI_ALLREDUCE( ifieldmax_l, ifieldmax, 1, MPI_INTEGER, MPI_MAX, &
+ comm2d, ierr )
+ CALL MPI_ALLREDUCE( ifieldmin_l, ifieldmin, 1, MPI_INTEGER, MPI_MIN, &
+ comm2d, ierr )
+#else
+ ifieldmax = ifieldmax_l
+ ifieldmin = ifieldmin_l
+#endif
+
+!
+!-- Minimum scaling
+ ifield = ifield - ifieldmin
+
+!
+!-- Calculate the number of bits needed for each value
+ ampl = ifieldmax - ifieldmin
+ nsize = 1
+
+ DO WHILE ( imask(nsize) < ampl )
+ nsize = nsize + 1
+ ENDDO
+
+!
+!-- Calculate size of the packed array
+ npack = length * nsize
+ IF ( MOD( npack, 32 ) /= 0 ) npack = npack + 32
+ npack = npack / 32
+
+!
+!-- Start packing the data
+ ALLOCATE ( packed_ifield(1:npack) )
+ packed_ifield = 0
+
+!
+!-- Starting position of a word
+ startpos = 0
+
+!
+!-- Starting position of the word to which data are actually written
+ ii = 1
+
+!
+!-- Compress all data
+ DO i = 1, length
+
+!
+!-- Cut the significant bits from the actual grid point value (GPV)
+ dummy1 = IAND( ifield(i), imask(nsize) )
+
+!
+!-- Calculate number of free bits of the actual word after packing the GPV
+ nfree = 32 - startpos - nsize
+
+ IF ( nfree > 0 ) THEN
+!
+!-- GPV fits to the actual word (ii), additional bits are still free.
+!-- Shift GPV to the new position
+ dummy2 = ISHFT( dummy1 ,nfree )
+
+!
+!-- Append bits to the already packed data
+ packed_ifield(ii) = packed_ifield(ii) + dummy2
+
+!
+!-- Calculate new starting position
+ startpos = startpos + nsize
+
+ ELSEIF ( nfree .EQ. 0 ) THEN
+!
+!-- GPV fills the actual word (ii) exactly
+ packed_ifield(ii) = packed_ifield(ii) + dummy1
+
+!
+!-- Activate next (new) word
+ ii = ii + 1
+
+!
+!-- Reset starting position of the new word
+ startpos = 0
+
+ ELSE
+!
+!-- GPV must be split up to the actual (ii) and the following (ii+1)
+!-- word. Shift first part of GPV to its position.
+ dummy2 = ISHFT( dummy1, nfree )
+
+!
+!-- Append bits
+ packed_ifield(ii) = packed_ifield(ii) + dummy2
+
+!
+!-- Store rest of GPV on the next word
+ ii = ii + 1
+ packed_ifield(ii) = ISHFT( dummy1, 32+nfree )
+!
+!-- Calculate starting position of the next GPV
+ startpos = -nfree
+
+ ENDIF
+
+ ENDDO
+
+!
+!-- Write the compressed 3D array
+ WRITE ( fid_avs ) packed_ifield
+
+!
+!-- Write additional informations on FLD-file
+ IF ( my_id == 0 ) WRITE ( fid_fld, 100 ) prec, ifieldmin, nsize, length
+
+ DEALLOCATE( ifield, packed_ifield )
+
+!
+!-- Formats
+100 FORMAT ('# precision = ',I4/ &
+ '# feldmin = ',I8/ &
+ '# nbits = ',I2/ &
+ '# nskip = ',I8)
+
+END SUBROUTINE write_compressed
Index: /palm/tags/release-3.4a/SOURCE/write_var_list.f90
===================================================================
--- /palm/tags/release-3.4a/SOURCE/write_var_list.f90 (revision 141)
+++ /palm/tags/release-3.4a/SOURCE/write_var_list.f90 (revision 141)
@@ -0,0 +1,448 @@
+ SUBROUTINE write_var_list
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 138 2007-11-28 10:03:58Z letzel
+! +canopy_mode, drag_coefficient, lad, lad_surface, lad_vertical_gradient,
+! lad_vertical_gradient_level, lad_vertical_gradient_level_ind, pch_index,
+! plant_canopy, time_sort_particles
+!
+! 102 2007-07-27 09:09:17Z raasch
+! +top_momentumflux_u|v, time_coupling
+!
+! 95 2007-06-02 16:48:38Z raasch
+! +bc_sa_t, ocean, sa_init, sa_surface, sa_vertical_gradient,
+! sa_vertical_gradient_level, bottom/top_salinity_flux
+!
+! 87 2007-05-22 15:46:47Z raasch
+! +max_pr_user (version 3.1)
+!
+! 75 2007-03-22 09:54:05Z raasch
+! +loop_optimization, pt_refrence, moisture renamed humidity
+!
+! 20 2007-02-26 00:12:32Z raasch
+! +top_heatflux, use_top_fluxes
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! Revision 1.34 2006/08/22 14:30:52 raasch
+! +dz_max
+!
+! Revision 1.1 1998/03/18 20:20:38 raasch
+! Initial revision
+!
+!
+! Description:
+! ------------
+! Writing values of control variables to restart-file (binary format)
+!------------------------------------------------------------------------------!
+
+ USE arrays_3d
+ USE averaging
+ USE control_parameters
+ USE grid_variables
+ USE indices
+ USE model_1d
+ USE particle_attributes
+ USE pegrid
+ USE profil_parameter
+ USE statistics
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=10) :: binary_version
+
+
+
+ binary_version = '3.1'
+
+ WRITE ( 14 ) binary_version ! opened in write_3d_binary
+
+ WRITE ( 14 ) 'nz '
+ WRITE ( 14 ) nz
+ WRITE ( 14 ) 'max_pr_user '
+ WRITE ( 14 ) max_pr_user
+ WRITE ( 14 ) 'statistic_regions '
+ WRITE ( 14 ) statistic_regions
+
+!
+!-- Caution: After changes in the following parameter-list, the
+!-- ------- version number stored in the variable binary_version has to be
+!-- increased. The same changes must also be done in the parameter-
+!-- list in read_var_list.
+
+ WRITE ( 14 ) 'adjust_mixing_length '
+ WRITE ( 14 ) adjust_mixing_length
+ WRITE ( 14 ) 'advected_distance_x '
+ WRITE ( 14 ) advected_distance_x
+ WRITE ( 14 ) 'advected_distance_y '
+ WRITE ( 14 ) advected_distance_y
+ WRITE ( 14 ) 'alpha_surface '
+ WRITE ( 14 ) alpha_surface
+ WRITE ( 14 ) 'average_count_pr '
+ WRITE ( 14 ) average_count_pr
+ WRITE ( 14 ) 'average_count_sp '
+ WRITE ( 14 ) average_count_sp
+ WRITE ( 14 ) 'average_count_3d '
+ WRITE ( 14 ) average_count_3d
+ WRITE ( 14 ) 'bc_e_b '
+ WRITE ( 14 ) bc_e_b
+ WRITE ( 14 ) 'bc_lr '
+ WRITE ( 14 ) bc_lr
+ WRITE ( 14 ) 'bc_ns '
+ WRITE ( 14 ) bc_ns
+ WRITE ( 14 ) 'bc_p_b '
+ WRITE ( 14 ) bc_p_b
+ WRITE ( 14 ) 'bc_p_t '
+ WRITE ( 14 ) bc_p_t
+ WRITE ( 14 ) 'bc_pt_b '
+ WRITE ( 14 ) bc_pt_b
+ WRITE ( 14 ) 'bc_pt_t '
+ WRITE ( 14 ) bc_pt_t
+ WRITE ( 14 ) 'bc_pt_t_val '
+ WRITE ( 14 ) bc_pt_t_val
+ WRITE ( 14 ) 'bc_q_b '
+ WRITE ( 14 ) bc_q_b
+ WRITE ( 14 ) 'bc_q_t '
+ WRITE ( 14 ) bc_q_t
+ WRITE ( 14 ) 'bc_q_t_val '
+ WRITE ( 14 ) bc_q_t_val
+ WRITE ( 14 ) 'bc_s_b '
+ WRITE ( 14 ) bc_s_b
+ WRITE ( 14 ) 'bc_s_t '
+ WRITE ( 14 ) bc_s_t
+ WRITE ( 14 ) 'bc_sa_t '
+ WRITE ( 14 ) bc_sa_t
+ WRITE ( 14 ) 'bc_uv_b '
+ WRITE ( 14 ) bc_uv_b
+ WRITE ( 14 ) 'bc_uv_t '
+ WRITE ( 14 ) bc_uv_t
+ WRITE ( 14 ) 'bottom_salinityflux '
+ WRITE ( 14 ) bottom_salinityflux
+ WRITE ( 14 ) 'building_height '
+ WRITE ( 14 ) building_height
+ WRITE ( 14 ) 'building_length_x '
+ WRITE ( 14 ) building_length_x
+ WRITE ( 14 ) 'building_length_y '
+ WRITE ( 14 ) building_length_y
+ WRITE ( 14 ) 'building_wall_left '
+ WRITE ( 14 ) building_wall_left
+ WRITE ( 14 ) 'building_wall_south '
+ WRITE ( 14 ) building_wall_south
+ WRITE ( 14 ) 'canopy_mode '
+ WRITE ( 14 ) canopy_mode
+ WRITE ( 14 ) 'cloud_droplets '
+ WRITE ( 14 ) cloud_droplets
+ WRITE ( 14 ) 'cloud_physics '
+ WRITE ( 14 ) cloud_physics
+ WRITE ( 14 ) 'conserve_volume_flow '
+ WRITE ( 14 ) conserve_volume_flow
+ WRITE ( 14 ) 'current_timestep_number '
+ WRITE ( 14 ) current_timestep_number
+ WRITE ( 14 ) 'cut_spline_overshoot '
+ WRITE ( 14 ) cut_spline_overshoot
+ WRITE ( 14 ) 'damp_level_1d '
+ WRITE ( 14 ) damp_level_1d
+ WRITE ( 14 ) 'dissipation_1d '
+ WRITE ( 14 ) dissipation_1d
+ WRITE ( 14 ) 'drag_coefficient '
+ WRITE ( 14 ) drag_coefficient
+ WRITE ( 14 ) 'dt_fixed '
+ WRITE ( 14 ) dt_fixed
+ WRITE ( 14 ) 'dt_pr_1d '
+ WRITE ( 14 ) dt_pr_1d
+ WRITE ( 14 ) 'dt_run_control_1d '
+ WRITE ( 14 ) dt_run_control_1d
+ WRITE ( 14 ) 'dt_3d '
+ WRITE ( 14 ) dt_3d
+ WRITE ( 14 ) 'dvrp_filecount '
+ WRITE ( 14 ) dvrp_filecount
+ WRITE ( 14 ) 'dx '
+ WRITE ( 14 ) dx
+ WRITE ( 14 ) 'dy '
+ WRITE ( 14 ) dy
+ WRITE ( 14 ) 'dz '
+ WRITE ( 14 ) dz
+ WRITE ( 14 ) 'dz_max '
+ WRITE ( 14 ) dz_max
+ WRITE ( 14 ) 'dz_stretch_factor '
+ WRITE ( 14 ) dz_stretch_factor
+ WRITE ( 14 ) 'dz_stretch_level '
+ WRITE ( 14 ) dz_stretch_level
+ WRITE ( 14 ) 'e_min '
+ WRITE ( 14 ) e_min
+ WRITE ( 14 ) 'end_time_1d '
+ WRITE ( 14 ) end_time_1d
+ WRITE ( 14 ) 'fft_method '
+ WRITE ( 14 ) fft_method
+ WRITE ( 14 ) 'first_call_advec_particles '
+ WRITE ( 14 ) first_call_advec_particles
+ WRITE ( 14 ) 'galilei_transformation '
+ WRITE ( 14 ) galilei_transformation
+ WRITE ( 14 ) 'grid_matching '
+ WRITE ( 14 ) grid_matching
+ WRITE ( 14 ) 'hom '
+ WRITE ( 14 ) hom
+ WRITE ( 14 ) 'inflow_disturbance_begin '
+ WRITE ( 14 ) inflow_disturbance_begin
+ WRITE ( 14 ) 'inflow_disturbance_end '
+ WRITE ( 14 ) inflow_disturbance_end
+ WRITE ( 14 ) 'km_constant '
+ WRITE ( 14 ) km_constant
+ WRITE ( 14 ) 'km_damp_max '
+ WRITE ( 14 ) km_damp_max
+ WRITE ( 14 ) 'lad '
+ WRITE ( 14 ) lad
+ WRITE ( 14 ) 'lad_surface '
+ WRITE ( 14 ) lad_surface
+ WRITE ( 14 ) 'lad_vertical_gradient '
+ WRITE ( 14 ) lad_vertical_gradient
+ WRITE ( 14 ) 'lad_vertical_gradient_level '
+ WRITE ( 14 ) lad_vertical_gradient_level
+ WRITE ( 14 ) 'lad_vertical_gradient_level_in'
+ WRITE ( 14 ) lad_vertical_gradient_level_ind
+ WRITE ( 14 ) 'last_dt_change '
+ WRITE ( 14 ) last_dt_change
+ WRITE ( 14 ) 'long_filter_factor '
+ WRITE ( 14 ) long_filter_factor
+ WRITE ( 14 ) 'loop_optimization '
+ WRITE ( 14 ) loop_optimization
+ WRITE ( 14 ) 'mixing_length_1d '
+ WRITE ( 14 ) mixing_length_1d
+ WRITE ( 14 ) 'humidity '
+ WRITE ( 14 ) humidity
+ WRITE ( 14 ) 'momentum_advec '
+ WRITE ( 14 ) momentum_advec
+ WRITE ( 14 ) 'netcdf_precision '
+ WRITE ( 14 ) netcdf_precision
+ WRITE ( 14 ) 'npex '
+ WRITE ( 14 ) npex
+ WRITE ( 14 ) 'npey '
+ WRITE ( 14 ) npey
+ WRITE ( 14 ) 'nsor_ini '
+ WRITE ( 14 ) nsor_ini
+ WRITE ( 14 ) 'nx '
+ WRITE ( 14 ) nx
+ WRITE ( 14 ) 'ny '
+ WRITE ( 14 ) ny
+ WRITE ( 14 ) 'ocean '
+ WRITE ( 14 ) ocean
+ WRITE ( 14 ) 'old_dt '
+ WRITE ( 14 ) old_dt
+ WRITE ( 14 ) 'omega '
+ WRITE ( 14 ) omega
+ WRITE ( 14 ) 'outflow_damping_width '
+ WRITE ( 14 ) outflow_damping_width
+ WRITE ( 14 ) 'overshoot_limit_e '
+ WRITE ( 14 ) overshoot_limit_e
+ WRITE ( 14 ) 'overshoot_limit_pt '
+ WRITE ( 14 ) overshoot_limit_pt
+ WRITE ( 14 ) 'overshoot_limit_u '
+ WRITE ( 14 ) overshoot_limit_u
+ WRITE ( 14 ) 'overshoot_limit_v '
+ WRITE ( 14 ) overshoot_limit_v
+ WRITE ( 14 ) 'overshoot_limit_w '
+ WRITE ( 14 ) overshoot_limit_w
+ WRITE ( 14 ) 'passive_scalar '
+ WRITE ( 14 ) passive_scalar
+ WRITE ( 14 ) 'pch_index '
+ WRITE ( 14 ) pch_index
+ WRITE ( 14 ) 'phi '
+ WRITE ( 14 ) phi
+ WRITE ( 14 ) 'plant_canopy '
+ WRITE ( 14 ) plant_canopy
+ WRITE ( 14 ) 'prandtl_layer '
+ WRITE ( 14 ) prandtl_layer
+ WRITE ( 14 ) 'precipitation '
+ WRITE ( 14 ) precipitation
+ WRITE ( 14 ) 'pt_init '
+ WRITE ( 14 ) pt_init
+ WRITE ( 14 ) 'pt_reference '
+ WRITE ( 14 ) pt_reference
+ WRITE ( 14 ) 'pt_surface '
+ WRITE ( 14 ) pt_surface
+ WRITE ( 14 ) 'pt_surface_initial_change '
+ WRITE ( 14 ) pt_surface_initial_change
+ WRITE ( 14 ) 'pt_vertical_gradient '
+ WRITE ( 14 ) pt_vertical_gradient
+ WRITE ( 14 ) 'pt_vertical_gradient_level '
+ WRITE ( 14 ) pt_vertical_gradient_level
+ WRITE ( 14 ) 'pt_vertical_gradient_level_ind'
+ WRITE ( 14 ) pt_vertical_gradient_level_ind
+ WRITE ( 14 ) 'q_init '
+ WRITE ( 14 ) q_init
+ WRITE ( 14 ) 'q_surface '
+ WRITE ( 14 ) q_surface
+ WRITE ( 14 ) 'q_surface_initial_change '
+ WRITE ( 14 ) q_surface_initial_change
+ WRITE ( 14 ) 'q_vertical_gradient '
+ WRITE ( 14 ) q_vertical_gradient
+ WRITE ( 14 ) 'q_vertical_gradient_level '
+ WRITE ( 14 ) q_vertical_gradient_level
+ WRITE ( 14 ) 'q_vertical_gradient_level_ind '
+ WRITE ( 14 ) q_vertical_gradient_level_ind
+ WRITE ( 14 ) 'radiation '
+ WRITE ( 14 ) radiation
+ WRITE ( 14 ) 'random_generator '
+ WRITE ( 14 ) random_generator
+ WRITE ( 14 ) 'random_heatflux '
+ WRITE ( 14 ) random_heatflux
+ WRITE ( 14 ) 'rif_max '
+ WRITE ( 14 ) rif_max
+ WRITE ( 14 ) 'rif_min '
+ WRITE ( 14 ) rif_min
+ WRITE ( 14 ) 'roughness_length '
+ WRITE ( 14 ) roughness_length
+ WRITE ( 14 ) 'runnr '
+ WRITE ( 14 ) runnr
+ WRITE ( 14 ) 'sa_init '
+ WRITE ( 14 ) sa_init
+ WRITE ( 14 ) 'sa_surface '
+ WRITE ( 14 ) sa_surface
+ WRITE ( 14 ) 'sa_vertical_gradient '
+ WRITE ( 14 ) sa_vertical_gradient
+ WRITE ( 14 ) 'sa_vertical_gradient_level '
+ WRITE ( 14 ) sa_vertical_gradient_level
+ WRITE ( 14 ) 'scalar_advec '
+ WRITE ( 14 ) scalar_advec
+ WRITE ( 14 ) 'simulated_time '
+ WRITE ( 14 ) simulated_time
+ WRITE ( 14 ) 'surface_heatflux '
+ WRITE ( 14 ) surface_heatflux
+ WRITE ( 14 ) 'surface_pressure '
+ WRITE ( 14 ) surface_pressure
+ WRITE ( 14 ) 'surface_scalarflux '
+ WRITE ( 14 ) surface_scalarflux
+ WRITE ( 14 ) 'surface_waterflux '
+ WRITE ( 14 ) surface_waterflux
+ WRITE ( 14 ) 's_surface '
+ WRITE ( 14 ) s_surface
+ WRITE ( 14 ) 's_surface_initial_change '
+ WRITE ( 14 ) s_surface_initial_change
+ WRITE ( 14 ) 's_vertical_gradient '
+ WRITE ( 14 ) s_vertical_gradient
+ WRITE ( 14 ) 's_vertical_gradient_level '
+ WRITE ( 14 ) s_vertical_gradient_level
+ WRITE ( 14 ) 'time_coupling '
+ WRITE ( 14 ) time_coupling
+ WRITE ( 14 ) 'time_disturb '
+ WRITE ( 14 ) time_disturb
+ WRITE ( 14 ) 'time_dopr '
+ WRITE ( 14 ) time_dopr
+ WRITE ( 14 ) 'time_dopr_av '
+ WRITE ( 14 ) time_dopr_av
+ WRITE ( 14 ) 'time_dopr_listing '
+ WRITE ( 14 ) time_dopr_listing
+ WRITE ( 14 ) 'time_dopts '
+ WRITE ( 14 ) time_dopts
+ WRITE ( 14 ) 'time_dosp '
+ WRITE ( 14 ) time_dosp
+ WRITE ( 14 ) 'time_dots '
+ WRITE ( 14 ) time_dots
+ WRITE ( 14 ) 'time_do2d_xy '
+ WRITE ( 14 ) time_do2d_xy
+ WRITE ( 14 ) 'time_do2d_xz '
+ WRITE ( 14 ) time_do2d_xz
+ WRITE ( 14 ) 'time_do2d_yz '
+ WRITE ( 14 ) time_do2d_yz
+ WRITE ( 14 ) 'time_do3d '
+ WRITE ( 14 ) time_do3d
+ WRITE ( 14 ) 'time_do_av '
+ WRITE ( 14 ) time_do_av
+ WRITE ( 14 ) 'time_do_sla '
+ WRITE ( 14 ) time_do_sla
+ WRITE ( 14 ) 'time_dvrp '
+ WRITE ( 14 ) time_dvrp
+ WRITE ( 14 ) 'time_restart '
+ WRITE ( 14 ) time_restart
+ WRITE ( 14 ) 'time_run_control '
+ WRITE ( 14 ) time_run_control
+ WRITE ( 14 ) 'time_sort_particles '
+ WRITE ( 14 ) time_sort_particles
+ WRITE ( 14 ) 'timestep_scheme '
+ WRITE ( 14 ) timestep_scheme
+ WRITE ( 14 ) 'topography '
+ WRITE ( 14 ) topography
+ WRITE ( 14 ) 'top_heatflux '
+ WRITE ( 14 ) top_heatflux
+ WRITE ( 14 ) 'top_momentumflux_u '
+ WRITE ( 14 ) top_momentumflux_u
+ WRITE ( 14 ) 'top_momentumflux_v '
+ WRITE ( 14 ) top_momentumflux_v
+ WRITE ( 14 ) 'top_salinityflux '
+ WRITE ( 14 ) top_salinityflux
+ WRITE ( 14 ) 'tsc '
+ WRITE ( 14 ) tsc
+ WRITE ( 14 ) 'u_init '
+ WRITE ( 14 ) u_init
+ WRITE ( 14 ) 'u_max '
+ WRITE ( 14 ) u_max
+ WRITE ( 14 ) 'u_max_ijk '
+ WRITE ( 14 ) u_max_ijk
+ WRITE ( 14 ) 'ug '
+ WRITE ( 14 ) ug
+ WRITE ( 14 ) 'ug_surface '
+ WRITE ( 14 ) ug_surface
+ WRITE ( 14 ) 'ug_vertical_gradient '
+ WRITE ( 14 ) ug_vertical_gradient
+ WRITE ( 14 ) 'ug_vertical_gradient_level '
+ WRITE ( 14 ) ug_vertical_gradient_level
+ WRITE ( 14 ) 'ug_vertical_gradient_level_ind'
+ WRITE ( 14 ) ug_vertical_gradient_level_ind
+ WRITE ( 14 ) 'ups_limit_e '
+ WRITE ( 14 ) ups_limit_e
+ WRITE ( 14 ) 'ups_limit_pt '
+ WRITE ( 14 ) ups_limit_pt
+ WRITE ( 14 ) 'ups_limit_u '
+ WRITE ( 14 ) ups_limit_u
+ WRITE ( 14 ) 'ups_limit_v '
+ WRITE ( 14 ) ups_limit_v
+ WRITE ( 14 ) 'ups_limit_w '
+ WRITE ( 14 ) ups_limit_w
+ WRITE ( 14 ) 'use_surface_fluxes '
+ WRITE ( 14 ) use_surface_fluxes
+ WRITE ( 14 ) 'use_top_fluxes '
+ WRITE ( 14 ) use_top_fluxes
+ WRITE ( 14 ) 'use_ug_for_galilei_tr '
+ WRITE ( 14 ) use_ug_for_galilei_tr
+ WRITE ( 14 ) 'use_upstream_for_tke '
+ WRITE ( 14 ) use_upstream_for_tke
+ WRITE ( 14 ) 'v_init '
+ WRITE ( 14 ) v_init
+ WRITE ( 14 ) 'v_max '
+ WRITE ( 14 ) v_max
+ WRITE ( 14 ) 'v_max_ijk '
+ WRITE ( 14 ) v_max_ijk
+ WRITE ( 14 ) 'vg '
+ WRITE ( 14 ) vg
+ WRITE ( 14 ) 'vg_surface '
+ WRITE ( 14 ) vg_surface
+ WRITE ( 14 ) 'vg_vertical_gradient '
+ WRITE ( 14 ) vg_vertical_gradient
+ WRITE ( 14 ) 'vg_vertical_gradient_level '
+ WRITE ( 14 ) vg_vertical_gradient_level
+ WRITE ( 14 ) 'vg_vertical_gradient_level_ind'
+ WRITE ( 14 ) vg_vertical_gradient_level_ind
+ WRITE ( 14 ) 'wall_adjustment '
+ WRITE ( 14 ) wall_adjustment
+ WRITE ( 14 ) 'w_max '
+ WRITE ( 14 ) w_max
+ WRITE ( 14 ) 'w_max_ijk '
+ WRITE ( 14 ) w_max_ijk
+ WRITE ( 14 ) 'time-series-quantities '
+ WRITE ( 14 ) cross_ts_uymax, cross_ts_uymax_computed, cross_ts_uymin, &
+ cross_ts_uymin_computed
+
+!
+!-- Set the end-of-file mark
+ WRITE ( 14 ) '*** end *** '
+
+
+ END SUBROUTINE write_var_list
Index: /palm/tags/release-3.4a/UTIL/Makefile
===================================================================
--- /palm/tags/release-3.4a/UTIL/Makefile (revision 141)
+++ /palm/tags/release-3.4a/UTIL/Makefile (revision 141)
@@ -0,0 +1,46 @@
+#------------------------------------------------------------------------------!
+#
+# Actual revisions:
+# -----------------
+# Initial revision
+#
+#
+# Former revisions:
+# -----------------
+# $Id $
+#
+# Description:
+# ------------
+# Makefile for generating the utility programs needed by mrun and palm
+#------------------------------------------------------------------------------!
+
+PROG1 = ../SCRIPTS/combine_plot_fields.x
+PROG2 = ../SCRIPTS/interpret_config.x
+
+OBJS1 = combine_plot_fields.o
+OBJS2 = interpret_config.o
+
+CC = cc
+CFLAGS = -O
+
+F90 =
+F90_SER =
+COPT =
+F90FLAGS =
+LDFLAGS =
+
+.SUFFIXES: $(SUFFIXES) .f90
+
+
+all: $(PROG1) $(PROG2)
+
+$(PROG1): $(OBJS1)
+ $(F90_SER) -o $(PROG1) $(OBJS1) $(LDFLAGS)
+
+$(PROG2): $(OBJS2)
+ $(F90_SER) -o $(PROG2) $(OBJS2) $(LDFLAGS)
+
+.f90.o:
+ $(F90_SER) $(F90FLAGS) $(COPT) -c $<
+
+
Index: /palm/tags/release-3.4a/UTIL/analyze_particle_data.f90
===================================================================
--- /palm/tags/release-3.4a/UTIL/analyze_particle_data.f90 (revision 141)
+++ /palm/tags/release-3.4a/UTIL/analyze_particle_data.f90 (revision 141)
@@ -0,0 +1,251 @@
+ PROGRAM analyze_particle_data
+
+!-------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+!
+!
+! Description:
+! ------------
+! This routine reads the particle data files generated by PALM
+! and does some statistical analysis on these data.
+!-------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+!
+!-- Variable definitions
+ CHARACTER (LEN=5) :: id_char
+ CHARACTER (LEN=80) :: run_description_header
+
+ INTEGER, PARAMETER :: spk = SELECTED_REAL_KIND( 6 )
+
+ INTEGER :: class, danz = 0, i, id, maximum_number_of_particles, n, &
+ number_of_intervalls, number_of_particles, &
+ number_of_vertical_levels, timelevel = 1, vertical_level, &
+ total_number_of_particles
+
+ INTEGER, DIMENSION(:), ALLOCATABLE :: class_table
+
+ LOGICAL :: found
+
+ REAL :: class_width, hdistance, km, km_x, km_y, particle_age, sigma, &
+ sigma_local, sigma_local_x, sigma_local_y, sigma_x, sigma_y, &
+ simulated_time, vertical_resolution
+ REAL, DIMENSION(:,:), ALLOCATABLE :: diffusivities
+
+ TYPE particle_type
+ SEQUENCE
+ INTEGER :: color, tailpoints
+ REAL :: age, origin_x, origin_y, origin_z, size, speed_x, speed_y, &
+ speed_z, x, y, z
+ END TYPE particle_type
+
+ TYPE(particle_type), DIMENSION(:), ALLOCATABLE :: particles
+
+
+!
+!-- Check, if file from PE0 exists and terminate program if it doesn't.
+ WRITE (id_char,'(''_'',I4.4)') danz
+ INQUIRE ( FILE=id_char, EXIST=found )
+!
+!-- Find out the number of files (equal to the number of PEs which
+!-- have been used in PALM) and open them
+ DO WHILE ( found )
+
+ OPEN ( danz+110, FILE=id_char, FORM='UNFORMATTED' )
+ danz = danz + 1
+ WRITE (id_char,'(''_'',I4.4)') danz
+ INQUIRE ( FILE=id_char, EXIST=found )
+
+ ENDDO
+!
+!-- Info-output
+ PRINT*, ''
+ PRINT*, '*** analyze_particle_data ***'
+ IF ( danz /= 0 ) THEN
+ PRINT*, '*** ', danz, ' file(s) found'
+ ELSE
+ PRINT*, '+++ file _0000 not found'
+ PRINT*, ' program terminated'
+ STOP
+ ENDIF
+
+!
+!-- Loop over all timelevels of output
+ DO
+ total_number_of_particles = 0
+ sigma = 0.0
+ sigma_x = 0.0
+ sigma_y = 0.0
+!
+!-- Loop over all files (reading data of the subdomains)
+ DO id = 0, danz-1
+!
+!-- Read file header
+ IF ( timelevel == 1 ) THEN
+ READ ( id+110 ) run_description_header
+!
+!-- Print header information
+ IF ( id == 0 ) THEN
+ PRINT*, '*** run: ', run_description_header
+ PRINT*, ' '
+ PRINT*, '--> enter class width in m:'
+ READ*, class_width
+ PRINT*, '--> enter number of class intervalls:'
+ READ*, number_of_intervalls
+ PRINT*, '--> enter vertical resolution in m:'
+ READ*, vertical_resolution
+ PRINT*, '--> enter number of vertical levels:'
+ READ*, number_of_vertical_levels
+!
+!-- Allocate table space
+ ALLOCATE( class_table( 0:number_of_intervalls ) )
+ class_table = 0
+ ALLOCATE( diffusivities(0:number_of_vertical_levels,5) )
+ diffusivities = 0.0
+ ENDIF
+ ENDIF
+!
+!-- Read time information and indices
+ READ ( id+110, END=10 ) simulated_time, maximum_number_of_particles,&
+ number_of_particles
+!
+!-- Print timelevel and number of particles
+ IF ( id == 0 ) THEN
+ PRINT*, ' '
+ PRINT*, '*** time: ', simulated_time
+ ENDIF
+ PRINT*, 'PE', id, ': ', number_of_particles, ' particles'
+!
+!-- Allocate array and read particle data
+ ALLOCATE( particles(maximum_number_of_particles) )
+ READ ( id+110 ) particles
+!
+!-- Analyze the particle data
+ DO n = 1, number_of_particles
+!
+!-- Calculate horizontal distance from of particle from its origin
+ hdistance = SQRT( ( particles(n)%x - particles(n)%origin_x )**2 + &
+ ( particles(n)%y - particles(n)%origin_y )**2 )
+ class = hdistance / class_width
+ sigma_local = hdistance**2
+ sigma_local_x = ( particles(n)%x - particles(n)%origin_x )**2
+ sigma_local_y = ( particles(n)%y - particles(n)%origin_y )**2
+
+ vertical_level = particles(n)%origin_z / vertical_resolution
+ IF ( vertical_level > number_of_vertical_levels ) THEN
+ vertical_level = number_of_vertical_levels
+ ENDIF
+
+ IF ( class > number_of_intervalls ) THEN
+ class = number_of_intervalls
+! PRINT*, 'x =',particles(n)%x,' y =',particles(n)%y
+! PRINT*, 'xo=',particles(n)%origin_x,' yo=',particles(n)%origin_y
+ ENDIF
+
+ class_table(class) = class_table(class) + 1
+
+ diffusivities(vertical_level,1) = diffusivities(vertical_level,1) +&
+ sigma_local
+ diffusivities(vertical_level,2) = diffusivities(vertical_level,2) +&
+ sigma_local_x
+ diffusivities(vertical_level,3) = diffusivities(vertical_level,3) +&
+ sigma_local_y
+ diffusivities(vertical_level,4) = diffusivities(vertical_level,4) +&
+ 1.0
+
+ vertical_level = particles(n)%z / vertical_resolution
+ IF ( vertical_level > number_of_vertical_levels ) THEN
+ vertical_level = number_of_vertical_levels
+ ENDIF
+ diffusivities(vertical_level,5) = diffusivities(vertical_level,5) +&
+ 1.0
+
+!
+!-- Summation for variances
+ sigma = sigma + sigma_local
+ sigma_x = sigma_x + sigma_local_x
+ sigma_y = sigma_y + sigma_local_y
+ total_number_of_particles = total_number_of_particles + 1
+
+ ENDDO
+!
+!-- Store the particle age (it is provided that all particles have the
+!-- same age)
+ particle_age = particles(1)%age
+
+!
+!-- Deallocate particle array before data from next file are read
+ DEALLOCATE( particles )
+
+ ENDDO ! next file
+!
+!-- Print statistics
+ PRINT*, ' '
+ PRINT*, '*** statistics for t = ', simulated_time
+ DO n = 0, number_of_intervalls-1
+ WRITE ( *, 1 ) n*class_width, (n+1)*class_width, class_table(n)
+ 1 FORMAT (F6.1,' - ',F6.1, ' m n = ',I7)
+ ENDDO
+ WRITE ( *, 2 ) (number_of_intervalls+1)*class_width, &
+ class_table(number_of_intervalls)
+ 2 FORMAT (6X,' > ',F6.1,' m n = ',I7)
+
+ sigma = SQRT( sigma / REAL( total_number_of_particles ) )
+ km = sigma**2 / ( 2.0 * particle_age )
+ sigma_x = SQRT( sigma_x / REAL( total_number_of_particles ) )
+ km_x = sigma_x**2 / ( 2.0 * particle_age )
+ sigma_y = SQRT( sigma_y / REAL( total_number_of_particles ) )
+ km_y = sigma_y**2 / ( 2.0 * particle_age )
+ PRINT*, ' '
+ WRITE ( *, 3 ) sigma, km, sigma_x, km_x, sigma_y, km_y
+ 3 FORMAT ('sigma = ',F6.1,' m Km = ',F5.1,' m**2/s'/ &
+ 'sigma_x = ',F6.1,' m Km_x = ',F5.1,' m**2/s'/ &
+ 'sigma_y = ',F6.1,' m Km_y = ',F5.1,' m**2/s')
+
+ PRINT*, ' '
+ PRINT*, 'Height dependence of diffusivities:'
+ DO i = 0, number_of_vertical_levels-1
+ IF ( diffusivities(i,4) == 0.0 ) diffusivities(i,4) = 1.0E-20
+ WRITE ( *, 4 ) i*vertical_resolution, (i+1.0)*vertical_resolution,&
+ ( diffusivities(i,1) / diffusivities(i,4) ) / &
+ ( 2.0 * particle_age ), &
+ ( diffusivities(i,2) / diffusivities(i,4) ) / &
+ ( 2.0 * particle_age ), &
+ ( diffusivities(i,3) / diffusivities(i,4) ) / &
+ ( 2.0 * particle_age ), &
+ diffusivities(i,4), diffusivities(i,5)
+ 4 FORMAT (F6.1,'-',F6.1,' m Km=',F5.1,' Km_x=',F5.1, &
+ ' Km_y=',F5.1,' n_o=',F7.0,' n=',F7.0)
+ ENDDO
+ IF ( diffusivities(number_of_vertical_levels,4) == 0.0 ) THEN
+ diffusivities(number_of_vertical_levels,4) = 1.0E-20
+ ENDIF
+ i = number_of_vertical_levels
+ WRITE ( *, 5 ) i*vertical_resolution, &
+ ( diffusivities(i,1) / diffusivities(i,4) ) / &
+ ( 2.0 * particle_age ), &
+ ( diffusivities(i,2) / diffusivities(i,4) ) / &
+ ( 2.0 * particle_age ), &
+ ( diffusivities(i,3) / diffusivities(i,4) ) / &
+ ( 2.0 * particle_age ), &
+ diffusivities(i,4), diffusivities(i,5)
+ 5 FORMAT (F6.1,'-...... m Km=',F5.1,' Km_x=',F5.1, &
+ ' Km_y=',F5.1,' n_o=',F7.0,' n=',F7.0)
+
+!
+!-- Initialize class table for next timelevel
+ class_table = 0
+ diffusivities = 0.0
+ timelevel = timelevel + 1
+
+ ENDDO ! next timelevel
+
+10 PRINT*, '*** EOF reached on file PARTICLE_DATA/_0000'
+
+ END PROGRAM analyze_particle_data
Index: /palm/tags/release-3.4a/UTIL/analyze_particle_netcdf_data.f90
===================================================================
--- /palm/tags/release-3.4a/UTIL/analyze_particle_netcdf_data.f90 (revision 141)
+++ /palm/tags/release-3.4a/UTIL/analyze_particle_netcdf_data.f90 (revision 141)
@@ -0,0 +1,254 @@
+ PROGRAM analyze_particle_netcdf_data
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! Initial revision 12/07/05
+!
+!
+! Description:
+! ------------
+! This is an EXAMPLE routine how to read NetCDF particle data output by PALM.
+! As an example, the mean heigth and radius of all particles are calculated
+! and output for each output time available on the file
+!
+!
+! Any additonal analyzation requested has to be added by the user by following
+! the steps given in this example!
+!
+!
+!
+! This routine must be compiled with:
+! decalpha:
+! f95 -fast -r8 -I/usr/local/netcdf-3.5.1/include
+! -L/usr/local/netcdf-3.5.1/lib -lnetcdf
+! IBM-Regatta:
+! xlf95 -qsuffix=cpp=f90 -qrealsize=8 -q64 -qmaxmem=-1 -Q
+! -I /aws/dataformats/netcdf-3.5.0/netcdf-64-32-3.5.0/include_F90_64
+! -L/aws/dataformats/netcdf-3.5.0/netcdf-64-32-3.5.0/lib -lnetcdf -O3
+! IBM-Regatta KISTI:
+! xlf95 -qsuffix=cpp=f90 -qrealsize=8 -q64 -qmaxmem=-1 -Q
+! -I /applic/netcdf64/src/f90
+! -L/applic/lib/NETCDF64 -lnetcdf -O3
+! IMUK:
+! ifort analyze_particle_netcdf_data
+! -I /muksoft/packages/netcdf/linux/include -axW -r8 -nbs -Vaxlib
+! -L /muksoft/packages/netcdf/linux/lib -lnetcdf
+! NEC-SX6:
+! sxf90 analyze_particle_netcdf_data.f90
+! -I /pool/SX-6/netcdf/netcdf-3.6.0-p1/include -C hopt -Wf '-A idbl4'
+! -D__netcdf -L/pool/SX-6/netcdf/netcdf-3.6.0-p1/lib -lnetcdf
+!------------------------------------------------------------------------------!
+
+ USE netcdf
+
+ IMPLICIT NONE
+
+!
+!-- Local variables
+ CHARACTER (LEN=7) :: id_char
+ CHARACTER (LEN=2000) :: string
+
+
+ INTEGER :: f, fn, i, id_dim_time, id_var_rnop, id_var_r, id_var_time, &
+ id_var_x, id_var_y, id_var_z, n, nc_stat, ntl, start
+
+ INTEGER, DIMENSION(1000) :: id_set
+ INTEGER, DIMENSION(1) :: id_dim_time_old
+
+ INTEGER, DIMENSION(:), ALLOCATABLE :: total_nop
+ INTEGER, DIMENSION(:,:), ALLOCATABLE :: nop
+
+ LOGICAL :: found
+
+ REAL :: mean_r, mean_z
+ REAL, DIMENSION(:), ALLOCATABLE :: prt_r, prt_x, prt_y, prt_z, tl
+
+!
+!-- Check, if file from PE0 exists. If it does not exist, PALM did not
+!-- create any output for this cross-section.
+ fn = 0
+ WRITE (id_char,'(''_'',I4.4)') fn
+ INQUIRE ( FILE=id_char, EXIST=found )
+
+!
+!-- Find out the number of files (equal to the number of PEs which
+!-- have been used in PALM) and open them
+ IF ( .NOT. found ) THEN
+ PRINT*, '+++ no file _0000 found in current working directory'
+ STOP
+ ENDIF
+
+ DO WHILE ( found )
+
+!
+!-- Open NetCDF dataset
+ nc_stat = NF90_OPEN( id_char, NF90_NOWRITE, id_set(fn) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 1 )
+ fn = fn + 1
+ WRITE (id_char,'(''_'',I4.4)') fn
+ INQUIRE ( FILE=id_char, EXIST=found )
+
+ ENDDO
+ fn = fn - 1
+
+ PRINT*, '*** ', fn+1, ' files found'
+
+!
+!-- Get the run description header and print it out
+ string = ' '
+ nc_stat = NF90_GET_ATT( id_set(0), NF90_GLOBAL, 'title', string )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 2 )
+ PRINT*, '*** run: ', TRIM( string )
+
+!
+!-- Get the available time levels
+ nc_stat = NF90_INQ_VARID( id_set(0), 'time', id_var_time )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 3 )
+
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set(0), id_var_time, &
+ dimids = id_dim_time_old )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 4 )
+ id_dim_time = id_dim_time_old(1)
+
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set(0), id_dim_time, len = ntl )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 5 )
+ ALLOCATE( tl(1:ntl) )
+ print*, 'ntl=',ntl
+
+ nc_stat = NF90_GET_VAR( id_set(0), id_var_time, tl )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 6 )
+
+ DO n = 1, ntl
+ print*, '*** time_level(', n, ') =', tl(n)
+ ENDDO
+
+!
+!-- Get the number of particles used
+ nc_stat = NF90_INQ_VARID( id_set(0), 'real_num_of_prt', id_var_rnop )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 7 )
+
+ ALLOCATE( nop(1:ntl,0:fn), total_nop(1:ntl) )
+
+ DO f = 0, fn
+
+ nc_stat = NF90_GET_VAR( id_set(f), id_var_rnop, nop(1:ntl,f) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 8 )
+
+ ENDDO
+
+ total_nop = 0
+ DO n = 1, ntl
+
+ DO f = 0, fn
+ total_nop(n) = total_nop(n) + nop(n,f)
+ ENDDO
+
+ PRINT*, '*** time = ', tl(n), ' total # of particles: ', total_nop(n)
+
+ ENDDO
+
+!
+!-- Get the particle x and y coordinates
+ nc_stat = NF90_INQ_VARID( id_set(0), 'pt_x', id_var_x )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 9 )
+
+ nc_stat = NF90_INQ_VARID( id_set(0), 'pt_y', id_var_y )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 10 )
+
+ nc_stat = NF90_INQ_VARID( id_set(0), 'pt_z', id_var_z )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 11 )
+
+ nc_stat = NF90_INQ_VARID( id_set(0), 'pt_radius', id_var_r )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 12 )
+
+ PRINT*, ' '
+!
+!-- Loop over all timelevels
+ DO n = 1, ntl
+
+ ALLOCATE( prt_x(total_nop(n)), prt_y(total_nop(n)), &
+ prt_z(total_nop(n)), prt_r(total_nop(n)) )
+
+ start = 1
+
+!
+!-- Read the data from the files (one file per processor)
+ DO f = 0, fn
+
+ nc_stat = NF90_GET_VAR( id_set(f), id_var_x, &
+ prt_x(start:start+nop(n,f)-1), &
+ start = (/ 1, n /), &
+ count = (/ nop(n,f), 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 13 )
+
+ nc_stat = NF90_GET_VAR( id_set(f), id_var_y, &
+ prt_y(start:start+nop(n,f)-1), &
+ start = (/ 1, n /), &
+ count = (/ nop(n,f), 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 14 )
+
+ nc_stat = NF90_GET_VAR( id_set(f), id_var_z, &
+ prt_z(start:start+nop(n,f)-1), &
+ start = (/ 1, n /), &
+ count = (/ nop(n,f), 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 15 )
+
+ nc_stat = NF90_GET_VAR( id_set(f), id_var_r, &
+ prt_r(start:start+nop(n,f)-1), &
+ start = (/ 1, n /), &
+ count = (/ nop(n,f), 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( nc_stat, 16 )
+
+ start = start + nop(n,f)
+
+ ENDDO
+
+ mean_z = 0.0
+ mean_r = 0.0
+ DO i = 1, total_nop(n)
+ mean_z = mean_z + prt_z(i)
+ mean_r = mean_r + prt_r(i)
+ ENDDO
+ mean_z = mean_z / total_nop(n)
+ mean_r = mean_r / total_nop(n)
+
+ PRINT*, '*** time = ', tl(n), ' mean height = ', mean_z, &
+ ' mean radius = ', mean_r
+
+!
+!-- prt_x, prt_y, prt_z, and prt_r contain the particle coordinates and
+!-- radii, respectively. Please output these data or carry out the
+!-- requested analyzing in this program before you deallocate the arrays.
+
+ DEALLOCATE( prt_x, prt_y, prt_z, prt_r )
+
+ ENDDO
+
+
+ END PROGRAM analyze_particle_netcdf_data
+
+
+
+ SUBROUTINE handle_netcdf_error( nc_stat, position )
+!
+!-- Prints out a text message corresponding to the current NetCDF status
+
+ USE netcdf
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: nc_stat, position
+
+ IF ( nc_stat /= NF90_NOERR ) THEN
+ PRINT*, '+++ analyze_particle_netcdf_data'
+ PRINT*, ' netcdf error: ', TRIM( nf90_strerror( nc_stat ) )
+ PRINT*, ' position = ', position
+ STOP
+ ENDIF
+
+ END SUBROUTINE handle_netcdf_error
Index: /palm/tags/release-3.4a/UTIL/check_pegrid.f90
===================================================================
--- /palm/tags/release-3.4a/UTIL/check_pegrid.f90 (revision 141)
+++ /palm/tags/release-3.4a/UTIL/check_pegrid.f90 (revision 141)
@@ -0,0 +1,145 @@
+ PROGRAM check_pegrid
+
+!-------------------------------------------------------------------------------!
+! Beschreibung:
+! -------------
+! Ueberpruefung der Konsistenz von Prozessortopologie und gewaehlten Feldgrenzen
+!-------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=1) :: char = ''
+ INTEGER :: i, j, k, maximum_grid_level, mg_levels_x, mg_levels_y, &
+ mg_levels_z, numprocs, numproc_sqr, nx, nxanz, ny, nyanz, nz, &
+ pdims(2)
+
+!
+!-- Prozessoranzahl abfragen
+ PRINT*, '*** Anzahl der verfuegbaren PE''s:'
+ READ (*,*) numprocs
+
+!
+!-- Prozessortopologie bestimmen
+ numproc_sqr = SQRT( REAL( numprocs ) )
+ pdims(1) = MAX( numproc_sqr , 1 )
+ DO WHILE ( MOD( numprocs , pdims(1) ) /= 0 )
+ pdims(1) = pdims(1) - 1
+ ENDDO
+ pdims(2) = numprocs / pdims(1)
+
+!
+!-- Prozessortopologie ausgeben
+ PRINT*, ' '
+ PRINT*, '*** berechnetes Prozessorgitter: (',pdims(1),',',pdims(2),')'
+
+!
+!-- Evtl. Uebersteuerung der Prozessortopologie durch den Benutzer
+ PRINT*, ' '
+ PRINT*, '*** soll dieses Prozessorgitter benutzt werden? (y/n/=y)'
+ READ (*,'(A1)') char
+ IF ( char /= 'y' .AND. char /= 'Y' .AND. char /= '' ) THEN
+ DO
+ PRINT*, ' '
+ PRINT*, '*** Bitte Prozessoranzahl in x- und y-Richtung angeben:'
+ READ (*,*) pdims(1), pdims(2)
+ IF ( pdims(1)*pdims(2) == numprocs ) EXIT
+ PRINT*, '+++ berechnete Prozessoranzahl (', pdims(1)*pdims(2), &
+ ') stimmt nicht mit vorgegebener Anzahl'
+ PRINT*, ' (', numprocs, ') ueberein!'
+ ENDDO
+ ENDIF
+
+!
+!-- Gitterpunktanzahl abfragen
+ PRINT*, ' '
+ PRINT*, ' '
+ PRINT*, '*** bitte nx, ny und nz angeben:'
+ READ (*,*) nx, ny, nz
+
+!
+!-- Pruefung, ob sich Gitterpunkte in x-Richtung glatt aufteilen lassen
+ IF ( MOD( nx+1 , pdims(1) ) /= 0 ) THEN
+ PRINT*,'+++ x-Richtung: Gitterpunktanzahl (',nx+1,') ist kein ganz-'
+ PRINT*,' zahliges Vielfaches der Prozessoranzahl (',&
+ &pdims(1),')'
+ STOP
+ ELSE
+ nxanz = ( nx + 1 ) / pdims(1)
+ ENDIF
+
+!
+!-- Pruefung, ob sich Gitterpunkte in y-Richtung glatt aufteilen lassen
+ IF ( MOD( ny+1 , pdims(2) ) /= 0 ) THEN
+ PRINT*,'+++ y-Richtung: Gitterpunktanzahl (',ny+1,') ist kein ganz-'
+ PRINT*,' zahliges Vielfaches der Prozessoranzahl (',&
+ &pdims(2),')'
+ STOP
+ ELSE
+ nyanz = ( ny + 1 ) / pdims(2)
+ ENDIF
+
+ PRINT*, ''
+ PRINT*, '*** Anzahl der Gitterpunkte in x- und y-Richtung je PE: (', &
+ nxanz,',',nyanz,')'
+
+!
+!-- Pruefen der Gitterpunktanzahl bzgl. Transposition
+ IF ( MOD( nz , pdims(1) ) /= 0 ) THEN
+ PRINT*,'+++ Transposition z --> x:'
+ PRINT*,' nz=',nz,' ist kein ganzzahliges Vielfaches von pdims(1)=', &
+ &pdims(1)
+ PRINT*, ''
+ STOP
+ ENDIF
+ IF ( MOD( nx+1 , pdims(2) ) /= 0 ) THEN
+ PRINT*,'+++ Transposition x --> y:'
+ PRINT*,' nx+1=',nx+1,' ist kein ganzzahliges Vielfaches von ',&
+ &'pdims(2)=',pdims(2)
+ PRINT*, ''
+ STOP
+ ENDIF
+ IF ( MOD( ny+1 , pdims(1) ) /= 0 ) THEN
+ PRINT*,'+++ Transposition y --> z:'
+ PRINT*,' ny+1=',ny+1,' ist kein ganzzahliges Vielfaches von ',&
+ &'pdims(1)=',pdims(1)
+ PRINT*, ''
+ STOP
+ ENDIF
+
+!
+!-- Moegliche Anzahl von Gitterniveaus im Falle der Benutzung des
+!-- Mehrgitterverfahrens berechnen und die Gitterpunktanzahl des groebsten
+!-- Gitters ausgeben
+ mg_levels_x = 1
+ mg_levels_y = 1
+ mg_levels_z = 1
+
+ i = nxanz
+ DO WHILE ( MOD( i, 2 ) == 0 .AND. i /= 2 )
+ i = i / 2
+ mg_levels_x = mg_levels_x + 1
+ ENDDO
+
+ j = nyanz
+ DO WHILE ( MOD( j, 2 ) == 0 .AND. j /= 2 )
+ j = j / 2
+ mg_levels_y = mg_levels_y + 1
+ ENDDO
+
+ k = nz
+ DO WHILE ( MOD( k, 2 ) == 0 .AND. k /= 2 )
+ k = k / 2
+ mg_levels_z = mg_levels_z + 1
+ ENDDO
+
+ maximum_grid_level = MIN( mg_levels_x, mg_levels_y, mg_levels_z )
+ i = nxanz / 2**(maximum_grid_level-1)
+ j = nyanz / 2**(maximum_grid_level-1)
+ k = nz / 2**(maximum_grid_level-1)
+
+ PRINT*, ' Anzahl der moeglichen Gitterniveaus: ', maximum_grid_level
+ PRINT*, ' Anz. Gitterpunkte auf groebstem Gitter (x,y,z): (', i, ',', &
+ j,',',k,')'
+ PRINT*, ''
+
+ END PROGRAM check_pegrid
Index: /palm/tags/release-3.4a/UTIL/combine_plot_fields.f90
===================================================================
--- /palm/tags/release-3.4a/UTIL/combine_plot_fields.f90 (revision 141)
+++ /palm/tags/release-3.4a/UTIL/combine_plot_fields.f90 (revision 141)
@@ -0,0 +1,749 @@
+ PROGRAM combine_plot_fields
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 114 2007-10-10 00:03:15Z raasch
+! Bugfix: model_string needed a default value
+!
+! Aug 07 Loop for processing of output by coupled runs, id_string does not
+! contain modus any longer
+!
+! 18/01/06 Output of time-averaged data
+!
+! 25/05/05 Errors removed
+!
+! 26/04/05 Output in NetCDF format, iso2d and avs output only if parameter
+! file exists
+!
+! 31/10/01 All comments and messages translated into English
+!
+! 23/02/99 Keine Bearbeitung komprimierter 3D-Daten
+! Ursprungsversion vom 28/07/97
+!
+!
+! Description:
+! ------------
+! This routine combines data of the PALM-subdomains into one file. In PALM
+! every processor element opens its own file and writes 2D- or 3D-binary-data
+! into it (different files are opened for xy-, xz-, yz-cross-sections and
+! 3D-data). For plotting or analyzing these PE-data have to be collected and
+! to be put into single files, which is done by this routine.
+! Output format is NetCDF. Additionally, a data are output in a binary format
+! readable by ISO2D-software (cross-sections) and by AVS (3D-data).
+!
+! This routine must be compiled with:
+! decalpha:
+! f95 -cpp -D__netcdf -fast -r8 -I/usr/local/netcdf-3.5.1/include
+! -L/usr/local/netcdf-3.5.1/lib -lnetcdf
+! IBM-Regatta:
+! xlf95 -qsuffix=cpp=f90 -WF,-D__netcdf -qrealsize=8 -q64 -qmaxmem=-1 -Q
+! -I /aws/dataformats/netcdf-3.6.0-p1/64-32/include-64
+! -L/aws/dataformats/netcdf-3.6.0-p1/64-32/lib -lnetcdf -O3
+! IBM-Regatta KISTI:
+! xlf95 -qsuffix=cpp=f90 -WF,-D__netcdf -qrealsize=8 -q64 -qmaxmem=-1 -Q
+! -I /applic/netcdf64/src/f90
+! -L/applic/lib/NETCDF64 -lnetcdf -O3
+! IBM-Regatta Yonsei (gfdl5):
+! xlf95 -qsuffix=cpp=f90 -WF,-D__netcdf -qrealsize=8 -q64 -qmaxmem=-1 -Q
+! -I /usr1/users/raasch/pub/netcdf-3.6.0-p1/include
+! -L/usr1/users/raasch/pub/netcdf-3.6.0-p1/lib -lnetcdf -O3
+! IMUK:
+! ifort combine...f90 -o combine...x
+! -cpp -D__netcdf -I /muksoft/packages/netcdf/linux/include -axW -r8 -nbs
+! -Vaxlib -L /muksoft/packages/netcdf/linux/lib -lnetcdf
+! NEC-SX6:
+! sxf90 combine...f90 -o combine...x
+! -I /pool/SX-6/netcdf/netcdf-3.6.0-p1/include -C hopt -Wf '-A idbl4'
+! -D__netcdf -L/pool/SX-6/netcdf/netcdf-3.6.0-p1/lib -lnetcdf
+! Sun Fire X4600
+! pgf95 combine...f90 -o combine...x
+! -Mpreprocess -D__netcdf -I /home/usr5/mkanda/netcdf-3.6.1/src/f90 -r8
+! -fast -L/home/usr5/mkanda/netcdf-3.6.1/src/libsrc -lnetcdf
+! FIMM:
+! ifort combine...f90 -o combine...x
+! -axW -cpp -openmp -r8 -nbs -convert little_endian -D__netcdf
+! -I /local/netcdf/include -Vaxlib -L/local/netcdf/lib -lnetcdf
+!------------------------------------------------------------------------------!
+
+#if defined( __netcdf )
+ USE netcdf
+#endif
+
+ IMPLICIT NONE
+
+!
+!-- Local variables
+ CHARACTER (LEN=2) :: modus, model_string
+ CHARACTER (LEN=4) :: id_string
+ CHARACTER (LEN=10) :: dimname, var_name
+ CHARACTER (LEN=40) :: filename
+
+ CHARACTER (LEN=2000), DIMENSION(0:1) :: var_list
+
+ INTEGER, PARAMETER :: spk = SELECTED_REAL_KIND( 6 )
+
+ INTEGER :: av, danz, i, id, &
+ j, model, models, nc_stat, nxa, nxag, nxe, nxeg, nya, &
+ nyag, nye, nyeg, nza, nzag, nze, nzeg, pos, time_step, xa, xe, &
+ ya, ye, za, ze
+
+ INTEGER, DIMENSION(0:1) :: current_level, current_var, fanz, id_set, &
+ id_var_time, num_var
+
+ INTEGER, DIMENSION(4) :: id_dims_loc
+
+ INTEGER, DIMENSION(0:1,4) :: id_dims
+
+ INTEGER, DIMENSION(0:1,1000) :: id_var, levels
+
+ LOGICAL :: avs_output, compressed, found, iso2d_output, netcdf_output, &
+ netcdf_0, netcdf_1
+
+ REAL :: dx, simulated_time
+ REAL, DIMENSION(:), ALLOCATABLE :: eta, ho, hu
+ REAL, DIMENSION(:,:), ALLOCATABLE :: pf
+ REAL(spk), DIMENSION(:,:,:), ALLOCATABLE :: pf3d
+
+ PRINT*, ''
+ PRINT*, ''
+ PRINT*, '*** combine_plot_fields ***'
+
+!
+!-- Find out if a coupled run has been carried out
+ INQUIRE( FILE='COUPLING_PORT_OPENED', EXIST=found )
+ IF ( found ) THEN
+ models = 2
+ PRINT*, ' coupled run'
+ ELSE
+ models = 1
+ PRINT*, ' uncoupled run'
+ ENDIF
+
+!
+!-- Do everything for each model
+ DO model = 1, models
+!
+!-- Set the model string used to identify the filenames
+ model_string = ''
+ IF ( models == 2 ) THEN
+ PRINT*, ''
+ PRINT*, '*** combine_plot_fields ***'
+ IF ( model == 2 ) THEN
+ model_string = '_O'
+ PRINT*, ' now combining ocean data'
+ PRINT*, ' ========================'
+ ELSE
+ PRINT*, ' now combining atmosphere data'
+ PRINT*, ' ============================='
+ ENDIF
+ ENDIF
+!
+!-- 2D-arrays for ISO2D
+!-- Main loop for the three different cross-sections, starting with
+!-- xy-section
+ modus = 'XY'
+ PRINT*, ''
+ DO WHILE ( modus == 'XY' .OR. modus == 'XZ' .OR. modus == 'YZ' )
+!
+!-- Check, if file from PE0 exists. If it does not exist, PALM did not
+!-- create any output for this cross-section.
+ danz = 0
+ WRITE (id_string,'(I4.4)') danz
+ INQUIRE ( &
+ FILE='PLOT2D_'//modus//TRIM( model_string )//'_'//id_string, &
+ EXIST=found )
+!
+!-- Find out the number of files (equal to the number of PEs which
+!-- have been used in PALM) and open them
+ DO WHILE ( found )
+
+ OPEN ( danz+110, &
+ FILE='PLOT2D_'//modus//TRIM( model_string )//'_'//id_string, &
+ FORM='UNFORMATTED' )
+ danz = danz + 1
+ WRITE (id_string,'(I4.4)') danz
+ INQUIRE ( &
+ FILE='PLOT2D_'//modus//TRIM( model_string )//'_'//id_string, &
+ EXIST=found )
+
+ ENDDO
+
+!
+!-- Inquire whether an iso2d parameter file exists
+ INQUIRE( FILE='PLOT2D_'//modus//'_GLOBAL'//TRIM( model_string ), &
+ EXIST=iso2d_output )
+
+!
+!-- Inquire whether a NetCDF file exists
+ INQUIRE( FILE='DATA_2D_'//modus//'_NETCDF'//TRIM( model_string ), &
+ EXIST=netcdf_0 )
+
+!
+!-- Inquire whether a NetCDF file for time-averaged data exists
+ INQUIRE( FILE='DATA_2D_'//modus//'_AV_NETCDF'//TRIM( model_string ),&
+ EXIST=netcdf_1 )
+
+ IF ( netcdf_0 .OR. netcdf_1 ) THEN
+ netcdf_output = .TRUE.
+ ELSE
+ netcdf_output = .FALSE.
+ ENDIF
+
+!
+!-- Info-output
+ PRINT*, ''
+ PRINT*, '*** combine_plot_fields ***'
+#if defined( __netcdf )
+ IF ( netcdf_output ) PRINT*, ' NetCDF output enabled'
+#else
+ IF ( netcdf_output ) THEN
+ PRINT*, '--- Sorry, no NetCDF support on this host'
+ netcdf_output = .FALSE.
+ ENDIF
+#endif
+ IF ( danz /= 0 ) THEN
+ PRINT*, ' ',modus,'-section: ', danz, ' file(s) found'
+ ELSE
+ PRINT*, ' no ', modus, '-section data available'
+ ENDIF
+
+ IF ( netcdf_output .AND. danz /= 0 ) THEN
+#if defined( __netcdf )
+ DO av = 0, 1
+
+ IF ( av == 0 .AND. .NOT. netcdf_0 ) CYCLE
+ IF ( av == 1 .AND. .NOT. netcdf_1 ) CYCLE
+
+!
+!-- Open NetCDF dataset
+ IF ( av == 0 ) THEN
+ filename = 'DATA_2D_'//modus//'_NETCDF' &
+ //TRIM( model_string )
+ ELSE
+ filename = 'DATA_2D_'//modus//'_AV_NETCDF' &
+ //TRIM( model_string )
+ ENDIF
+ nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 1 )
+
+!
+!-- Get the list of variables (order of variables corresponds with
+!-- the order of data on the binary file)
+ var_list(av) = ' ' ! GET_ATT does not assign trailing blanks
+ nc_stat = NF90_GET_ATT( id_set(av), NF90_GLOBAL, 'VAR_LIST', &
+ var_list(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 2 )
+
+!
+!-- Inquire id of the time coordinate variable
+ nc_stat = NF90_INQ_VARID( id_set(av), 'time', id_var_time(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 3 )
+
+!
+!-- Count number of variables; there is one more semicolon in the
+!-- string than variable names
+ num_var(av) = -1
+ DO i = 1, LEN( var_list(av) )
+ IF ( var_list(av)(i:i) == ';' ) num_var(av) = num_var(av) +1
+ ENDDO
+
+!
+!-- Extract the variable names from the list and inquire their
+!-- NetCDF IDs
+ pos = INDEX( var_list(av), ';' )
+!
+!-- Loop over all variables
+ DO i = 1, num_var(av)
+
+!
+!-- Extract variable name from list
+ var_list(av) = var_list(av)(pos+1:)
+ pos = INDEX( var_list(av), ';' )
+ var_name = var_list(av)(1:pos-1)
+
+!
+!-- Get variable ID from name
+ nc_stat = NF90_INQ_VARID( id_set(av), TRIM( var_name ), &
+ id_var(av,i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 4 )
+
+!
+!-- Get number of x/y/z levels for that variable
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set(av), id_var(av,i), &
+ dimids = id_dims_loc )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 5 )
+ id_dims(av,:) = id_dims_loc
+
+!
+!-- Inquire dimension ID
+ DO j = 1, 4
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set(av), &
+ id_dims(av,j), dimname, levels(av,i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 6 )
+
+ IF ( modus == 'XY' .AND. INDEX(dimname, 'z') /= 0 ) EXIT
+ IF ( modus == 'XZ' .AND. INDEX(dimname, 'y') /= 0 ) EXIT
+ IF ( modus == 'YZ' .AND. INDEX(dimname, 'x') /= 0 ) EXIT
+ ENDDO
+
+ ENDDO
+
+ ENDDO ! av = 0, 1
+
+ ENDIF
+#endif
+
+!
+!-- Read the arrays, as long as the end of the file is reached
+ fanz = 0
+ current_level = 1
+ current_var = 999999999
+
+ DO WHILE ( danz /= 0 )
+
+!
+!-- Loop over all files (reading data of the subdomains)
+ DO id = 0, danz-1
+!
+!-- File from PE0 contains special information at the beginning,
+!-- concerning the lower and upper indices of the total-domain used
+!-- in PALM (nxag, nxeg, nyag, nyeg) and the lower and upper indices
+!-- of the array to be writte by this routine (nxa, nxe, nya,
+!-- nye). Usually in the horizontal directions nxag=-1 and nxa=0
+!-- while all other variables have the same value (i.e. nxeg=nxe).
+!-- Allocate necessary arrays, open the output file and write
+!-- the coordinate informations needed by ISO2D.
+ IF ( id == 0 .AND. fanz(0) == 0 .AND. fanz(1) == 0 ) THEN
+ READ ( id+110 ) nxag, nxeg, nyag, nyeg
+ READ ( id+110 ) nxa, nxe, nya, nye
+ ALLOCATE ( eta(nya:nye), ho(nxa:nxe), hu(nxa:nxe), &
+ pf(nxag:nxeg,nyag:nyeg) )
+ READ ( id+110 ) dx, eta, hu, ho
+
+ IF ( iso2d_output ) THEN
+ OPEN ( 2, FILE='PLOT2D_'//modus//TRIM( model_string ), &
+ FORM='UNFORMATTED' )
+ WRITE ( 2 ) dx, eta, hu, ho
+ ENDIF
+ ENDIF
+!
+!-- Read output time
+ IF ( netcdf_output .AND. id == 0 ) THEN
+ IF ( netcdf_1 ) THEN
+ READ ( id+110, END=998 ) simulated_time, time_step, av
+ ELSE
+!
+!-- For compatibility with earlier PALM versions
+ READ ( id+110, END=998 ) simulated_time, time_step
+ av = 0
+ ENDIF
+ ENDIF
+!
+!-- Read subdomain indices
+ READ ( id+110, END=998 ) xa, xe, ya, ye
+!
+!-- IF the PE made no output (in case that no part of the
+!-- cross-section is situated on this PE), indices have the
+!-- value -1
+ IF ( .NOT. ( xa == -1 .AND. xe == -1 .AND. &
+ ya == -1 .AND. ye == -1 ) ) THEN
+!
+!-- Read the subdomain grid-point values
+ READ ( id+110 ) pf(xa:xe,ya:ye)
+ ENDIF
+ IF ( id == 0 ) fanz(av) = fanz(av) + 1
+
+ ENDDO
+!
+!-- Write the data of the total domain cross-section
+ IF ( iso2d_output ) WRITE ( 2 ) pf(nxa:nxe,nya:nye)
+
+!
+!-- Write same data in NetCDF format
+ IF ( netcdf_output ) THEN
+#if defined( __netcdf )
+!
+!-- Check if a new time step has begun; if yes write data to time
+!-- axis
+ IF ( current_var(av) > num_var(av) ) THEN
+ current_var(av) = 1
+ nc_stat = NF90_PUT_VAR( id_set(av), id_var_time(av), &
+ (/ simulated_time /), &
+ start = (/ time_step /), &
+ count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 7 )
+ ENDIF
+
+!
+!-- Now write the data; this is mode dependent
+ SELECT CASE ( modus )
+
+ CASE ( 'XY' )
+ nc_stat = NF90_PUT_VAR( id_set(av), &
+ id_var(av,current_var(av)), &
+ pf(nxa:nxe,nya:nye), &
+ start = (/ 1, 1, current_level(av), time_step /), &
+ count = (/ nxe-nxa+1, nye-nya+1, 1, 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 8)
+
+ CASE ( 'XZ' )
+ nc_stat = NF90_PUT_VAR( id_set(av), &
+ id_var(av,current_var(av)), &
+ pf(nxa:nxe,nya:nye), &
+ start = (/ 1, current_level(av), 1, time_step /), &
+ count = (/ nxe-nxa+1, 1, nye-nya+1, 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 9)
+
+ CASE ( 'YZ' )
+ nc_stat = NF90_PUT_VAR( id_set(av), &
+ id_var(av,current_var(av)), &
+ pf(nxa:nxe,nya:nye), &
+ start = (/ current_level(av), 1, 1, time_step /), &
+ count = (/ 1, nxe-nxa+1, nye-nya+1, 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error(10)
+
+ END SELECT
+
+!
+!-- Data is written, check if max level is reached
+ current_level(av) = current_level(av) + 1
+ IF ( current_level(av) > levels(av,current_var(av)) ) THEN
+ current_level(av) = 1
+ current_var(av) = current_var(av) + 1
+ ENDIF
+
+ ENDIF
+#endif
+
+ ENDDO
+
+998 IF ( danz /= 0 ) THEN
+!
+!-- Print the number of the arrays processed
+ WRITE (*,'(16X,I4,A)') fanz(0)+fanz(1), ' array(s) processed'
+ IF ( fanz(1) /= 0 ) THEN
+ WRITE (*,'(16X,I4,A)') fanz(1), ' array(s) are time-averaged'
+ ENDIF
+
+!
+!-- Close all files and deallocate arrays
+ DO id = 0, danz-1
+ CLOSE ( id+110 )
+ ENDDO
+ CLOSE ( 2 )
+ DEALLOCATE ( eta, ho, hu, pf )
+ ENDIF
+
+!
+!-- Close the NetCDF file
+ IF ( netcdf_output .AND. danz /= 0 ) THEN
+#if defined( __netcdf )
+ IF ( netcdf_0 ) THEN
+ nc_stat = NF90_CLOSE( id_set(0) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 11 )
+ ENDIF
+ IF ( netcdf_1 ) THEN
+ nc_stat = NF90_CLOSE( id_set(1) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 12 )
+ ENDIF
+#endif
+ ENDIF
+
+!
+!-- Choose the next cross-section
+ SELECT CASE ( modus )
+ CASE ( 'XY' )
+ modus = 'XZ'
+ CASE ( 'XZ' )
+ modus = 'YZ'
+ CASE ( 'YZ' )
+ modus = 'no'
+ END SELECT
+
+ ENDDO
+
+
+!
+!-- Combine the 3D-arrays
+
+!
+!-- Inquire whether an avs fld file exists
+ INQUIRE( FILE='PLOT3D_FLD'//TRIM( model_string ), EXIST=avs_output )
+
+!
+!-- Inquire whether a NetCDF file exists
+ INQUIRE( FILE='DATA_3D_NETCDF'//TRIM( model_string ), EXIST=netcdf_0 )
+
+!
+!-- Inquire whether a NetCDF file for time-averaged data exists
+ INQUIRE( FILE='DATA_3D_AV_NETCDF'//TRIM( model_string ), EXIST=netcdf_1 )
+
+ IF ( netcdf_0 .OR. netcdf_1 ) THEN
+ netcdf_output = .TRUE.
+ ELSE
+ netcdf_output = .FALSE.
+ ENDIF
+
+!
+!-- Check, if file from PE0 exists
+ danz = 0
+ WRITE (id_string,'(I4.4)') danz
+ INQUIRE ( &
+ FILE='PLOT3D_DATA'//TRIM( model_string )//'_'//TRIM( id_string ), &
+ EXIST=found )
+
+!
+!-- Combination only works, if data are not compressed. In that case,
+!-- PALM created a flag file (PLOT3D_COMPRESSED)
+ INQUIRE ( FILE='PLOT3D_COMPRESSED'//TRIM( model_string ), &
+ EXIST=compressed )
+
+!
+!-- Find out the number of files and open them
+ DO WHILE ( found .AND. .NOT. compressed )
+
+ OPEN ( danz+110, &
+ FILE='PLOT3D_DATA'//TRIM( model_string )//'_'//TRIM(id_string), &
+ FORM='UNFORMATTED')
+ danz = danz + 1
+ WRITE (id_string,'(I4.4)') danz
+ INQUIRE ( &
+ FILE='PLOT3D_DATA'//TRIM( model_string )//'_'//TRIM(id_string), &
+ EXIST=found )
+
+ ENDDO
+
+!
+!-- Info-output
+ PRINT*, ' '
+ PRINT*, '*** combine_plot_fields ***'
+#if defined( __netcdf )
+ IF ( netcdf_output ) PRINT*, ' NetCDF output enabled'
+#else
+ IF ( netcdf_output ) THEN
+ PRINT*, '--- Sorry, no NetCDF support on this host'
+ netcdf_output = .FALSE.
+ ENDIF
+#endif
+ IF ( danz /= 0 ) THEN
+ PRINT*, ' 3D-data: ', danz, ' file(s) found'
+ ELSE
+ IF ( found .AND. compressed ) THEN
+ PRINT*, '+++ no 3D-data processing, since data are compressed'
+ ELSE
+ PRINT*, ' no 3D-data file available'
+ ENDIF
+ ENDIF
+
+ IF ( netcdf_output .AND. danz /= 0 ) THEN
+#if defined( __netcdf )
+ DO av = 0, 1
+
+ IF ( av == 0 .AND. .NOT. netcdf_0 ) CYCLE
+ IF ( av == 1 .AND. .NOT. netcdf_1 ) CYCLE
+
+!
+!-- Open NetCDF dataset
+ IF ( av == 0 ) THEN
+ filename = 'DATA_3D_NETCDF'//TRIM( model_string )
+ ELSE
+ filename = 'DATA_3D_AV_NETCDF'//TRIM( model_string )
+ ENDIF
+ nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 13 )
+
+
+!
+!-- Get the list of variables (order of variables corresponds with the
+!-- order of data on the binary file)
+ var_list(av) = ' ' ! GET_ATT does not assign trailing blanks
+ nc_stat = NF90_GET_ATT( id_set(av), NF90_GLOBAL, 'VAR_LIST', &
+ var_list(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 14 )
+
+!
+!-- Inquire id of the time coordinate variable
+ nc_stat = NF90_INQ_VARID( id_set(av), 'time', id_var_time(av) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 15 )
+
+!
+!-- Count number of variables; there is one more semicolon in the
+!-- string than variable names
+ num_var(av) = -1
+ DO i = 1, LEN( var_list(av) )
+ IF ( var_list(av)(i:i) == ';' ) num_var(av) = num_var(av) + 1
+ ENDDO
+
+!
+!-- Extract the variable names from the list and inquire their NetCDF
+!-- IDs
+ pos = INDEX( var_list(av), ';' )
+!
+!-- Loop over all variables
+ DO i = 1, num_var(av)
+
+!
+!-- Extract variable name from list
+ var_list(av) = var_list(av)(pos+1:)
+ pos = INDEX( var_list(av), ';' )
+ var_name = var_list(av)(1:pos-1)
+
+!
+!-- Get variable ID from name
+! print*, '*** find id for "',TRIM( var_name ),'" begin'
+ nc_stat = NF90_INQ_VARID( id_set(av), TRIM( var_name ), &
+ id_var(av,i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 16 )
+! print*, '*** find id for "',TRIM( var_name ),'" end'
+
+ ENDDO
+
+ ENDDO ! av=0,1
+
+ ENDIF
+#endif
+
+!
+!-- Read arrays, until the end of the file is reached
+ current_var = 999999999
+ fanz = 0
+ DO WHILE ( danz /= 0 )
+
+!
+!-- Loop over all files
+ DO id = 0, danz-1
+!
+!-- File from PE0 contains special information at the beginning,
+!-- concerning the lower and upper indices of the total-domain used in
+!-- PALM (nxag, nxeg, nyag, nyeg, nzag, nzeg) and the lower and upper
+!-- indices of the array to be written by this routine (nxa, nxe, nya,
+!-- nye, nza, nze). Usually nxag=-1 and nxa=0, nyag=-1 and nya=0,
+!-- nzeg=nz and nze=nz_plot3d.
+!-- Allocate necessary array and open the output file.
+ IF ( id == 0 .AND. fanz(0) == 0 .AND. fanz(1) == 0 ) THEN
+ READ ( id+110 ) nxag, nxeg, nyag, nyeg, nzag, nzeg
+ READ ( id+110 ) nxa, nxe, nya, nye, nza, nze
+ ALLOCATE ( pf3d(nxag:nxeg,nyag:nyeg,nzag:nzeg) )
+ IF ( avs_output ) THEN
+ OPEN ( 2, FILE='PLOT3D_DATA'//TRIM( model_string ), &
+ FORM='UNFORMATTED' )
+ ENDIF
+ ENDIF
+
+!
+!-- Read output time
+ IF ( netcdf_output .AND. id == 0 ) THEN
+ IF ( netcdf_1 ) THEN
+ READ ( id+110, END=999 ) simulated_time, time_step, av
+ ELSE
+!
+!-- For compatibility with earlier PALM versions
+ READ ( id+110, END=999 ) simulated_time, time_step
+ av = 0
+ ENDIF
+ ENDIF
+
+!
+!-- Read subdomain indices and grid point values
+ READ ( id+110, END=999 ) xa, xe, ya, ye, za, ze
+ READ ( id+110 ) pf3d(xa:xe,ya:ye,za:ze)
+ IF ( id == 0 ) fanz(av) = fanz(av) + 1
+
+ ENDDO
+
+!
+!-- Write data of the total domain
+ IF ( avs_output ) WRITE ( 2 ) pf3d(nxa:nxe,nya:nye,nza:nze)
+
+!
+!-- Write same data in NetCDF format
+ IF ( netcdf_output ) THEN
+#if defined( __netcdf )
+!
+!-- Check if a new time step has begun; if yes write data to time axis
+ IF ( current_var(av) > num_var(av) ) THEN
+ current_var(av) = 1
+ nc_stat = NF90_PUT_VAR( id_set(av), id_var_time(av), &
+ (/ simulated_time /),&
+ start = (/ time_step /), count = (/ 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 17 )
+ ENDIF
+
+!
+!-- Now write the data
+ nc_stat = NF90_PUT_VAR( id_set(av), id_var(av,current_var(av)), &
+ pf3d(nxa:nxe,nya:nye,nza:nze), &
+ start = (/ 1, 1, 1, time_step /), &
+ count = (/ nxe-nxa+1, nye-nya+1, nze-nza+1, 1 /) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 18 )
+
+ current_var(av) = current_var(av) + 1
+
+#endif
+ ENDIF
+
+ ENDDO
+
+999 IF ( danz /= 0 ) THEN
+!
+!-- Print the number of arrays processed
+ WRITE (*,'(16X,I4,A)') fanz(0)+fanz(1), ' array(s) processed'
+ IF ( fanz(1) /= 0 ) THEN
+ WRITE (*,'(16X,I4,A)') fanz(1), ' array(s) are time-averaged'
+ ENDIF
+!
+!-- Close all files and deallocate array
+ DO id = 0, danz-1
+ CLOSE ( id+110 )
+ ENDDO
+ CLOSE ( 2 )
+ DEALLOCATE ( pf3d )
+!
+!-- Close the NetCDF file
+ IF ( netcdf_output ) THEN
+#if defined( __netcdf )
+ IF ( netcdf_0 ) THEN
+ nc_stat = NF90_CLOSE( id_set(0) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 19 )
+ ENDIF
+ IF ( netcdf_1 ) THEN
+ nc_stat = NF90_CLOSE( id_set(1) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 20 )
+ ENDIF
+#endif
+ ENDIF
+ ENDIF
+
+ ENDDO ! models
+
+
+ CONTAINS
+
+
+ SUBROUTINE handle_netcdf_error( errno )
+!
+!-- Prints out a text message corresponding to the current NetCDF status
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: errno
+
+ IF ( nc_stat /= NF90_NOERR ) THEN
+ PRINT*, '+++ combine_plot_fields netcdf: ', av, errno, &
+ TRIM( nf90_strerror( nc_stat ) )
+ ENDIF
+
+ END SUBROUTINE handle_netcdf_error
+
+
+ END PROGRAM combine_plot_fields
+
+
+
Index: /palm/tags/release-3.4a/UTIL/combine_plot_fields_single_open.f90
===================================================================
--- /palm/tags/release-3.4a/UTIL/combine_plot_fields_single_open.f90 (revision 141)
+++ /palm/tags/release-3.4a/UTIL/combine_plot_fields_single_open.f90 (revision 141)
@@ -0,0 +1,231 @@
+ PROGRAM combine_plot_fields
+
+!-------------------------------------------------------------------------------!
+! Aktuelle Aenderungen:
+! ---------------------
+! Prozessordateien werden einzeln geoeffnet und geschlossen
+!
+! Fruehere Aenderungen:
+! ---------------------
+! 23/02/99 Keine Bearbeitung komprimierter 3D-Daten
+! Ursprungsversion vom 28/07/97
+!
+!
+! Beschreibung:
+! -------------
+! Vereinigung der von PARLES im Parallelbetrieb erzeugten Teilfelder zu
+! gemeinsamen, das jeweilige Gesamtgebiet umfassenden Plotfeldern
+!-------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+!
+!-- Lokale Variablen
+ CHARACTER (LEN=2) :: modus
+ CHARACTER (LEN=7) :: id_char
+
+ INTEGER, PARAMETER :: spk = SELECTED_REAL_KIND( 6 )
+
+ INTEGER :: danz, fanz, id, nxa, nxag, nxe, nxeg, nya, nyag, nye, nyeg, &
+ nza, nzag, nze, nzeg, xa, xe, ya, ye, za, ze
+
+ LOGICAL :: compressed, found
+
+ REAL :: dx
+ REAL, DIMENSION(:), ALLOCATABLE :: eta, ho, hu
+ REAL, DIMENSION(:,:), ALLOCATABLE :: pf
+ REAL(spk), DIMENSION(:,:,:), ALLOCATABLE :: pf3d
+
+
+!
+!-- 2D-Felder fuer ISO2D
+!-- Hauptschleife ueber die 3 Schnittarten, beginnend mit xy-Schnitt
+ modus = 'XY'
+ PRINT*, ''
+ DO WHILE ( modus == 'XY' .OR. modus == 'XZ' .OR. modus == 'YZ' )
+!
+!-- Pruefen, ob Basisdatei von PE0 vorhanden
+ danz = 0
+ WRITE (id_char,'(A2,''_'',I4.4)') modus, danz
+ INQUIRE ( FILE='PLOT2D_'//id_char, EXIST=found )
+!
+!-- Anzahl der Dateien feststellen
+ DO WHILE ( found )
+
+ danz = danz + 1
+ WRITE (id_char,'(A2,''_'',I4.4)') modus, danz
+ INQUIRE ( FILE='PLOT2D_'//id_char, EXIST=found )
+
+ ENDDO
+!
+!-- Info-Ausgabe
+ PRINT*, ''
+ PRINT*, '*** combine_plot_fields ***'
+ IF ( danz /= 0 ) THEN
+ PRINT*, modus,'-Schnitt: ', danz, ' Datei(en) gefunden'
+ ELSE
+ PRINT*, 'keine ', modus, '-Schnitte vorhanden'
+ ENDIF
+
+!
+!-- Einzelne Felder einlesen, bis keine mehr auf den Dateien vorhanden
+ fanz = 0
+ DO WHILE ( danz /= 0 )
+
+!
+!-- Schleife ueber alle Dateien
+ DO id = 0, danz-1
+!
+!-- Prozessordatei oeffnen
+ WRITE (id_char,'(A2,''_'',I4.4)') modus, id
+ OPEN ( 1, FILE='PLOT2D_'//id_char, FORM='UNFORMATTED', &
+ POSITION='ASIS' )
+
+!
+!-- Bei erster Datei und erstem eingelesenen Teilfeld Gesamtfeld
+!-- allokieren, Ausgabedatei oeffnen und Koordinateninformationen
+!-- schreiben
+ IF ( id == 0 .AND. fanz == 0 ) THEN
+ READ ( 1 ) nxag, nxeg, nyag, nyeg
+ READ ( 1 ) nxa, nxe, nya, nye
+ ALLOCATE ( eta(nya:nye), ho(nxa:nxe), hu(nxa:nxe), &
+ pf(nxag:nxeg,nyag:nyeg) )
+ READ ( 1 ) dx, eta, hu, ho
+
+ OPEN ( 2, FILE='PLOT2D_'//modus, FORM='UNFORMATTED' )
+ WRITE ( 2 ) dx, eta, hu, ho
+ ENDIF
+!
+!-- Teilfeld einlesen und ausgeben
+ READ ( 1, END=998 ) xa, xe, ya, ye
+!
+!-- Falls PE kein Teilfeld ausgegeben hat, sind Indices entsprechend
+!-- gesetzt
+ IF ( .NOT. ( xa == -1 .AND. xe == -1 .AND. &
+ ya == -1 .AND. ye == -1 ) ) THEN
+ READ ( 1 ) pf(xa:xe,ya:ye)
+ ENDIF
+ IF ( id == 0 ) fanz = fanz + 1
+
+!
+!-- Prozessordatei schliessen
+ CLOSE ( 1 )
+
+ ENDDO
+!
+!-- Ausgabe des jeweiligen Gesamtfeldes
+ WRITE ( 2 ) pf(nxa:nxe,nya:nye)
+
+ ENDDO
+
+998 IF ( danz /= 0 ) THEN
+!
+!-- Anzahl der bearbeiteten Felder ausgeben
+ PRINT*, modus, '-Schnitt: ', fanz, ' Feld(er) ausgegeben'
+!
+!-- Dateien schliessen, allokierte Felder freigeben
+ CLOSE ( 1 )
+ CLOSE ( 2 )
+ DEALLOCATE ( eta, ho, hu, pf )
+ ENDIF
+!
+!-- Naechste Schnittebene
+ SELECT CASE ( modus )
+ CASE ( 'XY' )
+ modus = 'XZ'
+ CASE ( 'XZ' )
+ modus = 'YZ'
+ CASE ( 'YZ' )
+ modus = 'no'
+ END SELECT
+
+ ENDDO
+
+
+!
+!-- 3D-Felder fuer AVS
+!
+!-- Pruefen, ob Basisdatei von PE0 vorhanden
+ danz = 0
+ WRITE (id_char,'(I4.4)') danz
+ INQUIRE ( FILE='PLOT3D_DATA_'//TRIM( id_char ), EXIST=found )
+
+!
+!-- Vereinigung darf nur erfolgen, wenn 3D-Daten unkomprimiert vorliegen
+ INQUIRE ( FILE='PLOT3D_COMPRESSED', EXIST=compressed )
+
+!
+!-- Anzahl der Dateien feststellen
+ DO WHILE ( found .AND. .NOT. compressed )
+
+ danz = danz + 1
+ WRITE (id_char,'(I4.4)') danz
+ INQUIRE ( FILE='PLOT3D_DATA_'//TRIM( id_char ), EXIST=found )
+
+ ENDDO
+
+!
+!-- Info-Ausgabe
+ PRINT*, ' '
+ PRINT*, '*** combine_plot_fields ***'
+ IF ( danz /= 0 ) THEN
+ PRINT*, '3D-Ausgabe: ', danz, ' Datei(en) gefunden'
+ ELSE
+ IF ( found .AND. compressed ) THEN
+ PRINT*, '3D-Ausgabe nicht vorgenommen, da Daten komprimiert vorliegen'
+ ELSE
+ PRINT*, 'keine 3D-Ausgaben vorhanden'
+ ENDIF
+ ENDIF
+
+!
+!-- Einzelne Felder einlesen, bis keine mehr auf den Dateien vorhanden
+ fanz = 0
+ DO WHILE ( danz /= 0 )
+
+!
+!-- Schleife ueber alle Dateien
+ DO id = 0, danz-1
+!
+!-- Prozessordatei oeffnen
+ WRITE (id_char,'(I4.4)') id
+ OPEN ( 1, FILE='PLOT3D_DATA_'//TRIM( id_char ), FORM='UNFORMATTED', &
+ POSITION='ASIS' )
+!
+!-- Bei erster Datei und erstem eingelesenen Teilfeld Gesamtfeld
+!-- allokieren und Ausgabedatei oeffnen
+ IF ( id == 0 .AND. fanz == 0 ) THEN
+ READ ( 1 ) nxag, nxeg, nyag, nyeg, nzag, nzeg
+ READ ( 1 ) nxa, nxe, nya, nye, nza, nze
+ ALLOCATE ( pf3d(nxag:nxeg,nyag:nyeg,nzag:nzeg) )
+ OPEN ( 2, FILE='PLOT3D_DATA', FORM='UNFORMATTED' )
+ ENDIF
+!
+!-- Teilfeld einlesen und ausgeben
+ READ ( 1, END=999 ) xa, xe, ya, ye, za, ze
+ READ ( 1 ) pf3d(xa:xe,ya:ye,za:ze)
+ IF ( id == 0 ) fanz = fanz + 1
+
+!
+!-- Prozessordatei schliessen
+ CLOSE ( 1 )
+
+ ENDDO
+!
+!-- Ausgabe des jeweiligen Gesamtfeldes
+ WRITE ( 2 ) pf3d(nxa:nxe,nya:nye,nza:nze)
+
+ ENDDO
+
+999 IF ( danz /= 0 ) THEN
+!
+!-- Anzahl der bearbeiteten Felder ausgeben
+ PRINT*, '3D-Ausgabe: ', fanz, ' Feld(er) ausgegeben'
+!
+!-- Dateien schliessen, allokierte Felder freigeben
+ CLOSE ( 1 )
+ CLOSE ( 2 )
+ DEALLOCATE ( pf3d )
+ ENDIF
+
+ END PROGRAM combine_plot_fields
Index: /palm/tags/release-3.4a/UTIL/compare_palm_logs.f90
===================================================================
--- /palm/tags/release-3.4a/UTIL/compare_palm_logs.f90 (revision 141)
+++ /palm/tags/release-3.4a/UTIL/compare_palm_logs.f90 (revision 141)
@@ -0,0 +1,281 @@
+ PROGRAM compare_palm_logs
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+!
+!
+! Former revisions:
+! -----------------
+!
+! Description:
+! ------------
+! This routine compares the log files from two different PALM runs.
+!
+! This routine must be compiled with:
+! decalpha:
+! f95 -cpp -fast -r8
+! IBM-Regatta:
+! xlf95 -qsuffix=cpp=f90 -qrealsize=8 -q64 -qmaxmem=-1 -Q -O3
+! IMUK:
+! ifort compare...f90 -o compare...x
+! -cpp -axW -r8 -nbs -Vaxlib
+! NEC-SX6:
+! sxf90 compare...f90 -o compare...x
+! -C hopt -Wf '-A idbl4'
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+!
+!-- Local variables
+ CHARACTER (LEN=5) :: id_char
+ CHARACTER (LEN=80), DIMENSION(2) :: directory, log_message
+ CHARACTER (LEN=100), DIMENSION(2) :: filename
+
+ INTEGER :: count=0, i, id, i1(2), i2(2), j, j1(2), j2(2), k, k1(2), k2(2), &
+ n_err, n_files(2)
+
+ LOGICAL :: found
+
+ REAL :: simtime(2)
+
+ INTEGER, DIMENSION(:,:), ALLOCATABLE :: array_2d_i_1, array_2d_i_2
+
+ REAL, DIMENSION(:,:), ALLOCATABLE :: array_2d_1, array_2d_2
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: array_1, array_2
+
+ directory(1) = 'const_log/'
+ directory(2) = 'const_log.1/'
+
+!
+!-- Check, if file from PE0 exists on directory 1. Stop, if it does not exist.
+ n_files(1) = 0
+
+ WRITE (id_char,'(''_'',I4.4)') n_files(1)
+ INQUIRE ( FILE=TRIM( directory(1) )//id_char, EXIST=found )
+!
+!-- Find out the number of files (equal to the number of PEs which
+!-- have been used in PALM) and open them
+ DO WHILE ( found )
+
+ OPEN ( n_files(1)+100, FILE=TRIM( directory(1) )//id_char, &
+ FORM='UNFORMATTED' )
+ n_files(1) = n_files(1) + 1
+ WRITE (id_char,'(''_'',I4.4)') n_files(1)
+ INQUIRE ( FILE=TRIM( directory(1) )//id_char, EXIST=found )
+
+ ENDDO
+
+ IF ( n_files(1) == 0 ) THEN
+ PRINT*, '+++ no file _0000 in directory "', TRIM( directory(1) ), '"'
+ STOP
+ ELSE
+ PRINT*, '*** directory "', TRIM( directory(1) ), '": ', n_files(1), &
+ ' files found'
+ ENDIF
+
+!
+!-- Same for the second directory
+ n_files(2) = 0
+
+ WRITE (id_char,'(''_'',I4.4)') n_files(2)
+ INQUIRE ( FILE=TRIM( directory(2) )//id_char, EXIST=found )
+
+ DO WHILE ( found )
+
+ OPEN ( n_files(2)+200, FILE=TRIM( directory(2) )//id_char, &
+ FORM='UNFORMATTED' )
+ n_files(2) = n_files(2) + 1
+ WRITE (id_char,'(''_'',I4.4)') n_files(2)
+ INQUIRE ( FILE=TRIM( directory(2) )//id_char, EXIST=found )
+
+ ENDDO
+
+!
+!-- Number of files must be identical
+ IF ( n_files(1) /= n_files(2) ) THEN
+ PRINT*, '+++ file number mismatch'
+ PRINT*, ' ', TRIM( directory(1) ), ': ', n_files(1), ' files'
+ PRINT*, ' ', TRIM( directory(2) ), ': ', n_files(2), ' files'
+ STOP
+ ENDIF
+
+!
+!-- Compare the data file by file
+ DO id = 0, n_files(1)-1
+
+ count = 0
+
+ WRITE (filename(1),'(A,''_'',I4.4)') TRIM( directory(1) ), id
+ WRITE (filename(2),'(A,''_'',I4.4)') TRIM( directory(2) ), id
+
+ PRINT*, '*** comparing files "', TRIM( filename(1) ),'" "', &
+ TRIM( filename(2) ), '"'
+ DO
+ PRINT*,' '
+ READ ( id+100, END=100 ) log_message(1)
+ PRINT*,' --- ', TRIM( log_message(1) )
+ READ ( id+200, END=900 ) log_message(2)
+
+ IF ( TRIM( log_message(1) ) /= TRIM( log_message(2) ) ) THEN
+ PRINT*,' +++ log message on file 2 does not match:'
+ PRINT*,' ', TRIM( log_message(2) )
+ ENDIF
+
+ count = count + 1
+ IF ( log_message(1)(1:2) == '3d' ) THEN
+ PRINT*,' *** reading 3d array'
+ READ ( id+100, END=901 ) simtime(1), i1(1), i2(1), j1(1), j2(1), &
+ k1(1), k2(1)
+ PRINT*,' time=', simtime(1)
+ PRINT*,' array size=(',i1(1),':',i2(1), &
+ ',',j1(1),':',j2(1),',',k1(1),':',k2(1),')'
+ READ ( id+200, END=902 ) simtime(2), i1(2), i2(2), j1(2), j2(2), &
+ k1(2), k2(2)
+ IF ( simtime(1) /= simtime(2) .OR. i1(1) /= i1(2) .OR. &
+ i2(1) /= i2(2) .OR. j1(1) /= j1(2) .OR. j2(1) /= j2(2) .OR. &
+ k1(1) /= k1(2) .OR. k2(1) /= k2(2) ) THEN
+ PRINT*,' +++ time/indices on file 2 does not match:'
+ PRINT*,' time=', simtime(2)
+ PRINT*,' array size=(',i1(2),':', &
+ i2(2), ',',j1(2),':',j2(2),',',k1(2),':',k2(2),')'
+ STOP
+ ENDIF
+
+ ALLOCATE( array_1(i1(1):i2(1),j1(1):j2(1),k1(1):k2(1)), &
+ array_2(i1(2):i2(2),j1(2):j2(2),k1(2):k2(2)) )
+
+ READ ( id+100, END=903 ) array_1
+ READ ( id+200, END=904 ) array_2
+
+ n_err = 0
+loop: DO k = k1(1), k2(1)
+loop1: DO j = j1(1), j2(1)
+ DO i = i1(1), i2(1)
+ IF ( array_1(i,j,k) /= array_2(i,j,k) ) THEN
+ PRINT*,'+++ data mismatch on element (',i,',',j,',',k,')'
+ PRINT*,' array_1: ', array_1(i,j,k)
+ PRINT*,' array_2: ', array_2(i,j,k)
+ n_err = n_err + 1
+ IF ( n_err > 5 ) EXIT loop
+ ENDIF
+ ENDDO
+ ENDDO loop1
+ ENDDO loop
+
+ DEALLOCATE( array_1, array_2 )
+
+ ELSEIF ( log_message(1)(1:2) == '2d' ) THEN
+ PRINT*,' *** reading 2d array'
+ READ ( id+100, END=901 ) simtime(1), i1(1), i2(1), j1(1), j2(1)
+ PRINT*,' time=', simtime(1)
+ PRINT*,' array size=(',i1(1),':',i2(1), &
+ ',',j1(1),':',j2(1),')'
+ READ ( id+200, END=902 ) simtime(2), i1(2), i2(2), j1(2), j2(2)
+ IF ( simtime(1) /= simtime(2) .OR. i1(1) /= i1(2) .OR. &
+ i2(1) /= i2(2) .OR. j1(1) /= j1(2) .OR. j2(1) /= j2(2) ) THEN
+ PRINT*,' +++ time/indices on file 2 does not match:'
+ PRINT*,' time=', simtime(2)
+ PRINT*,' array size=(',i1(2),':', &
+ i2(2), ',',j1(2),':',j2(2),')'
+ ENDIF
+
+ ALLOCATE( array_2d_1(i1(1):i2(1),j1(1):j2(1)), &
+ array_2d_2(i1(2):i2(2),j1(2):j2(2)) )
+
+ READ ( id+100, END=903 ) array_2d_1
+ READ ( id+200, END=904 ) array_2d_2
+
+ IF ( i1(1) /= i1(2) ) i1(1) = i1(2)
+ IF ( i2(1) /= i2(2) ) i2(1) = i2(2)
+ IF ( j1(1) /= j1(2) ) j1(1) = j1(2)
+ IF ( j2(1) /= j2(2) ) j2(1) = j2(2)
+
+ n_err = 0
+loop2: DO j = j1(1), j2(1)
+ DO i = i1(1), i2(1)
+ IF ( array_2d_1(i,j) /= array_2d_2(i,j) ) THEN
+ PRINT*,'+++ data mismatch on element (',i,',',j,')'
+ PRINT*,' array_1: ', array_2d_1(i,j)
+ PRINT*,' array_2: ', array_2d_2(i,j)
+ n_err = n_err + 1
+ IF ( n_err > 5 ) EXIT loop2
+ ENDIF
+ ENDDO
+ ENDDO loop2
+
+ DEALLOCATE( array_2d_1, array_2d_2 )
+
+ ELSE
+ PRINT*,' *** reading 2d int array'
+ READ ( id+100, END=901 ) simtime(1), i1(1), i2(1), j1(1), j2(1)
+ PRINT*,' time=', simtime(1)
+ PRINT*,' array size=(',i1(1),':',i2(1), &
+ ',',j1(1),':',j2(1),')'
+ READ ( id+200, END=902 ) simtime(2), i1(2), i2(2), j1(2), j2(2)
+ IF ( simtime(1) /= simtime(2) .OR. i1(1) /= i1(2) .OR. &
+ i2(1) /= i2(2) .OR. j1(1) /= j1(2) .OR. j2(1) /= j2(2) ) THEN
+ PRINT*,' +++ time/indices on file 2 does not match:'
+ PRINT*,' time=', simtime(2)
+ PRINT*,' array size=(',i1(2),':', &
+ i2(2), ',',j1(2),':',j2(2),')'
+ ENDIF
+
+ ALLOCATE( array_2d_i_1(i1(1):i2(1),j1(1):j2(1)), &
+ array_2d_i_2(i1(2):i2(2),j1(2):j2(2)) )
+
+ READ ( id+100, END=903 ) array_2d_i_1
+ READ ( id+200, END=904 ) array_2d_i_2
+
+ IF ( i1(1) /= i1(2) ) i1(1) = i1(2)
+ IF ( i2(1) /= i2(2) ) i2(1) = i2(2)
+ IF ( j1(1) /= j1(2) ) j1(1) = j1(2)
+ IF ( j2(1) /= j2(2) ) j2(1) = j2(2)
+
+ n_err = 0
+loop3: DO j = j1(1), j2(1)
+ DO i = i1(1), i2(1)
+ IF ( array_2d_i_1(i,j) /= array_2d_i_2(i,j) ) THEN
+ PRINT*,'+++ data mismatch on element (',i,',',j,')'
+ PRINT*,' array_1: ', array_2d_i_1(i,j)
+ PRINT*,' array_2: ', array_2d_i_2(i,j)
+ n_err = n_err + 1
+ IF ( n_err > 5 ) EXIT loop3
+ ENDIF
+ ENDDO
+ ENDDO loop3
+
+ DEALLOCATE( array_2d_i_1, array_2d_i_2 )
+
+ ENDIF
+
+! IF ( count > 8 ) STOP
+ ENDDO
+
+100 PRINT*, '*** end of data on file "', TRIM( filename(1) ), '"'
+ PRINT*, '*** files seem to be identical'
+ PRINT*, ' '
+ ENDDO
+
+ STOP
+
+900 PRINT*,'+++ unexpected end on file "', TRIM( filename(2) ), '"'
+ STOP
+901 PRINT*,'+++ unexpected end on file "', TRIM( filename(1) ), '"'
+ PRINT*,' while reading indices'
+ STOP
+902 PRINT*,'+++ unexpected end on file "', TRIM( filename(2) ), '"'
+ PRINT*,' while reading indices'
+ STOP
+903 PRINT*,'+++ unexpected end on file "', TRIM( filename(1) ), '"'
+ PRINT*,' while reading array data'
+ STOP
+904 PRINT*,'+++ unexpected end on file "', TRIM( filename(2) ), '"'
+ PRINT*,' while reading array data'
+ STOP
+
+ END PROGRAM compare_palm_logs
+
+
+
Index: /palm/tags/release-3.4a/UTIL/find_palm_config.f90
===================================================================
--- /palm/tags/release-3.4a/UTIL/find_palm_config.f90 (revision 141)
+++ /palm/tags/release-3.4a/UTIL/find_palm_config.f90 (revision 141)
@@ -0,0 +1,336 @@
+ PROGRAM find_palm_config
+
+!------------------------------------------------------------------------------!
+! Description:
+! -------------
+! Find possible configurations for given processor and grid point numbers
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=1) :: char = ''
+ INTEGER :: count = 0, i, ii(1), j, k, maximum_grid_level, mg_levels_x, &
+ mg_levels_y, mg_levels_z, n, numprocs, numprocs_max, &
+ numprocs_min, nx, nxanz, nx_max, nx_min, ny, nyanz, ny_max, &
+ ny_min, nz, nz_max, nz_min, pdims(2)
+ INTEGER :: numnx(10000), numpr(10000)
+ LOGICAL :: cubic_domain = .FALSE., found, found_once = .FALSE., &
+ one_d_decomp = .FALSE., quadratic_domain_xy = .FALSE.
+ REAL :: grid_ratio, grid_ratio_new, maximum_grid_ratio, tolerance, &
+ tolerance_nx, tolerance_ny, tolerance_nz
+ REAL :: gridratio(10000)
+
+ TYPE configuration
+ REAL :: grid_ratio
+ INTEGER :: numprocs, pdims_1, pdims_2, nx, ny, nz, nxanz, &
+ nyanz, grid_levels, nx_mg, ny_mg, nz_mg
+ END TYPE configuration
+
+ TYPE(configuration), DIMENSION(10000) :: config
+
+!
+!-- Ask number of processors available
+ PRINT*, '*** number of PEs available + allowed tolerance:'
+ READ (*,*) numprocs, tolerance
+ IF ( tolerance < 0.0 ) THEN
+ numprocs_max = numprocs
+ numprocs_min = numprocs * ( 1.0 + tolerance )
+ ELSE
+ numprocs_max = numprocs * ( 1.0 + tolerance )
+ numprocs_min = numprocs * ( 1.0 - tolerance )
+ ENDIF
+
+!
+!-- Ask for 1D-decomposition
+ PRINT*, ' '
+ PRINT*, ' '
+ PRINT*, '*** shall a 1d-decomposition along x be used (y/n)?'
+ READ (*,*) char
+ IF ( char == 'y' ) one_d_decomp = .TRUE.
+
+!
+!-- Ask for quadratic domain
+ PRINT*, ' '
+ PRINT*, ' '
+ PRINT*, '*** shall a quadratic domain along x and y be used (y/n)?'
+ READ (*,*) char
+ IF ( char == 'y' ) THEN
+ quadratic_domain_xy = .TRUE.
+ PRINT*, ' '
+ PRINT*, ' '
+ PRINT*, '*** shall also grid points along z be equal to x and y (y/n)?'
+ READ (*,*) char
+ IF ( char == 'y' ) cubic_domain = .TRUE.
+ ENDIF
+
+!
+!-- Read number of gridpoints in each direction
+ PRINT*, ' '
+ PRINT*, ' '
+ PRINT*, '*** please type nx + allowed tolerance:'
+ READ (*,*) nx, tolerance_nx
+ IF ( tolerance_nx < 0.0 ) THEN
+ nx_max = nx
+ nx_min = nx * ( 1.0 + tolerance_nx )
+ ELSE
+ nx_max = nx * ( 1.0 + tolerance_nx )
+ nx_min = nx * ( 1.0 - tolerance_nx )
+ ENDIF
+ IF ( quadratic_domain_xy ) THEN
+ ny = nx
+ tolerance_ny = tolerance_nx
+ ELSE
+ PRINT*, '*** please type ny + allowed tolerance:'
+ READ (*,*) ny, tolerance_ny
+ ENDIF
+ IF ( tolerance_ny < 0.0 ) THEN
+ ny_max = ny
+ ny_min = ny * ( 1.0 + tolerance_ny )
+ ELSE
+ ny_max = ny * ( 1.0 + tolerance_ny )
+ ny_min = ny * ( 1.0 - tolerance_ny )
+ ENDIF
+ IF ( cubic_domain ) THEN
+ nz = nx
+ tolerance_nz = tolerance_nx
+ ELSE
+ PRINT*, '*** please type nz + allowed tolerance:'
+ READ (*,*) nz, tolerance_nz
+ ENDIF
+ IF ( tolerance_nz < 0.0 ) THEN
+ nz_max = nz
+ nz_min = nz * ( 1.0 + tolerance_nz )
+ ELSE
+ nz_max = nz * ( 1.0 + tolerance_nz )
+ nz_min = nz * ( 1.0 - tolerance_nz )
+ ENDIF
+
+!
+!-- Read maximum gridpoint-ratio for which results shall be printed
+ PRINT*, ' '
+ PRINT*, '*** please type maximum subdomain gridpoint-ratio'
+ PRINT*, ' ( ABS( nx_sub / ny_sub - 1.0 ) ) for which results shall be'
+ PRINT*, ' printed'
+ READ (*,*) maximum_grid_ratio
+
+!
+!-- Loop over allowed numbers of processors
+g: DO n = numprocs_max, numprocs_min, -1
+
+!
+!-- Set initial configuration
+ numprocs = n
+ pdims(1) = numprocs + 1
+ pdims(2) = 1
+
+!
+!-- Looking for practicable virtual processor grids
+p: DO WHILE ( pdims(1) > 1 )
+
+ pdims(1) = pdims(1) - 1
+
+!
+!-- Create the virtual PE-grid topology
+ IF ( MOD( numprocs , pdims(1) ) /= 0 ) THEN
+ CYCLE p
+ ELSE
+ IF ( one_d_decomp .AND. pdims(1) < numprocs ) CYCLE g
+ ENDIF
+ pdims(2) = numprocs / pdims(1)
+
+ xn: DO nx = nx_min, nx_max
+!
+!-- Proof, if grid points in x-direction can be distributed without
+!-- rest to the processors in x- and y-direction
+ IF ( MOD(nx+1, pdims(1)) /= 0 .OR. &
+ MOD(nx+1, pdims(2)) /= 0 ) CYCLE xn
+ nxanz = ( nx + 1 ) / pdims(1)
+
+ yn: DO ny = ny_min, ny_max
+!
+!-- Eventually exit in case of non quadratic domains
+ IF ( quadratic_domain_xy .AND. ny /= nx ) CYCLE yn
+!
+!-- Proof, if grid points in y-direction can be distributed without
+!-- rest to the processors in x- and y-direction
+ IF ( MOD( ny+1 , pdims(2) ) /= 0 .OR. &
+ MOD( ny+1, pdims(1) ) /= 0 ) CYCLE yn
+ nyanz = ( ny + 1 ) / pdims(2)
+
+ grid_ratio = ABS( REAL( nxanz ) / REAL( nyanz ) - 1.0 )
+
+ zn: DO nz = nz_min, nz_max
+!
+!-- Eventually exit in case of non cubic domains
+ IF ( cubic_domain .AND. nz /= nx ) CYCLE zn
+!
+!-- Proof, if grid points in z-direction can be distributed
+!-- without rest to the processors in x-direction
+ IF ( MOD( nz, pdims(1) ) /= 0 .AND. .NOT. one_d_decomp ) &
+ THEN
+ CYCLE zn
+ ENDIF
+
+!
+!-- Store configuration found
+ IF ( grid_ratio < maximum_grid_ratio ) THEN
+ found = .TRUE.
+ count = count + 1
+ config(count)%grid_ratio = grid_ratio
+ config(count)%numprocs = numprocs
+ config(count)%pdims_1 = pdims(1)
+ config(count)%pdims_2 = pdims(2)
+ config(count)%nx = nx
+ config(count)%ny = ny
+ config(count)%nz = nz
+ config(count)%nxanz = nxanz
+ config(count)%nyanz = nyanz
+ IF ( count == 10000 ) THEN
+ PRINT*, '+++ more than 10000 configurations'
+ EXIT g
+ ENDIF
+ ENDIF
+
+ IF ( one_d_decomp ) CYCLE yn
+
+ ENDDO zn
+
+ ENDDO yn
+
+ ENDDO xn
+
+ ENDDO p
+
+ ENDDO g
+
+ IF ( .NOT. found ) THEN
+ PRINT*, ' '
+ PRINT*, '+++ No valid processor grid found for the given number of'
+ PRINT*, ' processors and gridpoints'
+ STOP
+ ENDIF
+
+!
+!-- Calculate number of possible grid levels and gridpoints of the coarsest grid
+!-- used by the multigrid method
+ DO n = 1, count
+ mg_levels_x = 1
+ mg_levels_y = 1
+ mg_levels_z = 1
+
+ i = config(n)%nxanz
+ DO WHILE ( MOD( i, 2 ) == 0 .AND. i /= 2 )
+ i = i / 2
+ mg_levels_x = mg_levels_x + 1
+ ENDDO
+
+ j = config(n)%nyanz
+ DO WHILE ( MOD( j, 2 ) == 0 .AND. j /= 2 )
+ j = j / 2
+ mg_levels_y = mg_levels_y + 1
+ ENDDO
+
+ k = config(n)%nz
+ DO WHILE ( MOD( k, 2 ) == 0 .AND. k /= 2 )
+ k = k / 2
+ mg_levels_z = mg_levels_z + 1
+ ENDDO
+
+ maximum_grid_level = MIN( mg_levels_x, mg_levels_y, mg_levels_z )
+ config(n)%grid_levels = maximum_grid_level
+ config(n)%nx_mg = config(n)%nxanz / 2**(maximum_grid_level-1)
+ config(n)%ny_mg = config(n)%nyanz / 2**(maximum_grid_level-1)
+ config(n)%nz_mg = config(n)%nz / 2**(maximum_grid_level-1)
+ ENDDO
+
+!
+!-- Print the configurations computed above
+ PRINT*, ' '
+ PRINT*, ' '
+ PRINT*, '*** print out results in ascending grid-ratio order (y/n)?'
+ READ (*,*) char
+ IF ( char == 'y' ) THEN
+ gridratio = 10000.0
+ gridratio(1:count) = config(1:count)%grid_ratio
+ WRITE ( *, * ) ' '
+ WRITE ( *, * ) 'Possible configurations found:'
+ WRITE ( *, * ) 'sorted in ascending grid-ratio order'
+ WRITE ( *, 100 )
+ DO
+ ii = MINLOC( gridratio )
+ i = ii(1)
+ IF ( gridratio(i) /= 10000.0 ) THEN
+ WRITE ( *, 101 ) &
+ config(i)%grid_ratio, config(i)%numprocs, config(i)%pdims_1, &
+ config(i)%pdims_2, config(i)%nx, config(i)%ny, config(i)%nz, &
+ config(i)%nxanz, config(i)%nyanz, config(i)%grid_levels, &
+ config(i)%nx_mg, config(i)%ny_mg, config(i)%nz_mg
+ gridratio(i) = 10000.0
+ ELSE
+ EXIT
+ ENDIF
+ ENDDO
+ ENDIF
+
+ PRINT*, ' '
+ PRINT*, ' '
+ PRINT*, '*** print out results in descending PE order (y/n)?'
+ READ (*,*) char
+ IF ( char == 'y' ) THEN
+ numpr = 0
+ numpr(1:count) = config(1:count)%numprocs
+ WRITE ( *, * ) ' '
+ WRITE ( *, * ) 'Possible configurations found:'
+ WRITE ( *, * ) 'sorted after number of PEs'
+ WRITE ( *, 100 )
+ DO
+ ii = MAXLOC( numpr )
+ i = ii(1)
+ IF ( numpr(i) /= 0 ) THEN
+ WRITE ( *, 101 ) &
+ config(i)%grid_ratio, config(i)%numprocs, config(i)%pdims_1, &
+ config(i)%pdims_2, config(i)%nx, config(i)%ny, config(i)%nz, &
+ config(i)%nxanz, config(i)%nyanz, config(i)%grid_levels, &
+ config(i)%nx_mg, config(i)%ny_mg, config(i)%nz_mg
+ numpr(i) = 0
+ ELSE
+ EXIT
+ ENDIF
+ ENDDO
+ ENDIF
+
+ PRINT*, ' '
+ PRINT*, ' '
+ PRINT*, '*** print out results in descending grid size order (y/n)?'
+ READ (*,*) char
+ IF ( char == 'y' ) THEN
+ numnx = 0
+ DO i = 1, count
+ numnx(i) = config(i)%nx * config(i)%ny * config(i)%nz
+ ENDDO
+ WRITE ( *, * ) ' '
+ WRITE ( *, * ) 'Possible configurations found:'
+ WRITE ( *, * ) 'sorted after grid size'
+ WRITE ( *, 100 )
+ DO
+ ii = MAXLOC( numnx )
+ i = ii(1)
+ IF ( numnx(i) /= 0 ) THEN
+ WRITE ( *, 101 ) &
+ config(i)%grid_ratio, config(i)%numprocs, config(i)%pdims_1, &
+ config(i)%pdims_2, config(i)%nx, config(i)%ny, config(i)%nz, &
+ config(i)%nxanz, config(i)%nyanz, config(i)%grid_levels, &
+ config(i)%nx_mg, config(i)%ny_mg, config(i)%nz_mg
+ numnx(i) = 0
+ ELSE
+ EXIT
+ ENDIF
+ ENDDO
+ ENDIF
+
+100 FORMAT('ratio PEs PE-grid nx ny nz subdomain grid_levels ', &
+ 'coarsest subd.')
+101 FORMAT(F4.2,2X,I4,' (',I4,',',I4,')',2X,I4,1X,I4,1X,I4,' (',I4,',',I4,')', &
+ 5X,I2,7X,'(',I3,',',I3,',',I3,')')
+
+ END PROGRAM find_palm_config
Index: /palm/tags/release-3.4a/UTIL/interpret_config.f90
===================================================================
--- /palm/tags/release-3.4a/UTIL/interpret_config.f90 (revision 141)
+++ /palm/tags/release-3.4a/UTIL/interpret_config.f90 (revision 141)
@@ -0,0 +1,552 @@
+ PROGRAM interpret_config
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
+! -----------------
+! mrun environment variables are read from NAMELIST instead of using GETENV.
+! Variables are allways assigned a value, also if they already got one. These
+! values are re-assigned later in mrun.
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! 28/02/07 - Siggi - empty lines in configuration file are accepted
+! 01/11/05 - Siggi - s2b-Feld erlaubt den Wert locopt
+! 29/06/05 - Siggi - Fehlermeldung ins englische uebertragen und ergaenzt
+! 29/04/05 - Siggi - extin wird auch fuer Input-Dateien ausgegeben
+! 18/11/97 - Siggi - Komma in 2010-FORMAT hinzugefuegt
+! 21/07/97 - Siggi - Erste Fassung
+!
+! Description:
+! -------------
+! This program reads the mrun-configuration file .mrun.config and outputs
+! its content in form of ksh-commands, which can then be executed by mrun.
+! mrun is also able to directly read from the configuration file by using
+! the option "-S" (but with much slower speed).
+!------------------------------------------------------------------------------!
+
+ IMPLICIT NONE
+
+ CHARACTER (LEN=1) :: bs = ACHAR( 92 ) ! backslash (auf vpp sonst n.
+ ! druckbar)
+ CHARACTER (LEN=20) :: do_remote, do_trace, host, localhost
+ CHARACTER (LEN=100) :: config_file, icf
+ CHARACTER (LEN=300) :: cond1, cond2, empty = REPEAT( ' ', 240 ), &
+ for_cond1, for_cond2, for_host, input_list, &
+ iolist, output_list, s1, s2, s2a, s2b, s2c, s3, &
+ s3cond, s4, s5, s6, value, value_mrun, var, zeile
+
+ INTEGER :: dummy, i, icomment = 0, icond1, icond2, idatver = 0, iec = 0, &
+ ienvvar = 0, ifor_cond1, ifor_cond2, ifor_host, ihost, &
+ iic = 0, iicf, iin = 0, iinput_list, il, ilocalhost, ioc = 0, &
+ ios, iout = 0, ioutput_list, is1, is2, is2a, is2b, is2c, &
+ is3, is3cond, is4, is5, is6, ivalue, ivar, izeile
+
+ LOGICAL :: found
+
+ NAMELIST /mrun_environment/ cond1, cond2, config_file, do_remote, &
+ do_trace, host, input_list, icf, localhost, &
+ output_list
+
+
+ OPEN ( 1, FILE='.mrun_environment', FORM='FORMATTED' )
+ READ ( 1, mrun_environment )
+
+ icond1 = LEN_TRIM( cond1 )
+ icond2 = LEN_TRIM( cond2 )
+ il = LEN_TRIM( config_file )
+ ihost = LEN_TRIM( host )
+ iinput_list = LEN_TRIM( input_list )
+ iicf = LEN_TRIM( icf )
+ ilocalhost = LEN_TRIM( localhost )
+ ioutput_list = LEN_TRIM( output_list )
+
+ iolist = input_list(1:iinput_list) // output_list(1:ioutput_list)
+
+ IF ( do_trace(1:4) == 'true' ) THEN
+ PRINT*,'*** cond1="',cond1(1:icond1),'"'
+ PRINT*,'*** cond2="',cond2(1:icond2),'"'
+ PRINT*,'*** config_file="',config_file(1:il),'"'
+ PRINT*,'*** do_remote="',do_remote,'"'
+ PRINT*,'*** do_trace="',do_trace,'"'
+ PRINT*,'*** host="',host(1:ihost),'"'
+ PRINT*,'*** input_list="',input_list(1:iinput_list),'"'
+ PRINT*,'*** interpreted_config_file="',icf(1:iicf),'"'
+ PRINT*,'*** localhost="',localhost(1:ilocalhost),'"'
+ PRINT*,'*** output_list="',output_list(1:ioutput_list),'"'
+ ENDIF
+
+ OPEN ( 1, FILE=config_file(1:il), FORM='formatted' )
+ OPEN ( 2, FILE=icf(1:iicf), FORM='formatted' )
+
+ READ ( 1, '(A)', IOSTAT=ios ) zeile
+
+
+ DO WHILE ( ios == 0 )
+
+ izeile = LEN_TRIM( zeile )
+
+ IF ( LEN_TRIM( zeile ) == 0 ) THEN
+
+ CONTINUE
+
+ ELSEIF ( zeile(1:1) == '#' ) THEN
+
+ icomment = icomment + 1
+
+ ELSEIF ( zeile(1:1) == '%' ) THEN
+
+ ienvvar = ienvvar + 1
+ i = INDEX( zeile, ' ' )
+ var = zeile(2:i-1)
+ ivar = i - 2
+
+ zeile(1:i) = empty(1:i)
+ zeile = ADJUSTL( zeile )
+ i = INDEX( zeile, ' ' )
+ value = zeile(1:i-1)
+ ivalue = i - 1
+
+ zeile(1:i) = empty(1:i)
+ zeile = ADJUSTL( zeile )
+ i = INDEX( zeile, ' ' )
+
+ IF ( i /= 1 ) THEN
+ for_host = zeile(1:i-1)
+ ifor_host = i - 1
+
+ zeile(1:i) = empty(1:i)
+ zeile = ADJUSTL( zeile )
+ i = INDEX( zeile, ' ' )
+
+ IF ( i /= 1 ) THEN
+ for_cond1 = zeile(1:i-1)
+ ifor_cond1 = i - 1
+
+ zeile(1:i) = empty(1:i)
+ zeile = ADJUSTL( zeile )
+ i = INDEX( zeile, ' ' )
+
+ IF ( i /= 1 ) THEN
+ for_cond2 = zeile(1:i-1)
+ ifor_cond2 = i - 1
+ ELSE
+ for_cond2 = ''
+ ifor_cond2 = 0
+ ENDIF
+ ELSE
+ for_cond1 = ''
+ ifor_cond1 = 0
+ for_cond2 = ''
+ ifor_cond2 = 0
+ ENDIF
+ ELSE
+ for_host = ' '
+ ifor_host = 1
+ for_cond1 = ''
+ ifor_cond1 = 0
+ for_cond2 = ''
+ ifor_cond2 = 0
+ ENDIF
+ IF ( do_trace(1:4) == 'true' ) THEN
+ PRINT*,'var="',var(1:ivar),'"'
+ PRINT*,'value="',value(1:ivalue),'"'
+ PRINT*,'for_host="',for_host(1:ifor_host),'"'
+ PRINT*,'for_cond1="',for_cond1(1:ifor_cond1),'"'
+ PRINT*,'for_cond2="',for_cond2(1:ifor_cond2),'"'
+ ENDIF
+!
+!-- Geltungsbereich pruefen und evtl. Variable ausgeben
+ IF ( for_host == ' ' .OR. ( &
+ for_host(1:ifor_host) == host(1:ihost) .AND. &
+ for_cond1(1:ifor_cond1) == cond1(1:icond1) .AND. &
+ for_cond2(1:ifor_cond2) == cond2(1:icond2) &
+ ) .OR. ( &
+ INDEX( iolist, for_host(1:ifor_host) ) /= 0 &
+ ) ) THEN
+
+!
+!-- Zuerst Doppelpunkte durch Blanks ersetzen (aber doppelt
+!-- auftretende Doppelpunkte durch einen Doppelpunkt)
+ i = 0
+ DO
+ i = i + 1
+ IF ( i > ivalue ) EXIT
+ IF ( value(i:i) == ':' ) THEN
+ IF ( value(i+1:i+1) == ':' ) THEN
+ value = value(1:i) // value(i+2:ivalue)
+ ivalue = ivalue - 1
+ ELSE
+ value(i:i) = ' '
+ ENDIF
+ ENDIF
+ ENDDO
+
+!
+!-- Variable ausgeben
+ WRITE (2,2200) var(1:ivar), bs, value(1:ivalue), bs, &
+ var(1:ivar)
+ 2200 FORMAT ('eval ',A,'=',A,'"',A,A,'"'/'export ',A)
+
+ IF ( do_trace(1:4) == 'true' ) THEN
+ WRITE (2,2201) bs, var(1:ivar), value(1:ivalue)
+ 2201 FORMAT ('printf "',A,'n*** ENVIRONMENT-VARIABLE ',A,' = ',A)
+ ENDIF
+
+ ENDIF
+
+!
+!-- Variable "host" muss gleich ausgewertet werden, da mit ihr ein
+!-- neuer Geltungsbereich festgelegt wird
+ IF ( var(1:ivar) == 'host' ) THEN
+
+ host = value(1:ivalue)
+ ihost = ivalue
+
+! IF ( host(1:ihost) /= localhost(1:ilocalhost) ) THEN
+!
+! SELECT CASE ( value(1:ivalue) )
+!
+! CASE ( 'cray','hpcs','t3d','t3eb','t3eh','unics','vpp' )
+!
+! dummy = 1
+!
+! CASE DEFAULT
+!
+! WRITE (2,2202) bs, bs, value(1:ivalue), bs, bs
+! 2202 FORMAT ('printf "',A,'n +++ Auf Zielrechner ',A,'"',A,A,'" ist kein NQS-System vorhanden"'/ &
+! 'printf "',A,'n Programmlauf kann deshalb nicht gestartet werden"'/ &
+! 'locat=nqs; exit')
+! STOP
+!
+! END SELECT
+!
+! ENDIF
+
+ ENDIF
+
+ ELSEIF ( zeile(1:3) == 'EC:' ) THEN
+!
+!-- Error-Kommandos
+ iec = iec + 1
+ IF ( iec < 10 ) THEN
+ WRITE (2,'(''err_command['',I1,'']="'',A,''"'')') iec, &
+ zeile(4:izeile)
+ ELSEIF ( iec < 100 ) THEN
+ WRITE (2,'(''err_command['',I2,'']="'',A,''"'')') iec, &
+ zeile(4:izeile)
+ ELSE
+ WRITE (2,'(''err_command['',I3,'']="'',A,''"'')') iec, &
+ zeile(4:izeile)
+ ENDIF
+
+ ELSEIF ( zeile(1:3) == 'IC:' ) THEN
+!
+!-- Input-Kommandos
+ iic = iic + 1
+ IF ( iic < 10 ) THEN
+ WRITE (2,'(''in_command['',I1,'']="'',A,''"'')') iic, &
+ zeile(4:izeile)
+ ELSEIF ( iic < 100 ) THEN
+ WRITE (2,'(''in_command['',I2,'']="'',A,''"'')') iic, &
+ zeile(4:izeile)
+ ELSE
+ WRITE (2,'(''in_command['',I3,'']="'',A,''"'')') iic, &
+ zeile(4:izeile)
+ ENDIF
+
+ ELSEIF ( zeile(1:3) == 'OC:' ) THEN
+!
+!-- Output-Kommandos
+ ioc = ioc + 1
+ IF ( ioc < 10 ) THEN
+ WRITE (2,'(''out_command['',I1,'']="'',A,''"'')') ioc, &
+ zeile(4:izeile)
+ ELSEIF ( ioc < 100 ) THEN
+ WRITE (2,'(''out_command['',I2,'']="'',A,''"'')') ioc, &
+ zeile(4:izeile)
+ ELSE
+ WRITE (2,'(''out_command['',I3,'']="'',A,''"'')') ioc, &
+ zeile(4:izeile)
+ ENDIF
+
+ ELSE
+!
+!-- Dateiverbindungen
+ idatver = idatver + 1
+!
+!-- Lokaler Name
+ i = INDEX( zeile , ' ' )
+ s1 = zeile(1:i-1)
+ is1 = i-1
+!
+!-- Dateieigenschaften
+ zeile = ADJUSTL( zeile(i:izeile) )
+ i = INDEX( zeile , ' ' )
+ s2 = zeile(1:i-1)
+ is2 = i-1
+!
+!-- Geltungsbereich
+ zeile = ADJUSTL( zeile(i:izeile) )
+ i = INDEX( zeile , ' ' )
+ s3 = zeile(1:i-1)
+ is3 = i-1
+!
+!-- Pfadname
+ zeile = ADJUSTL( zeile(i:izeile) )
+ i = INDEX( zeile , ' ' )
+ s4 = zeile(1:i-1)
+ is4 = i-1
+!
+!-- evtl. Extension
+ zeile = ADJUSTL( zeile(i:izeile) )
+ i = INDEX( zeile , ' ' )
+ IF ( i == 1 ) THEN
+ s5 = ' '
+ is5 = 1
+ s6 = ' '
+ is6 = 1
+ ELSE
+ s5 = zeile(1:i-1)
+ is5 = i-1
+!
+!-- evtl. 2. Extension
+ zeile = ADJUSTL( zeile(i:izeile) )
+ i = INDEX( zeile , ' ' )
+ IF ( i == 1 ) THEN
+ s6 = ' '
+ is6 = 1
+ ELSE
+ s6 = zeile(1:i-1)
+ is6 = i-1
+ ENDIF
+ ENDIF
+
+!
+!-- Dateieigenschaften aufspalten
+ i = INDEX( s2 , ':' )
+ IF ( i == 0 ) THEN
+ s2a = s2
+ is2a = is2
+ s2b = ''
+ is2b = 0
+ s2c = ''
+ is2c = 0
+ ELSE
+ s2a = s2(1:i-1)
+ is2a = i-1
+ s2 = s2(i+1:is2)
+
+ i = INDEX( s2 , ':' )
+ IF ( i == 0 ) THEN
+ s2b = s2
+ is2b = LEN_TRIM( s2 )
+ s2c = ''
+ is2c = 0
+ ELSE
+ s2b = s2(1:i-1)
+ is2b = i-1
+ s2c = s2(i+1:)
+ is2c = LEN_TRIM( s2c )
+ ENDIF
+ ENDIF
+!
+!-- Pruefung, ob Eingabedateiverbindung abgespeichert werden soll
+ IF ( s2a(1:is2a) == 'in' .AND. .NOT. ( &
+ do_remote(1:4) == 'true' .AND. &
+ ( s2b(1:is2b) == 'loc' .OR. s2b(1:is2b) == 'locopt' ) &
+ ) ) THEN
+ found = .FALSE.
+ i = INDEX( s3 , ':' )
+ IF ( i == 0 ) THEN
+ s3cond = s3
+ is3cond = LEN_TRIM( s3cond )
+ ELSE
+ s3cond = s3(1:i-1)
+ is3cond = i-1
+ s3 = s3(i+1:)
+ ENDIF
+
+ DO WHILE ( s3cond(1:1) /= ' ' )
+
+ IF ( INDEX( input_list(1:iinput_list) , s3cond(1:is3cond) ) /= 0 &
+ .OR. s3cond(1:is3cond) == '-' ) THEN
+ found = .TRUE.
+ ENDIF
+
+ IF ( s3(1:1) == ' ' ) THEN
+ s3cond = ' '
+ ELSE
+ i = INDEX( s3 , ':' )
+ IF ( i == 0 ) THEN
+ s3cond = s3
+ is3cond = LEN_TRIM( s3cond )
+ s3 = ' '
+ ELSE
+ s3cond = s3(1:i-1)
+ is3cond = i-1
+ s3 = s3(i+1:)
+ ENDIF
+ ENDIF
+
+ ENDDO
+
+!
+!-- Wenn Geltungsbereich erfuellt, dann Dateiverbindung abspeichern
+ IF ( found ) THEN
+
+ iin = iin + 1
+ IF ( iin < 10 ) THEN
+ WRITE (2,2000) iin, s1(1:is1), iin, s2b(1:is2b), &
+ iin, s2c(1:is2c), &
+ iin, s3(1:is3), iin, s4(1:is4), &
+ iin, s5(1:is5), iin, s6(1:is6)
+2000 FORMAT ('localin[',I1,']="',A,'"; transin[',I1,']="',A, &
+ '"; actionin[',I1,']="',A, &
+ '"; typein[',I1,']="',A,'"'/'pathin[',I1,']="',A, &
+ '"; endin[',I1,']="',A,'"; extin[',I1,']="',A,'"')
+ ELSEIF ( iin < 100 ) THEN
+ WRITE (2,2001) iin, s1(1:is1), iin, s2b(1:is2b), &
+ iin, s2c(1:is2c), &
+ iin, s3(1:is3), iin, s4(1:is4), &
+ iin, s5(1:is5), iin, s6(1:is6)
+2001 FORMAT ('localin[',I2,']="',A,'"; transin[',I2,']="',A, &
+ '"; actionin[',I2,']="',A, &
+ '"; typein[',I2,']="',A,'"'/'pathin[',I2,']="',A, &
+ '"; endin[',I2,']="',A,'"; extin[',I2,']="',A,'"')
+ ELSE
+ WRITE (2,2002) iin, s1(1:is1), iin, s2b(1:is2b), &
+ iin, s2c(1:is2c), &
+ iin, s3(1:is3), iin, s4(1:is4), &
+ iin, s5(1:is5), iin, s6(1:is6)
+2002 FORMAT ('localin[',I3,']="',A,'"; transin[',I3,']="',A, &
+ '"; actionin[',I3,']="',A, &
+ '"; typein[',I3,']="',A,'"'/'pathin[',I3,']="',A, &
+ '"; endin[',I3,']="',A,'"; extin[',I3,']="',A,'"')
+ ENDIF
+ ENDIF
+
+ ELSEIF ( s2a(1:is2a) == 'out' .AND. .NOT. ( &
+ do_remote(1:4) == 'true' .AND. s2b(1:is2b) == 'loc' &
+ ) ) THEN
+!
+!-- Pruefung, ob Ausgabedateiverbindung abgespeichert werden soll
+ found = .FALSE.
+ i = INDEX( s3 , ':' )
+ IF ( i == 0 ) THEN
+ s3cond = s3
+ is3cond = LEN_TRIM( s3cond )
+ ELSE
+ s3cond = s3(1:i-1)
+ is3cond = i-1
+ s3 = s3(i+1:)
+ ENDIF
+
+ DO WHILE ( s3cond(1:1) /= ' ' )
+
+ IF ( INDEX( output_list(1:ioutput_list) , s3cond(1:is3cond) ) /= 0 &
+ .OR. s3cond(1:is3cond) == '-' ) THEN
+ found = .TRUE.
+ ENDIF
+
+ IF ( s3(1:1) == ' ' ) THEN
+ s3cond = ' '
+ ELSE
+ i = INDEX( s3 , ':' )
+ IF ( i == 0 ) THEN
+ s3cond = s3
+ is3cond = LEN_TRIM( s3cond )
+ s3 = ' '
+ ELSE
+ s3cond = s3(1:i-1)
+ is3cond = i-1
+ s3 = s3(i+1:)
+ ENDIF
+ ENDIF
+
+ ENDDO
+!
+!-- Wenn Geltungsbereich erfuellt, dann Dateiverbindung abspeichern
+ IF ( found ) THEN
+
+ iout = iout + 1
+ IF ( iout < 10 ) THEN
+ WRITE (2,2003) iout, s1(1:is1), iout, s2c(1:is2c), &
+ iout, s3(1:is3), iout, s4(1:is4), &
+ iout, s5(1:is5), iout, s6(1:is6)
+ 2003 FORMAT ('localout[',I1,']="',A,'"; actionout[',I1,']="',A, &
+ '"; typeout[',I1,']="',A,'"'/'pathout[',I1,']="',A, &
+ '"; endout[',I1,']="',A,'"; extout[',I1,']="',A,'"')
+ ELSEIF ( iin < 100 ) THEN
+ WRITE (2,2004) iout, s1(1:is1), iout, s2c(1:is2c), &
+ iout, s3(1:is3), iout, s4(1:is4), &
+ iout, s5(1:is5), iout, s6(1:is6)
+ 2004 FORMAT ('localout[',I2,']="',A,'"; actionout[',I2,']="',A, &
+ '"; typeout[',I2,']="',A,'"'/'pathout[',I2,']="',A, &
+ '"; endout[',I2,']="',A,'"; extout[',I2,']="',A,'"')
+ ELSE
+ WRITE (2,2005) iout, s1(1:is1), iout, s2c(1:is2c), &
+ iout, s3(1:is3), iout, s4(1:is4), &
+ iout, s5(1:is5), iout, s6(1:is6)
+ 2005 FORMAT ('localout[',I3,']="',A,'"; actionout[',I3,']="',A, &
+ '"; typeout[',I3,']="',A,'"'/'pathout[',I3,']="',A, &
+ '"; endout[',I3,']="',A,'"; extout[',I3,']="',A,'"')
+ ENDIF
+ ENDIF
+
+ ELSEIF ( s2a(1:is2a) /= 'in' .AND. s2a(1:is2a) /= 'out' ) THEN
+!
+!-- Kein gueltiger Wert fuer I/O-Feld
+ WRITE (2,2010) bs, bs, config_file(1:il), bs, bs, s2a(1:is2a), &
+ bs, bs, bs, bs, bs, bs, bs
+ 2010 FORMAT ('printf "',A,'n',A,'n +++ I/O-field in configuration ', &
+ 'file ',A, ' has the illegal"'/ &
+ 'printf "',A,'n value ',A,'"',A,A,'". Only ', &
+ A,'"in',A,'" or ',A,'"out',A,'" are allowed!"' &
+ )
+ WRITE (2,'(''locat=connect; exit'')')
+ STOP
+ ENDIF
+
+ ENDIF
+
+ READ( 1, '(A)', IOSTAT=ios ) zeile
+
+ ENDDO
+
+!
+!-- Ausgabe der Anzahl von gefundenen Zeilen
+ IF ( iec > 0 ) WRITE (2,'(''(( iec = '',I3,'' ))'')') iec
+ IF ( iic > 0 ) WRITE (2,'(''(( iic = '',I3,'' ))'')') iic
+ IF ( ioc > 0 ) WRITE (2,'(''(( ioc = '',I3,'' ))'')') ioc
+ IF ( iin > 0 ) WRITE (2,'(''(( iin = '',I3,'' ))'')') iin
+ IF ( iout > 0 ) WRITE (2,'(''(( iout = '',I3,'' ))'')') iout
+
+ IF ( do_trace(1:4) == 'true' ) THEN
+ PRINT*,' '
+ PRINT*,'*** Inhalt von: ',config_file(1:il)
+ PRINT*,icomment,' Kommentarzeilen'
+ PRINT*,ienvvar,' Environment-Variablen-Vereinbarungen'
+ PRINT*,iec,' Error-Kommandos'
+ PRINT*,iic,' Input-Kommandos'
+ PRINT*,ioc,' Output-Kommandos'
+ PRINT*,idatver,' Dateiverbindungs-Anweisungen'
+ PRINT*,'Davon interpretiert:'
+ PRINT*,iin,' Eingabedateien'
+ PRINT*,iout,' Ausgabedateien'
+ ENDIF
+
+ END PROGRAM interpret_config
+
+
+
+ SUBROUTINE local_getenv( var, ivar, value, ivalue )
+
+ CHARACTER (LEN=*) :: var, value
+ INTEGER :: ivalue, ivar
+
+ CALL GETENV( var(1:ivar), value )
+ ivalue = LEN_TRIM( value )
+
+ END SUBROUTINE local_getenv
Index: /palm/tags/release-3.4a/UTIL/read_palm_netcdf_data.f90
===================================================================
--- /palm/tags/release-3.4a/UTIL/read_palm_netcdf_data.f90 (revision 141)
+++ /palm/tags/release-3.4a/UTIL/read_palm_netcdf_data.f90 (revision 141)
@@ -0,0 +1,198 @@
+ PROGRAM read_palm_netcdf_data
+
+!------------------------------------------------------------------------------!
+! This is an example program for reading PALM 2d/3d NetCDF datasets
+!
+! The user has to add his own code for further storing and analyzing of
+! these data!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! The NetCDF include file and library has to be given with the respective
+! compiler options. Please find out the respective paths on your system and
+! set them appropriately.
+!
+! Here are some examples how this routine should be compiled:
+!
+! decalpha:
+! f95 -fast -r8 -I/usr/local/netcdf-3.5.1/include
+! -L/usr/local/netcdf-3.5.1/lib -lnetcdf
+! IBM-Regatta:
+! xlf95 -qrealsize=8 -q64 -qmaxmem=-1 -Q
+! -I /aws/dataformats/netcdf-3.6.0-p1/64-32/include
+! -L/aws/dataformats/netcdf-3.6.0-p1/64-32/lib -lnetcdf -O3
+! IBM-Regatta KISTI:
+! xlf95 -qrealsize=8 -q64 -qmaxmem=-1 -Q
+! -I /applic/netcdf64/src/f90
+! -L/applic/lib/NETCDF64 -lnetcdf -O3
+! IBM-Regatta Yonsei (gfdl5):
+! xlf95 -qrealsize=8 -q64 -qmaxmem=-1 -Q
+! -I /usr1/users/raasch/pub/netcdf-3.6.0-p1/include
+! -L/usr1/users/raasch/pub/netcdf-3.6.0-p1/lib -lnetcdf -O3
+! IMUK:
+! ifort read_palm...f90 -o read_palm...x
+! -I /muksoft/packages/netcdf/linux/include -axW -r8 -nbs
+! -Vaxlib -L /muksoft/packages/netcdf/linux/lib -lnetcdf
+! NEC-SX6:
+! sxf90 read_palm...f90 -o read_palm...x
+! -I /pool/SX-6/netcdf/netcdf-3.6.0-p1/include -C hopt -Wf '-A idbl4'
+! -L/pool/SX-6/netcdf/netcdf-3.6.0-p1/lib -lnetcdf
+!------------------------------------------------------------------------------!
+
+ USE netcdf
+
+ IMPLICIT NONE
+
+!
+!-- Local variables
+ CHARACTER (LEN=10) :: dimname(4), var_name
+ CHARACTER (LEN=40) :: filename
+
+ CHARACTER (LEN=2000) :: title, var_list
+
+ INTEGER :: i, j, k, nc_stat, pos, time_step
+
+ INTEGER :: current_level, current_var, id_set, id_var_time, num_var
+
+ INTEGER, DIMENSION(4) :: id_dims, id_dims_loc, levels
+
+ INTEGER, DIMENSION(1000) :: id_var
+
+ REAL :: time(1)
+
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: data_array
+
+
+ PRINT*, '*** Please type NetCDF filename to be read:'
+ READ*, filename
+
+ nc_stat = NF90_OPEN( filename, NF90_WRITE, id_set )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 1 )
+
+!
+!-- Get the run description header and output
+ title = ' '
+ nc_stat = NF90_GET_ATT( id_set, NF90_GLOBAL, 'title', title )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 2 )
+ WRITE (*,'(/A/A)') '*** file created by:', TRIM( title )
+
+!
+!-- Get the list of variables (order of variables corresponds with the
+!-- order of data on the binary file)
+ var_list = ' ' ! GET_ATT does not assign trailing blanks
+ nc_stat = NF90_GET_ATT( id_set, NF90_GLOBAL, 'VAR_LIST', var_list )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 3 )
+
+!
+!-- Inquire id of the time coordinate variable
+ nc_stat = NF90_INQ_VARID( id_set, 'time', id_var_time )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 4 )
+
+!
+!-- Count number of variables; there is one more semicolon in the
+!-- string than variable names
+ num_var = -1
+ DO i = 1, LEN( var_list )
+ IF ( var_list(i:i) == ';' ) num_var = num_var + 1
+ ENDDO
+ WRITE (*,'(/A,I3,A/)') '*** file contains ', num_var, ' variable(s)'
+
+
+ pos = INDEX( var_list, ';' )
+!
+!-- Loop over all variables
+ DO i = 1, num_var
+
+!
+!-- Extract variable name from list
+ var_list = var_list(pos+1:)
+ pos = INDEX( var_list, ';' )
+ var_name = var_list(1:pos-1)
+
+!
+!-- Get variable ID from name
+ nc_stat = NF90_INQ_VARID( id_set, TRIM( var_name ), id_var(i) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 5 )
+
+!
+!-- Inquire the dimension IDs
+ nc_stat = NF90_INQUIRE_VARIABLE( id_set, id_var(i), &
+ dimids = id_dims_loc )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 6 )
+ id_dims = id_dims_loc
+
+!
+!-- Get number of x/y/z/time levels(gridpoints) for that variable
+ DO j = 1, 4
+ nc_stat = NF90_INQUIRE_DIMENSION( id_set, id_dims(j),&
+ dimname(j), levels(j) )
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 7 )
+ ENDDO
+
+ WRITE (*,100) '*** reading variable "', TRIM(var_name), &
+ '", dimensioned as', TRIM(var_name), levels(1)-1, &
+ levels(2)-1, levels(3)-1
+100 FORMAT (A,A,A/4X,A,'(0:',I4,',0:',I4,',0:',I4,') (x/y/z)'/)
+
+!
+!-- Allocate the data array to be read
+ ALLOCATE( data_array(0:levels(1)-1,0:levels(2)-1,0:levels(3)-1) )
+
+!
+!-- Read the data from file for each timestep
+ DO j = 1, levels(4)
+
+!
+!-- Get the time of the current timelevel and output
+ nc_stat = NF90_GET_VAR( id_set, id_var_time, time, start = (/ j /), &
+ count = (/ 1 /) )
+
+ IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 7+i )
+
+ WRITE (*,'(A,I3,A,F8.1,A)') ' reading timelevel ', i, &
+ ' time = ', time(1), ' s'
+
+ nc_stat = NF90_GET_VAR( id_set, id_var(i), &
+ data_array, start = (/ 1, 1, 1, j /), &
+ count = (/ levels(1), levels(2), levels(3), 1 /) )
+
+ IF ( nc_stat /= NF90_NOERR ) &
+ CALL handle_netcdf_error( 7+levels(4)+i )
+!
+!-- ADD YOUR OWN CODE FOR FURTHER STORING OF THESE DATA HERE
+!-- --------------------------------------------------------
+
+
+ ENDDO
+
+ WRITE (*,'(/)')
+
+ DEALLOCATE( data_array )
+
+ ENDDO
+
+
+
+ CONTAINS
+
+
+ SUBROUTINE handle_netcdf_error( errno )
+!
+!-- Prints out a text message corresponding to the current NetCDF status
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: errno
+
+ IF ( nc_stat /= NF90_NOERR ) THEN
+ WRITE (*,'(A,1X,I3/4X,A)') &
+ '+++ read_palm_netcdf_data error handle:', &
+ errno, TRIM( nf90_strerror( nc_stat ) )
+ STOP
+ ENDIF
+
+ END SUBROUTINE handle_netcdf_error
+
+
+ END PROGRAM read_palm_netcdf_data
+
+
+