Revert "Merge branch 'master' of gitorious.psi.ch:nemu/simulation"
This reverts commit0ba118ea02, reversing changes made to5acc941a31.
This commit is contained in:
nemu
@ -1,339 +0,0 @@
|
|||||||
GNU GENERAL PUBLIC LICENSE
|
|
||||||
Version 2, June 1991
|
|
||||||
|
|
||||||
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
|
|
||||||
675 Mass Ave, Cambridge, MA 02139, USA
|
|
||||||
Everyone is permitted to copy and distribute verbatim copies
|
|
||||||
of this license document, but changing it is not allowed.
|
|
||||||
|
|
||||||
Preamble
|
|
||||||
|
|
||||||
The licenses for most software are designed to take away your
|
|
||||||
freedom to share and change it. By contrast, the GNU General Public
|
|
||||||
License is intended to guarantee your freedom to share and change free
|
|
||||||
software--to make sure the software is free for all its users. This
|
|
||||||
General Public License applies to most of the Free Software
|
|
||||||
Foundation's software and to any other program whose authors commit to
|
|
||||||
using it. (Some other Free Software Foundation software is covered by
|
|
||||||
the GNU Library General Public License instead.) You can apply it to
|
|
||||||
your programs, too.
|
|
||||||
|
|
||||||
When we speak of free software, we are referring to freedom, not
|
|
||||||
price. Our General Public Licenses are designed to make sure that you
|
|
||||||
have the freedom to distribute copies of free software (and charge for
|
|
||||||
this service if you wish), that you receive source code or can get it
|
|
||||||
if you want it, that you can change the software or use pieces of it
|
|
||||||
in new free programs; and that you know you can do these things.
|
|
||||||
|
|
||||||
To protect your rights, we need to make restrictions that forbid
|
|
||||||
anyone to deny you these rights or to ask you to surrender the rights.
|
|
||||||
These restrictions translate to certain responsibilities for you if you
|
|
||||||
distribute copies of the software, or if you modify it.
|
|
||||||
|
|
||||||
For example, if you distribute copies of such a program, whether
|
|
||||||
gratis or for a fee, you must give the recipients all the rights that
|
|
||||||
you have. You must make sure that they, too, receive or can get the
|
|
||||||
source code. And you must show them these terms so they know their
|
|
||||||
rights.
|
|
||||||
|
|
||||||
We protect your rights with two steps: (1) copyright the software, and
|
|
||||||
(2) offer you this license which gives you legal permission to copy,
|
|
||||||
distribute and/or modify the software.
|
|
||||||
|
|
||||||
Also, for each author's protection and ours, we want to make certain
|
|
||||||
that everyone understands that there is no warranty for this free
|
|
||||||
software. If the software is modified by someone else and passed on, we
|
|
||||||
want its recipients to know that what they have is not the original, so
|
|
||||||
that any problems introduced by others will not reflect on the original
|
|
||||||
authors' reputations.
|
|
||||||
|
|
||||||
Finally, any free program is threatened constantly by software
|
|
||||||
patents. We wish to avoid the danger that redistributors of a free
|
|
||||||
program will individually obtain patent licenses, in effect making the
|
|
||||||
program proprietary. To prevent this, we have made it clear that any
|
|
||||||
patent must be licensed for everyone's free use or not licensed at all.
|
|
||||||
|
|
||||||
The precise terms and conditions for copying, distribution and
|
|
||||||
modification follow.
|
|
||||||
|
|
||||||
GNU GENERAL PUBLIC LICENSE
|
|
||||||
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
|
|
||||||
|
|
||||||
0. This License applies to any program or other work which contains
|
|
||||||
a notice placed by the copyright holder saying it may be distributed
|
|
||||||
under the terms of this General Public License. The "Program", below,
|
|
||||||
refers to any such program or work, and a "work based on the Program"
|
|
||||||
means either the Program or any derivative work under copyright law:
|
|
||||||
that is to say, a work containing the Program or a portion of it,
|
|
||||||
either verbatim or with modifications and/or translated into another
|
|
||||||
language. (Hereinafter, translation is included without limitation in
|
|
||||||
the term "modification".) Each licensee is addressed as "you".
|
|
||||||
|
|
||||||
Activities other than copying, distribution and modification are not
|
|
||||||
covered by this License; they are outside its scope. The act of
|
|
||||||
running the Program is not restricted, and the output from the Program
|
|
||||||
is covered only if its contents constitute a work based on the
|
|
||||||
Program (independent of having been made by running the Program).
|
|
||||||
Whether that is true depends on what the Program does.
|
|
||||||
|
|
||||||
1. You may copy and distribute verbatim copies of the Program's
|
|
||||||
source code as you receive it, in any medium, provided that you
|
|
||||||
conspicuously and appropriately publish on each copy an appropriate
|
|
||||||
copyright notice and disclaimer of warranty; keep intact all the
|
|
||||||
notices that refer to this License and to the absence of any warranty;
|
|
||||||
and give any other recipients of the Program a copy of this License
|
|
||||||
along with the Program.
|
|
||||||
|
|
||||||
You may charge a fee for the physical act of transferring a copy, and
|
|
||||||
you may at your option offer warranty protection in exchange for a fee.
|
|
||||||
|
|
||||||
2. You may modify your copy or copies of the Program or any portion
|
|
||||||
of it, thus forming a work based on the Program, and copy and
|
|
||||||
distribute such modifications or work under the terms of Section 1
|
|
||||||
above, provided that you also meet all of these conditions:
|
|
||||||
|
|
||||||
a) You must cause the modified files to carry prominent notices
|
|
||||||
stating that you changed the files and the date of any change.
|
|
||||||
|
|
||||||
b) You must cause any work that you distribute or publish, that in
|
|
||||||
whole or in part contains or is derived from the Program or any
|
|
||||||
part thereof, to be licensed as a whole at no charge to all third
|
|
||||||
parties under the terms of this License.
|
|
||||||
|
|
||||||
c) If the modified program normally reads commands interactively
|
|
||||||
when run, you must cause it, when started running for such
|
|
||||||
interactive use in the most ordinary way, to print or display an
|
|
||||||
announcement including an appropriate copyright notice and a
|
|
||||||
notice that there is no warranty (or else, saying that you provide
|
|
||||||
a warranty) and that users may redistribute the program under
|
|
||||||
these conditions, and telling the user how to view a copy of this
|
|
||||||
License. (Exception: if the Program itself is interactive but
|
|
||||||
does not normally print such an announcement, your work based on
|
|
||||||
the Program is not required to print an announcement.)
|
|
||||||
|
|
||||||
These requirements apply to the modified work as a whole. If
|
|
||||||
identifiable sections of that work are not derived from the Program,
|
|
||||||
and can be reasonably considered independent and separate works in
|
|
||||||
themselves, then this License, and its terms, do not apply to those
|
|
||||||
sections when you distribute them as separate works. But when you
|
|
||||||
distribute the same sections as part of a whole which is a work based
|
|
||||||
on the Program, the distribution of the whole must be on the terms of
|
|
||||||
this License, whose permissions for other licensees extend to the
|
|
||||||
entire whole, and thus to each and every part regardless of who wrote it.
|
|
||||||
|
|
||||||
Thus, it is not the intent of this section to claim rights or contest
|
|
||||||
your rights to work written entirely by you; rather, the intent is to
|
|
||||||
exercise the right to control the distribution of derivative or
|
|
||||||
collective works based on the Program.
|
|
||||||
|
|
||||||
In addition, mere aggregation of another work not based on the Program
|
|
||||||
with the Program (or with a work based on the Program) on a volume of
|
|
||||||
a storage or distribution medium does not bring the other work under
|
|
||||||
the scope of this License.
|
|
||||||
|
|
||||||
3. You may copy and distribute the Program (or a work based on it,
|
|
||||||
under Section 2) in object code or executable form under the terms of
|
|
||||||
Sections 1 and 2 above provided that you also do one of the following:
|
|
||||||
|
|
||||||
a) Accompany it with the complete corresponding machine-readable
|
|
||||||
source code, which must be distributed under the terms of Sections
|
|
||||||
1 and 2 above on a medium customarily used for software interchange; or,
|
|
||||||
|
|
||||||
b) Accompany it with a written offer, valid for at least three
|
|
||||||
years, to give any third party, for a charge no more than your
|
|
||||||
cost of physically performing source distribution, a complete
|
|
||||||
machine-readable copy of the corresponding source code, to be
|
|
||||||
distributed under the terms of Sections 1 and 2 above on a medium
|
|
||||||
customarily used for software interchange; or,
|
|
||||||
|
|
||||||
c) Accompany it with the information you received as to the offer
|
|
||||||
to distribute corresponding source code. (This alternative is
|
|
||||||
allowed only for noncommercial distribution and only if you
|
|
||||||
received the program in object code or executable form with such
|
|
||||||
an offer, in accord with Subsection b above.)
|
|
||||||
|
|
||||||
The source code for a work means the preferred form of the work for
|
|
||||||
making modifications to it. For an executable work, complete source
|
|
||||||
code means all the source code for all modules it contains, plus any
|
|
||||||
associated interface definition files, plus the scripts used to
|
|
||||||
control compilation and installation of the executable. However, as a
|
|
||||||
special exception, the source code distributed need not include
|
|
||||||
anything that is normally distributed (in either source or binary
|
|
||||||
form) with the major components (compiler, kernel, and so on) of the
|
|
||||||
operating system on which the executable runs, unless that component
|
|
||||||
itself accompanies the executable.
|
|
||||||
|
|
||||||
If distribution of executable or object code is made by offering
|
|
||||||
access to copy from a designated place, then offering equivalent
|
|
||||||
access to copy the source code from the same place counts as
|
|
||||||
distribution of the source code, even though third parties are not
|
|
||||||
compelled to copy the source along with the object code.
|
|
||||||
|
|
||||||
4. You may not copy, modify, sublicense, or distribute the Program
|
|
||||||
except as expressly provided under this License. Any attempt
|
|
||||||
otherwise to copy, modify, sublicense or distribute the Program is
|
|
||||||
void, and will automatically terminate your rights under this License.
|
|
||||||
However, parties who have received copies, or rights, from you under
|
|
||||||
this License will not have their licenses terminated so long as such
|
|
||||||
parties remain in full compliance.
|
|
||||||
|
|
||||||
5. You are not required to accept this License, since you have not
|
|
||||||
signed it. However, nothing else grants you permission to modify or
|
|
||||||
distribute the Program or its derivative works. These actions are
|
|
||||||
prohibited by law if you do not accept this License. Therefore, by
|
|
||||||
modifying or distributing the Program (or any work based on the
|
|
||||||
Program), you indicate your acceptance of this License to do so, and
|
|
||||||
all its terms and conditions for copying, distributing or modifying
|
|
||||||
the Program or works based on it.
|
|
||||||
|
|
||||||
6. Each time you redistribute the Program (or any work based on the
|
|
||||||
Program), the recipient automatically receives a license from the
|
|
||||||
original licensor to copy, distribute or modify the Program subject to
|
|
||||||
these terms and conditions. You may not impose any further
|
|
||||||
restrictions on the recipients' exercise of the rights granted herein.
|
|
||||||
You are not responsible for enforcing compliance by third parties to
|
|
||||||
this License.
|
|
||||||
|
|
||||||
7. If, as a consequence of a court judgment or allegation of patent
|
|
||||||
infringement or for any other reason (not limited to patent issues),
|
|
||||||
conditions are imposed on you (whether by court order, agreement or
|
|
||||||
otherwise) that contradict the conditions of this License, they do not
|
|
||||||
excuse you from the conditions of this License. If you cannot
|
|
||||||
distribute so as to satisfy simultaneously your obligations under this
|
|
||||||
License and any other pertinent obligations, then as a consequence you
|
|
||||||
may not distribute the Program at all. For example, if a patent
|
|
||||||
license would not permit royalty-free redistribution of the Program by
|
|
||||||
all those who receive copies directly or indirectly through you, then
|
|
||||||
the only way you could satisfy both it and this License would be to
|
|
||||||
refrain entirely from distribution of the Program.
|
|
||||||
|
|
||||||
If any portion of this section is held invalid or unenforceable under
|
|
||||||
any particular circumstance, the balance of the section is intended to
|
|
||||||
apply and the section as a whole is intended to apply in other
|
|
||||||
circumstances.
|
|
||||||
|
|
||||||
It is not the purpose of this section to induce you to infringe any
|
|
||||||
patents or other property right claims or to contest validity of any
|
|
||||||
such claims; this section has the sole purpose of protecting the
|
|
||||||
integrity of the free software distribution system, which is
|
|
||||||
implemented by public license practices. Many people have made
|
|
||||||
generous contributions to the wide range of software distributed
|
|
||||||
through that system in reliance on consistent application of that
|
|
||||||
system; it is up to the author/donor to decide if he or she is willing
|
|
||||||
to distribute software through any other system and a licensee cannot
|
|
||||||
impose that choice.
|
|
||||||
|
|
||||||
This section is intended to make thoroughly clear what is believed to
|
|
||||||
be a consequence of the rest of this License.
|
|
||||||
|
|
||||||
8. If the distribution and/or use of the Program is restricted in
|
|
||||||
certain countries either by patents or by copyrighted interfaces, the
|
|
||||||
original copyright holder who places the Program under this License
|
|
||||||
may add an explicit geographical distribution limitation excluding
|
|
||||||
those countries, so that distribution is permitted only in or among
|
|
||||||
countries not thus excluded. In such case, this License incorporates
|
|
||||||
the limitation as if written in the body of this License.
|
|
||||||
|
|
||||||
9. The Free Software Foundation may publish revised and/or new versions
|
|
||||||
of the General Public License from time to time. Such new versions will
|
|
||||||
be similar in spirit to the present version, but may differ in detail to
|
|
||||||
address new problems or concerns.
|
|
||||||
|
|
||||||
Each version is given a distinguishing version number. If the Program
|
|
||||||
specifies a version number of this License which applies to it and "any
|
|
||||||
later version", you have the option of following the terms and conditions
|
|
||||||
either of that version or of any later version published by the Free
|
|
||||||
Software Foundation. If the Program does not specify a version number of
|
|
||||||
this License, you may choose any version ever published by the Free Software
|
|
||||||
Foundation.
|
|
||||||
|
|
||||||
10. If you wish to incorporate parts of the Program into other free
|
|
||||||
programs whose distribution conditions are different, write to the author
|
|
||||||
to ask for permission. For software which is copyrighted by the Free
|
|
||||||
Software Foundation, write to the Free Software Foundation; we sometimes
|
|
||||||
make exceptions for this. Our decision will be guided by the two goals
|
|
||||||
of preserving the free status of all derivatives of our free software and
|
|
||||||
of promoting the sharing and reuse of software generally.
|
|
||||||
|
|
||||||
NO WARRANTY
|
|
||||||
|
|
||||||
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
|
|
||||||
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
|
|
||||||
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
|
|
||||||
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
|
|
||||||
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
|
|
||||||
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
|
|
||||||
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
|
|
||||||
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
|
|
||||||
REPAIR OR CORRECTION.
|
|
||||||
|
|
||||||
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
|
|
||||||
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
|
|
||||||
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
|
|
||||||
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
|
|
||||||
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
|
|
||||||
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
|
|
||||||
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
|
|
||||||
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
|
|
||||||
POSSIBILITY OF SUCH DAMAGES.
|
|
||||||
|
|
||||||
END OF TERMS AND CONDITIONS
|
|
||||||
|
|
||||||
Appendix: How to Apply These Terms to Your New Programs
|
|
||||||
|
|
||||||
If you develop a new program, and you want it to be of the greatest
|
|
||||||
possible use to the public, the best way to achieve this is to make it
|
|
||||||
free software which everyone can redistribute and change under these terms.
|
|
||||||
|
|
||||||
To do so, attach the following notices to the program. It is safest
|
|
||||||
to attach them to the start of each source file to most effectively
|
|
||||||
convey the exclusion of warranty; and each file should have at least
|
|
||||||
the "copyright" line and a pointer to where the full notice is found.
|
|
||||||
|
|
||||||
<one line to give the program's name and a brief idea of what it does.>
|
|
||||||
Copyright (C) 19yy <name of author>
|
|
||||||
|
|
||||||
This program is free software; you can redistribute it and/or modify
|
|
||||||
it under the terms of the GNU General Public License as published by
|
|
||||||
the Free Software Foundation; either version 2 of the License, or
|
|
||||||
(at your option) any later version.
|
|
||||||
|
|
||||||
This program is distributed in the hope that it will be useful,
|
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
||||||
GNU General Public License for more details.
|
|
||||||
|
|
||||||
You should have received a copy of the GNU General Public License
|
|
||||||
along with this program; if not, write to the Free Software
|
|
||||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
||||||
|
|
||||||
Also add information on how to contact you by electronic and paper mail.
|
|
||||||
|
|
||||||
If the program is interactive, make it output a short notice like this
|
|
||||||
when it starts in an interactive mode:
|
|
||||||
|
|
||||||
Gnomovision version 69, Copyright (C) 19yy name of author
|
|
||||||
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
|
|
||||||
This is free software, and you are welcome to redistribute it
|
|
||||||
under certain conditions; type `show c' for details.
|
|
||||||
|
|
||||||
The hypothetical commands `show w' and `show c' should show the appropriate
|
|
||||||
parts of the General Public License. Of course, the commands you use may
|
|
||||||
be called something other than `show w' and `show c'; they could even be
|
|
||||||
mouse-clicks or menu items--whatever suits your program.
|
|
||||||
|
|
||||||
You should also get your employer (if you work as a programmer) or your
|
|
||||||
school, if any, to sign a "copyright disclaimer" for the program, if
|
|
||||||
necessary. Here is a sample; alter the names:
|
|
||||||
|
|
||||||
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
|
|
||||||
`Gnomovision' (which makes passes at compilers) written by James Hacker.
|
|
||||||
|
|
||||||
<signature of Ty Coon>, 1 April 1989
|
|
||||||
Ty Coon, President of Vice
|
|
||||||
|
|
||||||
This General Public License does not permit incorporating your program into
|
|
||||||
proprietary programs. If your program is a subroutine library, you may
|
|
||||||
consider it more useful to permit linking proprietary applications with the
|
|
||||||
library. If this is what you want to do, use the GNU Library General
|
|
||||||
Public License instead of this License.
|
|
||||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -1,120 +0,0 @@
|
|||||||
# Microsoft Developer Studio Project File - Name="dipole field calculation" - Package Owner=<4>
|
|
||||||
# Microsoft Developer Studio Generated Build File, Format Version 6.00
|
|
||||||
# ** DO NOT EDIT **
|
|
||||||
|
|
||||||
# TARGTYPE "Win32 (x86) Console Application" 0x0103
|
|
||||||
|
|
||||||
CFG=dipole field calculation - Win32 Debug
|
|
||||||
!MESSAGE This is not a valid makefile. To build this project using NMAKE,
|
|
||||||
!MESSAGE use the Export Makefile command and run
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE NMAKE /f "dipole field calculation.mak".
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE You can specify a configuration when running NMAKE
|
|
||||||
!MESSAGE by defining the macro CFG on the command line. For example:
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE NMAKE /f "dipole field calculation.mak" CFG="dipole field calculation - Win32 Debug"
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE Possible choices for configuration are:
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE "dipole field calculation - Win32 Release" (based on "Win32 (x86) Console Application")
|
|
||||||
!MESSAGE "dipole field calculation - Win32 Debug" (based on "Win32 (x86) Console Application")
|
|
||||||
!MESSAGE
|
|
||||||
|
|
||||||
# Begin Project
|
|
||||||
# PROP AllowPerConfigDependencies 0
|
|
||||||
# PROP Scc_ProjName ""
|
|
||||||
# PROP Scc_LocalPath ""
|
|
||||||
CPP=cl.exe
|
|
||||||
F90=df.exe
|
|
||||||
RSC=rc.exe
|
|
||||||
|
|
||||||
!IF "$(CFG)" == "dipole field calculation - Win32 Release"
|
|
||||||
|
|
||||||
# PROP BASE Use_MFC 0
|
|
||||||
# PROP BASE Use_Debug_Libraries 0
|
|
||||||
# PROP BASE Output_Dir "Release"
|
|
||||||
# PROP BASE Intermediate_Dir "Release"
|
|
||||||
# PROP BASE Target_Dir ""
|
|
||||||
# PROP Use_MFC 0
|
|
||||||
# PROP Use_Debug_Libraries 0
|
|
||||||
# PROP Output_Dir "Release"
|
|
||||||
# PROP Intermediate_Dir "Release"
|
|
||||||
# PROP Ignore_Export_Lib 0
|
|
||||||
# PROP Target_Dir ""
|
|
||||||
# ADD BASE F90 /compile_only /nologo /warn:nofileopt
|
|
||||||
# ADD F90 /compile_only /nologo /warn:nofileopt
|
|
||||||
# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
|
|
||||||
# ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
|
|
||||||
# ADD BASE RSC /l 0x409 /d "NDEBUG"
|
|
||||||
# ADD RSC /l 0x409 /d "NDEBUG"
|
|
||||||
BSC32=bscmake.exe
|
|
||||||
# ADD BASE BSC32 /nologo
|
|
||||||
# ADD BSC32 /nologo
|
|
||||||
LINK32=link.exe
|
|
||||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
|
||||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /machine:I386 /out:"Release/dipole.exe"
|
|
||||||
|
|
||||||
!ELSEIF "$(CFG)" == "dipole field calculation - Win32 Debug"
|
|
||||||
|
|
||||||
# PROP BASE Use_MFC 0
|
|
||||||
# PROP BASE Use_Debug_Libraries 1
|
|
||||||
# PROP BASE Output_Dir "Debug"
|
|
||||||
# PROP BASE Intermediate_Dir "Debug"
|
|
||||||
# PROP BASE Target_Dir ""
|
|
||||||
# PROP Use_MFC 0
|
|
||||||
# PROP Use_Debug_Libraries 1
|
|
||||||
# PROP Output_Dir "Debug"
|
|
||||||
# PROP Intermediate_Dir "Debug"
|
|
||||||
# PROP Ignore_Export_Lib 0
|
|
||||||
# PROP Target_Dir ""
|
|
||||||
# ADD BASE F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
|
|
||||||
# ADD F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
|
|
||||||
# ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
|
|
||||||
# ADD CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
|
|
||||||
# ADD BASE RSC /l 0x409 /d "_DEBUG"
|
|
||||||
# ADD RSC /l 0x409 /d "_DEBUG"
|
|
||||||
BSC32=bscmake.exe
|
|
||||||
# ADD BASE BSC32 /nologo
|
|
||||||
# ADD BSC32 /nologo
|
|
||||||
LINK32=link.exe
|
|
||||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
|
|
||||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /incremental:no /debug /machine:I386 /out:"Debug/dipole.exe" /pdbtype:sept
|
|
||||||
|
|
||||||
!ENDIF
|
|
||||||
|
|
||||||
# Begin Target
|
|
||||||
|
|
||||||
# Name "dipole field calculation - Win32 Release"
|
|
||||||
# Name "dipole field calculation - Win32 Debug"
|
|
||||||
# Begin Group "Source Files"
|
|
||||||
|
|
||||||
# PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat;f90;for;f;fpp"
|
|
||||||
# Begin Source File
|
|
||||||
|
|
||||||
SOURCE=..\thinfilm\field_calculation.f90
|
|
||||||
|
|
||||||
!IF "$(CFG)" == "dipole field calculation - Win32 Release"
|
|
||||||
|
|
||||||
# PROP Exclude_From_Build 1
|
|
||||||
|
|
||||||
!ELSEIF "$(CFG)" == "dipole field calculation - Win32 Debug"
|
|
||||||
|
|
||||||
!ENDIF
|
|
||||||
|
|
||||||
# End Source File
|
|
||||||
# Begin Source File
|
|
||||||
|
|
||||||
SOURCE=..\thinfilm\field_calculation_GaAs.f90
|
|
||||||
# End Source File
|
|
||||||
# End Group
|
|
||||||
# Begin Group "Header Files"
|
|
||||||
|
|
||||||
# PROP Default_Filter "h;hpp;hxx;hm;inl;fi;fd"
|
|
||||||
# End Group
|
|
||||||
# Begin Group "Resource Files"
|
|
||||||
|
|
||||||
# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
|
|
||||||
# End Group
|
|
||||||
# End Target
|
|
||||||
# End Project
|
|
||||||
@ -1,19 +0,0 @@
|
|||||||
<html>
|
|
||||||
<body>
|
|
||||||
<pre>
|
|
||||||
<h1>Build Log</h1>
|
|
||||||
<h3>
|
|
||||||
--------------------Configuration: dipole field calculation - Win32 Release--------------------
|
|
||||||
</h3>
|
|
||||||
<h3>Command Lines</h3>
|
|
||||||
Creating command line "link.exe kernel32.lib /nologo /subsystem:console /incremental:no /pdb:"Release/dipole.pdb" /machine:I386 /out:"Release/dipole.exe" ".\Release\field_calculation_GaAs.obj" "
|
|
||||||
<h3>Output Window</h3>
|
|
||||||
Linking...
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
<h3>Results</h3>
|
|
||||||
dipole.exe - 0 error(s), 0 warning(s)
|
|
||||||
</pre>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -1,105 +0,0 @@
|
|||||||
# Microsoft Developer Studio Project File - Name="dynamics" - Package Owner=<4>
|
|
||||||
# Microsoft Developer Studio Generated Build File, Format Version 6.00
|
|
||||||
# ** DO NOT EDIT **
|
|
||||||
|
|
||||||
# TARGTYPE "Win32 (x86) Console Application" 0x0103
|
|
||||||
|
|
||||||
CFG=dynamics - Win32 Debug
|
|
||||||
!MESSAGE This is not a valid makefile. To build this project using NMAKE,
|
|
||||||
!MESSAGE use the Export Makefile command and run
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE NMAKE /f "dynamics.mak".
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE You can specify a configuration when running NMAKE
|
|
||||||
!MESSAGE by defining the macro CFG on the command line. For example:
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE NMAKE /f "dynamics.mak" CFG="dynamics - Win32 Debug"
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE Possible choices for configuration are:
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE "dynamics - Win32 Release" (based on "Win32 (x86) Console Application")
|
|
||||||
!MESSAGE "dynamics - Win32 Debug" (based on "Win32 (x86) Console Application")
|
|
||||||
!MESSAGE
|
|
||||||
|
|
||||||
# Begin Project
|
|
||||||
# PROP AllowPerConfigDependencies 0
|
|
||||||
# PROP Scc_ProjName ""
|
|
||||||
# PROP Scc_LocalPath ""
|
|
||||||
CPP=cl.exe
|
|
||||||
F90=df.exe
|
|
||||||
RSC=rc.exe
|
|
||||||
|
|
||||||
!IF "$(CFG)" == "dynamics - Win32 Release"
|
|
||||||
|
|
||||||
# PROP BASE Use_MFC 0
|
|
||||||
# PROP BASE Use_Debug_Libraries 0
|
|
||||||
# PROP BASE Output_Dir "Release"
|
|
||||||
# PROP BASE Intermediate_Dir "Release"
|
|
||||||
# PROP BASE Target_Dir ""
|
|
||||||
# PROP Use_MFC 0
|
|
||||||
# PROP Use_Debug_Libraries 0
|
|
||||||
# PROP Output_Dir "Release"
|
|
||||||
# PROP Intermediate_Dir "Release"
|
|
||||||
# PROP Target_Dir ""
|
|
||||||
# ADD BASE F90 /compile_only /nologo /warn:nofileopt
|
|
||||||
# ADD F90 /compile_only /nologo /warn:nofileopt
|
|
||||||
# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
|
|
||||||
# ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
|
|
||||||
# ADD BASE RSC /l 0x409 /d "NDEBUG"
|
|
||||||
# ADD RSC /l 0x409 /d "NDEBUG"
|
|
||||||
BSC32=bscmake.exe
|
|
||||||
# ADD BASE BSC32 /nologo
|
|
||||||
# ADD BSC32 /nologo
|
|
||||||
LINK32=link.exe
|
|
||||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
|
||||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
|
||||||
|
|
||||||
!ELSEIF "$(CFG)" == "dynamics - Win32 Debug"
|
|
||||||
|
|
||||||
# PROP BASE Use_MFC 0
|
|
||||||
# PROP BASE Use_Debug_Libraries 1
|
|
||||||
# PROP BASE Output_Dir "Debug"
|
|
||||||
# PROP BASE Intermediate_Dir "Debug"
|
|
||||||
# PROP BASE Target_Dir ""
|
|
||||||
# PROP Use_MFC 0
|
|
||||||
# PROP Use_Debug_Libraries 1
|
|
||||||
# PROP Output_Dir "Debug"
|
|
||||||
# PROP Intermediate_Dir "Debug"
|
|
||||||
# PROP Target_Dir ""
|
|
||||||
# ADD BASE F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
|
|
||||||
# ADD F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
|
|
||||||
# ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
|
|
||||||
# ADD CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
|
|
||||||
# ADD BASE RSC /l 0x409 /d "_DEBUG"
|
|
||||||
# ADD RSC /l 0x409 /d "_DEBUG"
|
|
||||||
BSC32=bscmake.exe
|
|
||||||
# ADD BASE BSC32 /nologo
|
|
||||||
# ADD BSC32 /nologo
|
|
||||||
LINK32=link.exe
|
|
||||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
|
|
||||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /incremental:no /debug /machine:I386 /pdbtype:sept
|
|
||||||
|
|
||||||
!ENDIF
|
|
||||||
|
|
||||||
# Begin Target
|
|
||||||
|
|
||||||
# Name "dynamics - Win32 Release"
|
|
||||||
# Name "dynamics - Win32 Debug"
|
|
||||||
# Begin Group "Source Files"
|
|
||||||
|
|
||||||
# PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat;f90;for;f;fpp"
|
|
||||||
# Begin Source File
|
|
||||||
|
|
||||||
SOURCE=N:\simulations\dynamics.f90
|
|
||||||
# End Source File
|
|
||||||
# End Group
|
|
||||||
# Begin Group "Header Files"
|
|
||||||
|
|
||||||
# PROP Default_Filter "h;hpp;hxx;hm;inl;fi;fd"
|
|
||||||
# End Group
|
|
||||||
# Begin Group "Resource Files"
|
|
||||||
|
|
||||||
# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
|
|
||||||
# End Group
|
|
||||||
# End Target
|
|
||||||
# End Project
|
|
||||||
@ -1,783 +0,0 @@
|
|||||||
! dynamics.f90
|
|
||||||
!
|
|
||||||
!
|
|
||||||
!****************************************************************************
|
|
||||||
!
|
|
||||||
! PROGRAM: dynamics
|
|
||||||
!
|
|
||||||
! PURPOSE: Simulation of the asymmetry of an artificial spinglass.
|
|
||||||
! DYNAMICS assumes the spinglass to have an FCC lattice.
|
|
||||||
! The dimensions of the lattice are w * w * d, along the
|
|
||||||
! x-, y- and z-axis respectively. The magnetic moments
|
|
||||||
! are randomly distributed over the latticepoints, the muons
|
|
||||||
! are placed on the centers of the FCC-cube.
|
|
||||||
! The directions of the magnetic moments is choosen randomly
|
|
||||||
! over the whole sphere.
|
|
||||||
! The program calculates the magnetic field at the site of
|
|
||||||
! muon by adding all dilopar contributions from about 300
|
|
||||||
! magnetic moments which nearest by the muonsite. Periodic
|
|
||||||
! boundary conditions are applied in the x- and y-direction.
|
|
||||||
! The z-direction is assumed to perpendicular to a thin
|
|
||||||
! film surface.
|
|
||||||
! The dynamics of the magnetic spins is included in one of
|
|
||||||
! the following ways:
|
|
||||||
! For fluctuationrates larger then 100 MHz,
|
|
||||||
! a timestep tau is choosen from a
|
|
||||||
! log distrubution ( tau = - ln(random) / fluctuationrate )
|
|
||||||
! The muon then rotates for tau microseconds, after all spins
|
|
||||||
! are rotated over an angle between - dtetha en dtheta and - dphi and dphi.
|
|
||||||
! This process is repeated until the total time is 10 microsecods or more.
|
|
||||||
! Output of the muon position is done about every time_resolution microsecond.
|
|
||||||
! For fluctuationrates smaller then 100 MHz
|
|
||||||
! the muons rotate 1000 times for time_resolution microsecond, after each rotation
|
|
||||||
! a fraction (= fluctuationrate / 100) of the magnetic ions are rotated
|
|
||||||
! over an angle between - dtetha en dtheta and - dphi and dphi.
|
|
||||||
! After each fluctuation the fields at the muonsites are recalculated.
|
|
||||||
! "deporization" functions are calculated for
|
|
||||||
! left-right, up-down and forward-backward detectors,
|
|
||||||
! being the x-, y- and z-components of the muon spin vector.
|
|
||||||
! For arbitrary direction one has to take the scalar product of
|
|
||||||
! that specific direction with the results produced by this program
|
|
||||||
!
|
|
||||||
! USE: The parameters used for the simulation are supposed to be on
|
|
||||||
! file with the generic name <calculation>.inp.
|
|
||||||
! The program can be started in two ways:
|
|
||||||
!
|
|
||||||
! typing DYNAMICS
|
|
||||||
! the user will be prompted for the name of the calculation
|
|
||||||
!
|
|
||||||
! typing DYNAMICS <calculation>
|
|
||||||
! the name of the calculation will be read from the commandline.
|
|
||||||
!
|
|
||||||
! Output will be written on <calculation>.out and on separate files
|
|
||||||
! (for each set of parameters) named <calculation>_###.g_t, where
|
|
||||||
! ### can a unique number according to the following rules:
|
|
||||||
! If a file \simulations\counter.his can be opened, the program will
|
|
||||||
! the number in this file and uses that as a start for numbering
|
|
||||||
! the *.g_t files. The program will update \simulations\counter.his.
|
|
||||||
! If that file is not present, the program will start at number 1.
|
|
||||||
!
|
|
||||||
! INPUT: For each simulation the following set of parameters has to be
|
|
||||||
! given on one line in the file <calculation>.inp
|
|
||||||
!
|
|
||||||
! lattice parameter [nm]
|
|
||||||
! magnetic moment [Bohr-magneton]
|
|
||||||
! external field, three component [tesla]
|
|
||||||
! thickness d [nm]
|
|
||||||
! width w [nm]
|
|
||||||
! concentration [at.%]
|
|
||||||
! number of muons #
|
|
||||||
! initial muon spin direction in
|
|
||||||
! spherical coordinates, theta, phi [degree]
|
|
||||||
! note that the z-axis is perpendicular to the film
|
|
||||||
! muon stopping range, from d1 to d2 [nm]
|
|
||||||
! d1 and d2 are note restricted by 0 and d, stopping outside
|
|
||||||
! the actual sample is possible
|
|
||||||
! fluctuationrate [ 1/ microsecond ]
|
|
||||||
! fluctuation amplitude, in
|
|
||||||
! spherical coordinates, d-theta, d-phi [degree]
|
|
||||||
!
|
|
||||||
! Lines with parameters can be interlaced with comments,
|
|
||||||
! Commentlines should have a ! at position 1.
|
|
||||||
!
|
|
||||||
!
|
|
||||||
!
|
|
||||||
!****************************************************************************
|
|
||||||
|
|
||||||
program dynamics
|
|
||||||
|
|
||||||
Use DFPORT
|
|
||||||
Use DFLIB
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Variables
|
|
||||||
|
|
||||||
integer*4,parameter::max_spins = 50000, & ! maximum number of magnetic moments
|
|
||||||
& max_muons = 10000, & ! maximum number of muons
|
|
||||||
& max_nn = 500, & ! maximum number of nearest neighbours
|
|
||||||
& n_time_steps = 500 ! number of time steps calculated
|
|
||||||
! Should be future variable
|
|
||||||
! Should be future variable
|
|
||||||
|
|
||||||
|
|
||||||
! Structure to store the position (as lattice site-indexes)
|
|
||||||
! and the direction-cosines of each spin.
|
|
||||||
|
|
||||||
structure /spin/
|
|
||||||
integer*4 x,y,z
|
|
||||||
real*8 theta,phi,dir(3)
|
|
||||||
end structure
|
|
||||||
|
|
||||||
structure /muon/
|
|
||||||
integer*4 x,y,z, ns, s(max_nn)
|
|
||||||
real*8 dir(3), r(3,max_nn), r_2(max_nn), r_5(max_nn), omega(3)
|
|
||||||
end structure
|
|
||||||
|
|
||||||
! Declarations, maximumnumber of spins: max_spins, maxd is the maximum number of
|
|
||||||
! unitcell-distance for which the spin in included in the calculation
|
|
||||||
|
|
||||||
real*8, time_resolution=0.01 ! time resolution
|
|
||||||
! (approximate time between points
|
|
||||||
! on the *.g_t file)
|
|
||||||
|
|
||||||
|
|
||||||
character*10 dddd, tttt, zone
|
|
||||||
character*4 file_index
|
|
||||||
integer*4 dt(8), ifile, l_calc, n_steps, i_step
|
|
||||||
character*80 calculation
|
|
||||||
character*127 line
|
|
||||||
logical unique
|
|
||||||
integer*4 i,j,k,l,nw,nd,nsp,n_spin, n_site
|
|
||||||
integer*4 iseed, nd1, nd2
|
|
||||||
record /spin/ s(max_spins)
|
|
||||||
record /muon/ m(max_muons)
|
|
||||||
real*8 dummy, a, d, concentration, w, depth1, depth2
|
|
||||||
real*8 factor, moment, b_ext(3)
|
|
||||||
real*8 fluctuationrate, tau, dphi, dtheta, fraction
|
|
||||||
real*8 g_t(3), omega, b_abs, b_sq, ca_sq, his, radiussq
|
|
||||||
real*8 t_ini, p_ini, emu(3), Pi
|
|
||||||
real*8 step, exp_time, write_time, f_c
|
|
||||||
|
|
||||||
! Body of dynamics
|
|
||||||
|
|
||||||
! Read the parameters from the input file
|
|
||||||
! with name : <calculation>.inp
|
|
||||||
! The output will go to <calculation>.out
|
|
||||||
! and <calculation>_###.g_t
|
|
||||||
|
|
||||||
Write(6,*) ' '
|
|
||||||
Write(6,*) ' ---------------------------------------------------------------------'
|
|
||||||
Write(6,*) ' | Program field-calculation of muons due to random dynamic spins |'
|
|
||||||
Write(6,*) ' | |'
|
|
||||||
Write(6,*) ' | Version of November 16 2005 |'
|
|
||||||
Write(6,*) ' | |'
|
|
||||||
Write(6,*) ' | Input is read from an input file that should be named |'
|
|
||||||
Write(6,*) ' | <calculation>.inp and contains for each simulation on |'
|
|
||||||
Write(6,*) ' | one line: |'
|
|
||||||
Write(6,*) ' | |'
|
|
||||||
Write(6,*) ' | lattice-constant [nm], magnetic moment [mu_B], |'
|
|
||||||
Write(6,*) ' | ext. field(3) ,thickness, width, c, number_of_muons, |'
|
|
||||||
Write(6,*) ' | initial-muon-direction(theta, phi)[degrees], |'
|
|
||||||
Write(6,*) ' | (muon-positions from) depth1, (to) depth2 [nm], |'
|
|
||||||
Write(6,*) ' | fluctions rate [inverse microsec], |'
|
|
||||||
Write(6,*) ' | fluctuation amplitude parallel to film [0..360degr.],|'
|
|
||||||
Write(6,*) ' | fluctuation amplitude perpendicular to film |'
|
|
||||||
Write(6,*) ' | [0..180degr.] |'
|
|
||||||
Write(6,*) ' | |'
|
|
||||||
Write(6,*) ' | Lines with a ! in the first position are treated as comments. |'
|
|
||||||
Write(6,*) ' | |'
|
|
||||||
Write(6,*) ' | <calculation> can be issued as a commandline parameter |'
|
|
||||||
Write(6,*) ' ---------------------------------------------------------------------'
|
|
||||||
|
|
||||||
! files :
|
|
||||||
|
|
||||||
inquire( file='\simulations\counter.his', exist = unique )
|
|
||||||
IF ( unique ) THEN
|
|
||||||
open(9,file='\simulations\counter.his',status='old',err=994)
|
|
||||||
read(9,*) ifile ! initialize outputfile counter
|
|
||||||
ELSE
|
|
||||||
ifile = 0
|
|
||||||
END IF
|
|
||||||
|
|
||||||
IF ( iargc() .GT. 0 ) THEN
|
|
||||||
call getarg(1, calculation)
|
|
||||||
Write(6,*) ' Calculation taken from commandline > ',calculation
|
|
||||||
ELSE
|
|
||||||
200 write(6,201)
|
|
||||||
201 format(' '/' Give name of the calculation > ', \)
|
|
||||||
read(5,'(a60)') calculation
|
|
||||||
END IF
|
|
||||||
|
|
||||||
l_calc = index( calculation, ' ') - 1
|
|
||||||
|
|
||||||
IF ( l_calc .GT. 0 ) THEN
|
|
||||||
open(1,file=calculation(1:l_calc)//'.inp',status='old',action='read',err=995 )
|
|
||||||
open(2,file=calculation(1:l_calc)//'.out',status='unknown',action='write',err=996)
|
|
||||||
|
|
||||||
|
|
||||||
END IF
|
|
||||||
|
|
||||||
! initialization of randomumber generator and Pi
|
|
||||||
|
|
||||||
iseed = 1234567
|
|
||||||
Pi = acos( -1.0D+00 )
|
|
||||||
|
|
||||||
! Read everything from the input file, one line per calculation
|
|
||||||
|
|
||||||
DO WHILE ( .NOT. Eof(1) ) ! WHILE LOOP(1) over the input file
|
|
||||||
|
|
||||||
10 read(1,'(a127)',end=999) line
|
|
||||||
|
|
||||||
IF ( line(1:1) .EQ. '!' ) THEN
|
|
||||||
Write(2,'(a)') line
|
|
||||||
GOTO 10
|
|
||||||
END IF
|
|
||||||
|
|
||||||
read(line,*,err=998,end=999) a, moment, b_ext, d, w, concentration, &
|
|
||||||
& n_site, t_ini, p_ini, depth1, depth2, &
|
|
||||||
& fluctuationrate, dphi, dtheta
|
|
||||||
|
|
||||||
IF ( n_site .GT. 0.8 * max_muons ) n_site = 0.8 * max_muons
|
|
||||||
|
|
||||||
! Estimate optimum time_step
|
|
||||||
|
|
||||||
b_abs = sqrt( sum( b_ext * b_ext ) )
|
|
||||||
f_c = 135.5 * b_abs + 0.3 * moment * comcentration / (a*a*a)
|
|
||||||
|
|
||||||
time_step = min( 0.01, 0.1 / f_c )
|
|
||||||
|
|
||||||
! Initialize randomnumber generator "randomly"
|
|
||||||
|
|
||||||
call date_and_time( dddd, tttt, zone, dt )
|
|
||||||
DO i = 1, dt(8) ! number milliseconds on the clock
|
|
||||||
dummy = ran(iseed)
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
|
|
||||||
write(2,100) calculation(1:73),(dt(j),j=1,3),(dt(j),j=5,8)
|
|
||||||
100 format(' '/' ',73('-')/' ',a73/' ',73('-')/ &
|
|
||||||
& ' Calculation started ',i5,'-',i2,'-',i2, &
|
|
||||||
& ' at ',2(i2,':'),i2,'.',i3/' ',73('-')/' ')
|
|
||||||
write(2,'(a,f8.3)') ' lattice parameter = ', a
|
|
||||||
write(2,'(a,f8.3)') ' magnetic moment = ', moment
|
|
||||||
write(2,'(a,3f8.3)') ' external field = ', b_ext
|
|
||||||
write(2,'(a,f8.3)') ' concentration = ', concentration
|
|
||||||
write(2,'(a,2f8.3)') ' init.muon theta,phi = ', t_ini, p_ini
|
|
||||||
write(2,'(a,f8.3)') ' fluctuationrate = ', fluctuationrate
|
|
||||||
write(2,'(a,2f8.3)') ' fluctuation amp. = ', dphi, dtheta
|
|
||||||
|
|
||||||
emu(1) = sin(t_ini*Pi/180.0) * cos(p_ini*Pi/180.0)
|
|
||||||
emu(2) = sin(t_ini*Pi/180.0) * sin(p_ini*Pi/180.0)
|
|
||||||
emu(3) = cos(t_ini*Pi/180.0)
|
|
||||||
|
|
||||||
DO j = 1, max_muons
|
|
||||||
m(j).dir = emu
|
|
||||||
END DO
|
|
||||||
|
|
||||||
exp_time = 0.0D+00
|
|
||||||
write_time = 0.0D+00
|
|
||||||
|
|
||||||
! update file index for
|
|
||||||
|
|
||||||
ifile = ifile + 1 ! increase outputfile number
|
|
||||||
|
|
||||||
IF ( unique ) THEN
|
|
||||||
rewind(9)
|
|
||||||
write(9,*) ifile ! store for next program
|
|
||||||
END IF
|
|
||||||
|
|
||||||
write(file_index,'(''_'',i3)') ifile ! generate file_name
|
|
||||||
|
|
||||||
DO j = 2, 4
|
|
||||||
IF (file_index(j:j) .EQ. ' ' ) file_index(j:j) = '0'
|
|
||||||
END DO
|
|
||||||
|
|
||||||
open(3,file=calculation(1:l_calc)//file_index//'.g_t', &
|
|
||||||
& status='unknown',action='write', err=997 )
|
|
||||||
|
|
||||||
! output time=0 asymmetries
|
|
||||||
|
|
||||||
write(3,'(4F19.6)' ) exp_time, emu
|
|
||||||
write_time = write_time + time_resolution
|
|
||||||
|
|
||||||
! Initialize randomnumber generator "randomly"
|
|
||||||
|
|
||||||
call date_and_time( dddd, tttt, zone, dt )
|
|
||||||
|
|
||||||
DO i = 1, dt(8) ! number milliseconds on the clock
|
|
||||||
dummy = ran(iseed)
|
|
||||||
END DO
|
|
||||||
|
|
||||||
|
|
||||||
! make lattice, spinglass, choose muon sites and calculates "interaction matrix"
|
|
||||||
|
|
||||||
CALL lattice( iseed, d, w, a, concentration, n_spin, nd, nw, s, &
|
|
||||||
& n_site, depth1, depth2, m )
|
|
||||||
|
|
||||||
|
|
||||||
write(2,'(a,f8.3)') ' thickness = ', d
|
|
||||||
write(2,'(a,f8.3)') ' width = ', w
|
|
||||||
write(2,'(a,i10)') ' number of spins = ', n_spin
|
|
||||||
write(2,'(a,i10)') ' number of muons = ', n_site
|
|
||||||
write(2,'(a,2f8.3)') ' muons penetrate betw. ', depth1, depth2
|
|
||||||
write(2,'(a,a)') ' Output will be written on ', &
|
|
||||||
& calculation(1:l_calc)//file_index//'.g_t'
|
|
||||||
|
|
||||||
write(6,'(a,f8.3)') ' lattice parameter = ', a
|
|
||||||
write(6,'(a,f8.3)') ' magnetic moment = ', moment
|
|
||||||
write(6,'(a,3f8.3)') ' external field = ', b_ext
|
|
||||||
write(6,'(a,f8.3)') ' concentration = ', concentration
|
|
||||||
write(6,'(a,2f8.3)') ' init.muon theta,phi = ', t_ini, p_ini
|
|
||||||
write(6,'(a,f8.3)') ' fluctuationrate = ', fluctuationrate
|
|
||||||
write(6,'(a,2f8.3)') ' fluctuation amp. = ', dphi, dtheta
|
|
||||||
write(6,'(a,f8.3)') ' thickness = ', d
|
|
||||||
write(6,'(a,f8.3)') ' width = ', w
|
|
||||||
write(6,'(a,i10)') ' number of spins = ', n_spin
|
|
||||||
write(6,'(a,i10)') ' number of muons = ', n_site
|
|
||||||
write(6,'(a,2f8.3)') ' muons penetrate betw. ', depth1, depth2
|
|
||||||
write(6,'(a,a)') ' Output will be written on ', &
|
|
||||||
& calculation(1:l_calc)//file_index//'.g_t'
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
! The fluctuations are incorporated as follows:
|
|
||||||
|
|
||||||
! for rates larger then 1/time_resolution MHz,
|
|
||||||
! a timestep tau is choosen from a
|
|
||||||
! log distrubution ( tau = - ln(random) / fluctuationrate )
|
|
||||||
! The muon then rotates for tau microseconds, after all spins
|
|
||||||
! are rotated over an angle between - dtetha en dtheta and - dphi and dphi.
|
|
||||||
! This process is repeated until the total time is n_time_steps*time_resolution
|
|
||||||
! microsecods or more.
|
|
||||||
! Output of the muon position is about every time_resolution microsecond.
|
|
||||||
|
|
||||||
! for rates smaller then 1/time_resolution MHz
|
|
||||||
! the muons rotate 1000 times for time_resolution microsecond, after each rotation
|
|
||||||
! a fraction (= fluctuationrate *time_resolution) of the magnetic ions are rotated
|
|
||||||
! over an angle between - dtetha en dtheta and - dphi and dphi.
|
|
||||||
|
|
||||||
! After each fluctuation the fields at the muonsites are recalculated.
|
|
||||||
|
|
||||||
! "deporization" functions are calculated for
|
|
||||||
! left-right, up-down and forward-backward detectors,
|
|
||||||
! being the x-, y- and z-components of the muon spin vector.
|
|
||||||
|
|
||||||
! For arbitrary direction one has to take the scalar product of
|
|
||||||
! that specific direction with the results produced by this program
|
|
||||||
|
|
||||||
|
|
||||||
IF ( fluctuationrate .GT. 1.0/time_resolution ) THEN ! Rapid fluctuations
|
|
||||||
|
|
||||||
fraction = 1.0
|
|
||||||
! Start of WHILE loop(2) over exp_time
|
|
||||||
|
|
||||||
DO WHILE ( exp_time .LT. time_resolution * float(n_time_steps) )
|
|
||||||
|
|
||||||
tau = - log( ran(iseed) ) / fluctuationrate
|
|
||||||
|
|
||||||
IF ( exp_time + tau .GT. time_resolution * float(n_time_steps) ) &
|
|
||||||
& tau = time_resolution * float(n_time_steps) - exp_time
|
|
||||||
|
|
||||||
! take at least time_resolution microsec. steps, even if tau is larger
|
|
||||||
|
|
||||||
n_steps = floor( tau / time_resolution ) + 1
|
|
||||||
step = tau / float( n_steps )
|
|
||||||
|
|
||||||
CALL fields( a, moment, b_ext, s, n_site, m)
|
|
||||||
|
|
||||||
DO i_step = 1, n_steps
|
|
||||||
exp_time = exp_time + step
|
|
||||||
call muonrotation( n_site, m, step )
|
|
||||||
g_t = 0.0
|
|
||||||
DO j = 1, n_site
|
|
||||||
DO k = 1, 3
|
|
||||||
g_t(k) = g_t(k) + m(j).dir(k)
|
|
||||||
END DO
|
|
||||||
END DO
|
|
||||||
|
|
||||||
g_t = g_t / float(n_site)
|
|
||||||
|
|
||||||
IF ( exp_time .GT. write_time ) THEN
|
|
||||||
write(3,'(4F19.6)' ) exp_time, g_t
|
|
||||||
write_time = exp_time + time_resolution
|
|
||||||
END IF
|
|
||||||
|
|
||||||
END DO
|
|
||||||
|
|
||||||
! after tau, change spin directions and repeat the above.
|
|
||||||
! however, stop when 10 microsec has been reached.
|
|
||||||
|
|
||||||
CALL fluctuation( iseed, n_spin, s, dtheta, dphi, fraction )
|
|
||||||
|
|
||||||
END DO ! END of WHILE loop(2)
|
|
||||||
|
|
||||||
ELSE ! fluctuationrate < 1/time_resolution
|
|
||||||
|
|
||||||
fraction = fluctuationrate * time_resolution
|
|
||||||
step = time_resolution
|
|
||||||
n_steps = n_time_steps
|
|
||||||
|
|
||||||
DO i_step = 1, n_steps
|
|
||||||
exp_time = exp_time + step
|
|
||||||
CALL fields( a, moment, b_ext, s, n_site, m)
|
|
||||||
CALL muonrotation( n_site, m, step )
|
|
||||||
|
|
||||||
g_t = 0.0
|
|
||||||
|
|
||||||
DO j = 1, n_site
|
|
||||||
DO k = 1, 3
|
|
||||||
g_t(k) = g_t(k) + m(j).dir(k)
|
|
||||||
END DO
|
|
||||||
END DO
|
|
||||||
|
|
||||||
g_t = g_t / float(n_site)
|
|
||||||
|
|
||||||
write(3,'(4F19.6)' ) exp_time, g_t
|
|
||||||
CALL fluctuation( iseed, n_spin, s, dtheta, dphi, fraction )
|
|
||||||
|
|
||||||
END DO
|
|
||||||
|
|
||||||
END IF
|
|
||||||
|
|
||||||
END DO ! END of WHILE loop(1)
|
|
||||||
|
|
||||||
STOP ' Program DYNAMICS stopped where it should stop '
|
|
||||||
|
|
||||||
994 STOP ' FATAL: Cannot open counter.his '
|
|
||||||
|
|
||||||
995 STOP ' FATAL: Cannot open input file '
|
|
||||||
|
|
||||||
996 STOP ' FATAL: Cannot open output file '
|
|
||||||
|
|
||||||
997 Write(2,*) ' Cannot open g_t file '
|
|
||||||
STOP ' FATAL: Cannot open g_t file '
|
|
||||||
|
|
||||||
998 Write(2,*) ' Error in input file '
|
|
||||||
STOP ' FATAL: Due to error in input file '
|
|
||||||
|
|
||||||
999 Write(2,*) ' End of input-file '
|
|
||||||
STOP ' STOP End of input file '
|
|
||||||
|
|
||||||
end program dynamics
|
|
||||||
|
|
||||||
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
||||||
|
|
||||||
! LATTICE calculates the actual dimensions of the sample, places magnetic spins
|
|
||||||
! randomly according to concentration, gives the spins a random direction
|
|
||||||
! in space. It also generates a table of muonsites.
|
|
||||||
|
|
||||||
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
||||||
|
|
||||||
Subroutine lattice( iseed, d, w, a, concentration, n_spin, nd, nw, s, &
|
|
||||||
& n_site, depth1, depth2, m )
|
|
||||||
|
|
||||||
! Structure to store the position (as lattice site-indexes)
|
|
||||||
! and the direction-cosines of each spin and muon.
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer*4,parameter::max_spins = 50000, & ! maximum number of magnetic moments
|
|
||||||
& max_muons = 10000, & ! maximum number of muons
|
|
||||||
& max_nn = 500 ! maximum number of nearest neighbours
|
|
||||||
|
|
||||||
|
|
||||||
structure /spin/
|
|
||||||
integer*4 x,y,z
|
|
||||||
real*8 theta,phi,dir(3)
|
|
||||||
end structure
|
|
||||||
|
|
||||||
structure /muon/
|
|
||||||
integer*4 x,y,z, ns, s(max_nn)
|
|
||||||
real*8 dir(3), r(3,max_nn), r_2(max_nn), r_5(max_nn), omega(3)
|
|
||||||
end structure
|
|
||||||
|
|
||||||
real*8 d, w, a, concentration, c, depth1, depth2, fraction, radiussq
|
|
||||||
real*8 Pi, r(3), r_2, r_3, r_5, help
|
|
||||||
integer*4 iseed, nd, nw, nat, n_spin, n_site, nd1, nd2
|
|
||||||
integer*4 i, j, k, l, hw, kw, ns
|
|
||||||
record /spin/ s(*)
|
|
||||||
record /muon/ m(*)
|
|
||||||
|
|
||||||
Pi = acos( -1.0D+00 )
|
|
||||||
c = concentration / 100.0
|
|
||||||
|
|
||||||
! Calculate the 'rounded' number of spins for a lattice m*m*n for
|
|
||||||
! the given concentration.
|
|
||||||
! n is the number of atoms (half unitcells) perpendicular
|
|
||||||
! to the layer (== z-direction).
|
|
||||||
! m is the size of the layer in the x- and y-direction
|
|
||||||
|
|
||||||
nd = floor(2.0 * d / a ) + 2
|
|
||||||
nw = floor(2.0 * w / a ) + 2
|
|
||||||
nat = nd * nw * nw / 2
|
|
||||||
n_spin = floor( nat * c )
|
|
||||||
d = float(nd) * a / 2.0
|
|
||||||
w = float(nw) * a / 2.0
|
|
||||||
hw = nw / 2
|
|
||||||
|
|
||||||
IF ( c .GT. 0.0 ) THEN
|
|
||||||
radiussq = (( 1.6 * float(max_nn) / c ) / ( 4.0 * Pi / 3.0 ))**(2.0/3.0)
|
|
||||||
ELSE
|
|
||||||
radiussq = 1D+10
|
|
||||||
END IF
|
|
||||||
|
|
||||||
write(2,*) ' radius = ', sqrt( radiussq )
|
|
||||||
|
|
||||||
nd1 = floor( 2.0 * depth1 / a )
|
|
||||||
nd2 = floor( 2.0 * depth2 / a )
|
|
||||||
IF ( mod( nd1 , 2 ) .EQ. 0 ) nd1 = nd1 + 1 ! nd1 should be odd
|
|
||||||
IF ( nd2 .LT. nd1 + 1 ) nd2 = nd1 + 1
|
|
||||||
depth1 = float(nd1) * a / 2.0
|
|
||||||
depth2 = float(nd2) * a / 2.0
|
|
||||||
fraction = float(n_site) / (float((nd2-nd1)*nw*nw) / 8.0)
|
|
||||||
|
|
||||||
|
|
||||||
! Place the spins randomly on the fcc-lattice
|
|
||||||
! Run over a whole simple cubic lattice in steps
|
|
||||||
! of half of the fcc-unitcell.
|
|
||||||
! Then take care of the fcc-structure and
|
|
||||||
! decide whether or not to place a spin.
|
|
||||||
|
|
||||||
n_spin = 0
|
|
||||||
|
|
||||||
DO j = 0, nw-1
|
|
||||||
DO k = 0, nw-1
|
|
||||||
DO l = 0, nd-1
|
|
||||||
IF ( mod(j+k+l,2) .EQ. 0 ) THEN ! This takes care of the fcc structure.
|
|
||||||
IF ( ran(iseed) .LT. c ) THEN ! Takes care of concentration
|
|
||||||
n_spin = n_spin + 1
|
|
||||||
IF ( n_spin .GT. max_spins ) STOP ' Stopped because number of spin too large '
|
|
||||||
s(n_spin).x = j
|
|
||||||
s(n_spin).y = k
|
|
||||||
s(n_spin).z = l
|
|
||||||
|
|
||||||
! Give the spin an arbitrary direction
|
|
||||||
|
|
||||||
s(n_spin).theta = Pi * ran(iseed)
|
|
||||||
s(n_spin).phi = (Pi+Pi) * ran(iseed)
|
|
||||||
s(n_spin).dir(1) = sin(s(n_spin).theta) * cos(s(n_spin).phi)
|
|
||||||
s(n_spin).dir(2) = sin(s(n_spin).theta) * sin(s(n_spin).phi)
|
|
||||||
s(n_spin).dir(3) = cos(s(n_spin).theta)
|
|
||||||
|
|
||||||
END IF
|
|
||||||
END IF
|
|
||||||
|
|
||||||
|
|
||||||
END DO
|
|
||||||
END DO
|
|
||||||
END DO
|
|
||||||
|
|
||||||
! determine positions of the muons
|
|
||||||
|
|
||||||
n_site = 0
|
|
||||||
|
|
||||||
DO j = 1, nw-1, 2
|
|
||||||
DO k = 1, nw-1, 2
|
|
||||||
DO l = nd1, nd2, 2
|
|
||||||
|
|
||||||
IF ( ran(iseed) .LT. fraction ) THEN
|
|
||||||
n_site = n_site + 1
|
|
||||||
m(n_site).x = j
|
|
||||||
m(n_site).y = k
|
|
||||||
m(n_site).x = l
|
|
||||||
ns = 0
|
|
||||||
|
|
||||||
DO i = 1, n_spin
|
|
||||||
kw = j - s(i).x
|
|
||||||
IF ( kw .LT. -hw ) kw = kw + nw ! periodic boundary condition
|
|
||||||
IF ( kw .GT. hw ) kw = kw - nw ! periodic boundary condition
|
|
||||||
r(1) = dble(float(kw))
|
|
||||||
kw = k - s(i).y
|
|
||||||
IF ( kw .LT. -hw ) kw = kw + nw ! periodic boundary condition
|
|
||||||
IF ( kw .GT. hw ) kw = kw - nw ! periodic boundary condition
|
|
||||||
r(2) = dble(float(kw))
|
|
||||||
r(3) = dble(float(l-s(i).z)) ! NO periodic boundary condition
|
|
||||||
r_2 = sum( r * r )
|
|
||||||
|
|
||||||
IF ( r_2 .LE. radiussq ) THEN ! skip calculation if distance
|
|
||||||
! is too large
|
|
||||||
help = sqrt( r_2 )
|
|
||||||
r_3 = r_2 * help
|
|
||||||
r_5 = r_2 * r_3
|
|
||||||
ns = ns + 1
|
|
||||||
IF (ns .GT. max_nn) STOP ' Stopped because NS becomes too large '
|
|
||||||
m(n_site).s(ns) = i
|
|
||||||
m(n_site).r(1,ns) = r(1)
|
|
||||||
m(n_site).r(2,ns) = r(2)
|
|
||||||
m(n_site).r(3,ns) = r(3)
|
|
||||||
m(n_site).r_2(ns) = r_2
|
|
||||||
m(n_site).r_5(ns) = r_5
|
|
||||||
END IF
|
|
||||||
|
|
||||||
END DO
|
|
||||||
|
|
||||||
m(n_site).ns = ns
|
|
||||||
|
|
||||||
END IF
|
|
||||||
|
|
||||||
END DO
|
|
||||||
END DO
|
|
||||||
END DO
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
END
|
|
||||||
|
|
||||||
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
||||||
|
|
||||||
! FIELDS calculates all internal fields at the muonsites and
|
|
||||||
! adds the external field
|
|
||||||
|
|
||||||
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
||||||
|
|
||||||
Subroutine fields( a, moment, b_ext, s, n_site, m)
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer*4,parameter::max_spins = 50000, & ! maximum number of magnetic moments
|
|
||||||
& max_muons = 10000, & ! maximum number of muons
|
|
||||||
& max_nn = 500 ! maximum number of nearest neighbours
|
|
||||||
|
|
||||||
|
|
||||||
structure /spin/
|
|
||||||
integer*4 x,y,z
|
|
||||||
real*8 theta,phi,dir(3)
|
|
||||||
end structure
|
|
||||||
|
|
||||||
structure /muon/
|
|
||||||
integer*4 x,y,z, ns, s(max_nn)
|
|
||||||
real*8 dir(3), r(3,max_nn), r_2(max_nn), r_5(max_nn), omega(3)
|
|
||||||
end structure
|
|
||||||
|
|
||||||
real*8 Pi, Gyro, p_r, a, factor
|
|
||||||
real*8 b(3), b_ext(3), moment
|
|
||||||
integer*4 j, k, l, n_site
|
|
||||||
record /spin/ s(*)
|
|
||||||
record /muon/ m(*)
|
|
||||||
|
|
||||||
Pi = acos(-1D+00)
|
|
||||||
Gyro = (Pi+Pi) * 135.54 ! gyro-magnetic ratio of muon [tesla^-1 s^-1]
|
|
||||||
factor = 1D-07 * moment * 9.2740019D-24 / ( a*a*a * 0.125D-27 )
|
|
||||||
|
|
||||||
DO j = 1, n_site
|
|
||||||
b = 0
|
|
||||||
DO k = 1, m(j).ns
|
|
||||||
l = m(j).s(k)
|
|
||||||
p_r = m(j).r(1,k) * s(l).dir(1) + &
|
|
||||||
& m(j).r(2,k) * s(l).dir(2) + &
|
|
||||||
& m(j).r(3,k) * s(l).dir(3)
|
|
||||||
b(1) = b(1) + (3.0D+00*p_r*m(j).r(1,k)-m(j).r_2(k)*s(l).dir(1))/m(j).r_5(k)
|
|
||||||
b(2) = b(2) + (3.0D+00*p_r*m(j).r(2,k)-m(j).r_2(k)*s(l).dir(2))/m(j).r_5(k)
|
|
||||||
b(3) = b(3) + (3.0D+00*p_r*m(j).r(3,k)-m(j).r_2(k)*s(l).dir(3))/m(j).r_5(k)
|
|
||||||
END DO
|
|
||||||
b = factor * b + b_ext
|
|
||||||
m(j).omega(1) = Gyro * b(1)
|
|
||||||
m(j).omega(2) = Gyro * b(2)
|
|
||||||
m(j).omega(3) = Gyro * b(3)
|
|
||||||
END DO
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
END
|
|
||||||
|
|
||||||
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
||||||
|
|
||||||
! FLUCTUATION changes all directions of the spins with a random amount
|
|
||||||
! DTHETA and DPHI
|
|
||||||
|
|
||||||
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
||||||
|
|
||||||
Subroutine fluctuation( iseed, n_spin, s, dtheta, dphi, fraction )
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer*4,parameter::max_spins = 50000, & ! maximum number of magnetic moments
|
|
||||||
& max_muons = 10000, & ! maximum number of muons
|
|
||||||
& max_nn = 500 ! maximum number of nearest neighbours
|
|
||||||
|
|
||||||
structure /spin/
|
|
||||||
integer*4 x,y,z
|
|
||||||
real*8 theta,phi,dir(3)
|
|
||||||
end structure
|
|
||||||
|
|
||||||
record /spin/ s(*)
|
|
||||||
real*8 dtheta, dphi, dt, dp, Pi, fraction
|
|
||||||
integer*4 iseed, n_spin, i_spin
|
|
||||||
|
|
||||||
IF ( fraction .LT. 1.0D-06 .OR. &
|
|
||||||
& ( dtheta .LT. 1.0D-06 .AND. dphi .LT. 1.0D-06 ) ) RETURN
|
|
||||||
|
|
||||||
Pi = acos( -1.0D+00 )
|
|
||||||
dt = dtheta * Pi / 180.0 ! amplitude of the fluctuation in theta
|
|
||||||
dp = dphi * Pi / 180.0 ! amplitude of the fluctuation in phi
|
|
||||||
|
|
||||||
DO i_spin = 1, n_spin
|
|
||||||
IF ( ran(iseed) .LT. fraction ) THEN
|
|
||||||
s(i_spin).theta = s(i_spin).theta + 2.0 * dt * (ran(iseed)-0.5)
|
|
||||||
s(i_spin).phi = s(i_spin).phi + 2.0 * dp * (ran(iseed)-0.5)
|
|
||||||
s(i_spin).dir(1) = sin(s(i_spin).theta) * cos(s(i_spin).phi)
|
|
||||||
s(i_spin).dir(2) = sin(s(i_spin).theta) * sin(s(i_spin).phi)
|
|
||||||
s(i_spin).dir(3) = cos(s(i_spin).theta)
|
|
||||||
END IF
|
|
||||||
END DO
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
END
|
|
||||||
|
|
||||||
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
||||||
|
|
||||||
! MUONROTATION rotates all muons over the vector m.omega * step
|
|
||||||
|
|
||||||
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
||||||
|
|
||||||
Subroutine muonrotation( n_site, m, step )
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
integer*4,parameter::max_spins = 50000, & ! maximum number of magnetic moments
|
|
||||||
& max_muons = 10000, & ! maximum number of muons
|
|
||||||
& max_nn = 500 ! maximum number of nearest neighbours
|
|
||||||
|
|
||||||
structure /muon/
|
|
||||||
integer*4 x,y,z, ns, s(max_nn)
|
|
||||||
real*8 dir(3), r(3,max_nn), r_2(max_nn), r_5(max_nn), omega(3)
|
|
||||||
end structure
|
|
||||||
|
|
||||||
record /muon/ m(*)
|
|
||||||
real*8 v(3), OM(3), step
|
|
||||||
integer*4 j, n_site
|
|
||||||
|
|
||||||
DO j = 1, n_site
|
|
||||||
OM(1) = m(j).omega(1)
|
|
||||||
OM(2) = m(j).omega(2)
|
|
||||||
OM(3) = m(j).omega(3)
|
|
||||||
OM = OM * step
|
|
||||||
v(1) = m(j).dir(1)
|
|
||||||
v(2) = m(j).dir(2)
|
|
||||||
v(3) = m(j).dir(3)
|
|
||||||
call rotation( v, OM )
|
|
||||||
m(j).dir(1) = v(1)
|
|
||||||
m(j).dir(2) = v(2)
|
|
||||||
m(j).dir(3) = v(3)
|
|
||||||
END DO
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
END
|
|
||||||
|
|
||||||
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
||||||
|
|
||||||
! ROTATION rotates a vector V around the vector O
|
|
||||||
|
|
||||||
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
||||||
|
|
||||||
Subroutine rotation( v, o )
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
real*8 v(3), o(3), uo(3), r(3), o_abs, cc, ss
|
|
||||||
|
|
||||||
o_abs = sqrt( sum( o * o ) )
|
|
||||||
|
|
||||||
IF ( o_abs .GT. 1D-08 ) THEN
|
|
||||||
uo = o / o_abs
|
|
||||||
cc = cos( o_abs )
|
|
||||||
ss = sin( o_abs )
|
|
||||||
|
|
||||||
r(1) = ( cc+uo(1)*uo(1)*(1-cc) ) * v(1) + &
|
|
||||||
& ( -uo(3)*ss+uo(1)*uo(2)*(1-cc) ) * v(2) + &
|
|
||||||
& ( uo(2)*ss+uo(1)*uo(3)*(1-cc) ) * v(3)
|
|
||||||
|
|
||||||
r(2) = ( uo(3)*ss+uo(1)*uo(2)*(1-cc) ) * v(1) + &
|
|
||||||
& ( cc+uo(2)*uo(2)*(1-cc) ) * v(2) + &
|
|
||||||
& ( -uo(1)*ss+uo(2)*uo(3)*(1-cc) ) * v(3)
|
|
||||||
|
|
||||||
r(3) = ( -uo(2)*ss+uo(1)*uo(3)*(1-cc) ) * v(1) + &
|
|
||||||
& ( uo(1)*ss+uo(2)*uo(3)*(1-cc) ) * v(2) + &
|
|
||||||
& ( cc+uo(3)*uo(3)*(1-cc) ) * v(3)
|
|
||||||
|
|
||||||
v = r
|
|
||||||
END IF
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
END
|
|
||||||
@ -1,19 +0,0 @@
|
|||||||
<html>
|
|
||||||
<body>
|
|
||||||
<pre>
|
|
||||||
<h1>Build Log</h1>
|
|
||||||
<h3>
|
|
||||||
--------------------Configuration: dynamics - Win32 Debug--------------------
|
|
||||||
</h3>
|
|
||||||
<h3>Command Lines</h3>
|
|
||||||
Creating command line "link.exe kernel32.lib /nologo /subsystem:console /incremental:no /pdb:"Debug/dynamics.pdb" /debug /machine:I386 /out:"Debug/dynamics.exe" /pdbtype:sept .\Debug\dynamics.obj "
|
|
||||||
<h3>Output Window</h3>
|
|
||||||
Linking...
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
<h3>Results</h3>
|
|
||||||
dynamics.exe - 0 error(s), 0 warning(s)
|
|
||||||
</pre>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -1,60 +0,0 @@
|
|||||||
!
|
|
||||||
! Program to index old files
|
|
||||||
!
|
|
||||||
character*4 file_index
|
|
||||||
character*80 calculation, dummy
|
|
||||||
character*48 g_t
|
|
||||||
character*32 his
|
|
||||||
integer ifile, i,j
|
|
||||||
!
|
|
||||||
ifile = 0
|
|
||||||
!
|
|
||||||
1 CONTINUE
|
|
||||||
200 write(6,201)
|
|
||||||
201 format(' '/' Give name of the calculation > ', \)
|
|
||||||
read(5,'(a60)') calculation
|
|
||||||
IF ( calculation(1:1) .EQ. ' ' ) STOP ' Stopped by operator '
|
|
||||||
l_calc = index( calculation, ' ') - 1
|
|
||||||
!
|
|
||||||
open(1,file=calculation(1:l_calc)//'.inp',status='old',action='read',err=200 )
|
|
||||||
open(3,file=calculation(1:l_calc)//'.g_t',status='old',action='read')
|
|
||||||
open(4,file=calculation(1:l_calc)//'.his',status='old',action='read')
|
|
||||||
!
|
|
||||||
read(1,'(a80)') comment
|
|
||||||
read(4,'(a80)') dummy
|
|
||||||
!
|
|
||||||
300 read(1,'(a80)',end=900) dummy
|
|
||||||
ifile = ifile + 1 ! increase outputfile number
|
|
||||||
write(file_index,'(''_'',i3)') ifile ! generate file_name
|
|
||||||
DO j = 2, 4
|
|
||||||
IF (file_index(j:j) .EQ. ' ' ) file_index(j:j) = '0'
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
write(6,*) ' file index = ', file_index
|
|
||||||
!
|
|
||||||
open(8,file=calculation(1:l_calc)//file_index//'.g_t',status='unknown',action='write')
|
|
||||||
open(9,file=calculation(1:l_calc)//file_index//'.his',status='unknown',action='write')
|
|
||||||
!
|
|
||||||
DO j = 1, 1000
|
|
||||||
read(3,'(a48)',end=305) g_t
|
|
||||||
write(8,'(a48)') g_t
|
|
||||||
END DO
|
|
||||||
305 close(8)
|
|
||||||
!
|
|
||||||
310 read(4,'(a32)',end=390) his
|
|
||||||
IF (his(2:2) .EQ. '-') goto 390
|
|
||||||
write(9,'(a32)') his
|
|
||||||
GOTO 310
|
|
||||||
!
|
|
||||||
390 close(9)
|
|
||||||
GOTO 300
|
|
||||||
!
|
|
||||||
! finish
|
|
||||||
!
|
|
||||||
900 close(1)
|
|
||||||
close(3)
|
|
||||||
close(4)
|
|
||||||
Write(6,*) ' end of *.inp file '
|
|
||||||
Write(6,*) ' '
|
|
||||||
GOTO 200
|
|
||||||
END
|
|
||||||
@ -1,105 +0,0 @@
|
|||||||
# Microsoft Developer Studio Project File - Name="index" - Package Owner=<4>
|
|
||||||
# Microsoft Developer Studio Generated Build File, Format Version 6.00
|
|
||||||
# ** DO NOT EDIT **
|
|
||||||
|
|
||||||
# TARGTYPE "Win32 (x86) Console Application" 0x0103
|
|
||||||
|
|
||||||
CFG=index - Win32 Debug
|
|
||||||
!MESSAGE This is not a valid makefile. To build this project using NMAKE,
|
|
||||||
!MESSAGE use the Export Makefile command and run
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE NMAKE /f "index.mak".
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE You can specify a configuration when running NMAKE
|
|
||||||
!MESSAGE by defining the macro CFG on the command line. For example:
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE NMAKE /f "index.mak" CFG="index - Win32 Debug"
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE Possible choices for configuration are:
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE "index - Win32 Release" (based on "Win32 (x86) Console Application")
|
|
||||||
!MESSAGE "index - Win32 Debug" (based on "Win32 (x86) Console Application")
|
|
||||||
!MESSAGE
|
|
||||||
|
|
||||||
# Begin Project
|
|
||||||
# PROP AllowPerConfigDependencies 0
|
|
||||||
# PROP Scc_ProjName ""
|
|
||||||
# PROP Scc_LocalPath ""
|
|
||||||
CPP=cl.exe
|
|
||||||
F90=df.exe
|
|
||||||
RSC=rc.exe
|
|
||||||
|
|
||||||
!IF "$(CFG)" == "index - Win32 Release"
|
|
||||||
|
|
||||||
# PROP BASE Use_MFC 0
|
|
||||||
# PROP BASE Use_Debug_Libraries 0
|
|
||||||
# PROP BASE Output_Dir "Release"
|
|
||||||
# PROP BASE Intermediate_Dir "Release"
|
|
||||||
# PROP BASE Target_Dir ""
|
|
||||||
# PROP Use_MFC 0
|
|
||||||
# PROP Use_Debug_Libraries 0
|
|
||||||
# PROP Output_Dir "Release"
|
|
||||||
# PROP Intermediate_Dir "Release"
|
|
||||||
# PROP Target_Dir ""
|
|
||||||
# ADD BASE F90 /compile_only /nologo /warn:nofileopt
|
|
||||||
# ADD F90 /compile_only /nologo /warn:nofileopt
|
|
||||||
# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
|
|
||||||
# ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
|
|
||||||
# ADD BASE RSC /l 0x409 /d "NDEBUG"
|
|
||||||
# ADD RSC /l 0x409 /d "NDEBUG"
|
|
||||||
BSC32=bscmake.exe
|
|
||||||
# ADD BASE BSC32 /nologo
|
|
||||||
# ADD BSC32 /nologo
|
|
||||||
LINK32=link.exe
|
|
||||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
|
||||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
|
||||||
|
|
||||||
!ELSEIF "$(CFG)" == "index - Win32 Debug"
|
|
||||||
|
|
||||||
# PROP BASE Use_MFC 0
|
|
||||||
# PROP BASE Use_Debug_Libraries 1
|
|
||||||
# PROP BASE Output_Dir "Debug"
|
|
||||||
# PROP BASE Intermediate_Dir "Debug"
|
|
||||||
# PROP BASE Target_Dir ""
|
|
||||||
# PROP Use_MFC 0
|
|
||||||
# PROP Use_Debug_Libraries 1
|
|
||||||
# PROP Output_Dir "Debug"
|
|
||||||
# PROP Intermediate_Dir "Debug"
|
|
||||||
# PROP Target_Dir ""
|
|
||||||
# ADD BASE F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
|
|
||||||
# ADD F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
|
|
||||||
# ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
|
|
||||||
# ADD CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
|
|
||||||
# ADD BASE RSC /l 0x409 /d "_DEBUG"
|
|
||||||
# ADD RSC /l 0x409 /d "_DEBUG"
|
|
||||||
BSC32=bscmake.exe
|
|
||||||
# ADD BASE BSC32 /nologo
|
|
||||||
# ADD BSC32 /nologo
|
|
||||||
LINK32=link.exe
|
|
||||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
|
|
||||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /incremental:no /debug /machine:I386 /pdbtype:sept
|
|
||||||
|
|
||||||
!ENDIF
|
|
||||||
|
|
||||||
# Begin Target
|
|
||||||
|
|
||||||
# Name "index - Win32 Release"
|
|
||||||
# Name "index - Win32 Debug"
|
|
||||||
# Begin Group "Source Files"
|
|
||||||
|
|
||||||
# PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat;f90;for;f;fpp"
|
|
||||||
# Begin Source File
|
|
||||||
|
|
||||||
SOURCE=".\index old files.f90"
|
|
||||||
# End Source File
|
|
||||||
# End Group
|
|
||||||
# Begin Group "Header Files"
|
|
||||||
|
|
||||||
# PROP Default_Filter "h;hpp;hxx;hm;inl;fi;fd"
|
|
||||||
# End Group
|
|
||||||
# Begin Group "Resource Files"
|
|
||||||
|
|
||||||
# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
|
|
||||||
# End Group
|
|
||||||
# End Target
|
|
||||||
# End Project
|
|
||||||
@ -1,19 +0,0 @@
|
|||||||
<html>
|
|
||||||
<body>
|
|
||||||
<pre>
|
|
||||||
<h1>Build Log</h1>
|
|
||||||
<h3>
|
|
||||||
--------------------Configuration: index - Win32 Release--------------------
|
|
||||||
</h3>
|
|
||||||
<h3>Command Lines</h3>
|
|
||||||
Creating command line "link.exe kernel32.lib /nologo /subsystem:console /incremental:no /pdb:"Release/index.pdb" /machine:I386 /out:"Release/index.exe" ".\Release\index old files.obj" "
|
|
||||||
<h3>Output Window</h3>
|
|
||||||
Linking...
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
<h3>Results</h3>
|
|
||||||
index.exe - 0 error(s), 0 warning(s)
|
|
||||||
</pre>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -1,385 +0,0 @@
|
|||||||
! Program to simulate thin film spinglasses.
|
|
||||||
!
|
|
||||||
! Ge Nieuwenhuys, June, 2002, Written as Ising Metropolis program
|
|
||||||
! October 2005, Rewritten as Heisenberg Zero-Temperature
|
|
||||||
! October 17, 2005 Bug in direct access file "removes" by
|
|
||||||
! oversizing the recordlength
|
|
||||||
!
|
|
||||||
! October 12: periodic boundary conditions in y- z plane
|
|
||||||
! October 14: random number start randomly (based on clock) for
|
|
||||||
! batch calculations.
|
|
||||||
! October 14: output-file-names are automatically indexed.
|
|
||||||
!
|
|
||||||
! Spins are located on a fcc lattice
|
|
||||||
!
|
|
||||||
! nspin number of spins
|
|
||||||
! nsp number of spins asked
|
|
||||||
! d thickness
|
|
||||||
! a lattice constant
|
|
||||||
! ah half of lattice constant
|
|
||||||
!
|
|
||||||
Use DFPORT ! library only needed for obtaining CPU-time
|
|
||||||
Use DFLIB
|
|
||||||
!
|
|
||||||
parameter ( max_spins = 100000 )
|
|
||||||
!
|
|
||||||
structure /spin/
|
|
||||||
integer*4 x,y,z
|
|
||||||
real*8 c(3)
|
|
||||||
end structure
|
|
||||||
!
|
|
||||||
structure /inter/
|
|
||||||
integer si
|
|
||||||
real*8 val
|
|
||||||
end structure
|
|
||||||
!
|
|
||||||
integer*4 j,k,l,m,n, nsp, nspin, nat, steps_per_spin, mh, ix, iy, iz
|
|
||||||
integer*4 l_calc, ifile, iseed
|
|
||||||
record /spin/ s(max_spins)
|
|
||||||
record /inter/ i(100,max_spins)
|
|
||||||
real*8 d, concentration, c, dd(max_spins), rkky, norm, p(3), k_F
|
|
||||||
real*8 b_ext(3), b_ext_K(3), moment, T_glass, mag(3)
|
|
||||||
character*1 answer
|
|
||||||
character*80 calculation, line
|
|
||||||
logical open_inp
|
|
||||||
character*8 dddd, tttt, zone
|
|
||||||
character*4 file_index
|
|
||||||
integer dt(8)
|
|
||||||
real*4 runtime(2), start_time, end_time
|
|
||||||
!
|
|
||||||
! initialization
|
|
||||||
!
|
|
||||||
val = 0
|
|
||||||
a = .407 ! nm, lattice parameter for Au
|
|
||||||
k_F = 12.0 ! 1/nm, Fermi wavevector for Au
|
|
||||||
moment = 2.2 ! mu_B, moment of the impurity spins
|
|
||||||
b_ext(1) = 0.01
|
|
||||||
b_ext(2) = 0.0
|
|
||||||
b_ext(3) = 0.0 ! extrenal field of 100 gauss in x-direction
|
|
||||||
T_glass = 15.0 ! glass_temperature in Kelvin
|
|
||||||
ah = a / 2.0
|
|
||||||
iseed = 1234567
|
|
||||||
!
|
|
||||||
Write(6,*) '-----------------------------------------------------'
|
|
||||||
Write(6,*) '| SPIN-GLASS GROUNDSTATE SIMULATION |'
|
|
||||||
Write(6,*) '| Version October 17, 2005 |'
|
|
||||||
Write(6,*) '| |'
|
|
||||||
Write(6,*) '| This program simulates a spin-glass groundstate |'
|
|
||||||
Write(6,*) '| using the method as described by |'
|
|
||||||
Write(6,*) '| Walstedt and Walker, Phys. Rev. B22 (1980) 3816 |'
|
|
||||||
Write(6,*) '| |'
|
|
||||||
Write(6,*) '| The program can be used in batch mode by |'
|
|
||||||
Write(6,*) '| supplying the name of the calculation |'
|
|
||||||
Write(6,*) '| (Enter will start the online mode) |'
|
|
||||||
Write(6,*) '| |'
|
|
||||||
Write(6,*) '| In de batch-mode the parameters will be read from |'
|
|
||||||
Write(6,*) '| <calculation>.inp |'
|
|
||||||
Write(6,*) '| A comment on the first line and then on |'
|
|
||||||
Write(6,*) '| each line of this file |'
|
|
||||||
Write(6,*) '| number of spins, |'
|
|
||||||
Write(6,*) '| thickness of sample [nm], |'
|
|
||||||
Write(6,*) '| lattice parameter [nm], |'
|
|
||||||
Write(6,*) '| Fermi wave number [nm^-1] |'
|
|
||||||
Write(6,*) '| concentration of spins [at.%], |'
|
|
||||||
Write(6,*) '| glass temperature [K], |'
|
|
||||||
Write(6,*) '| magnetic moment [mu_B], |'
|
|
||||||
Write(6,*) '| external magnetic field (3 components) [tesla] |'
|
|
||||||
Write(6,*) '| number of iterations |'
|
|
||||||
Write(6,*) '| |'
|
|
||||||
Write(6,*) '| <calculation> can be entered as a |'
|
|
||||||
Write(6,*) '| commandline parameter |'
|
|
||||||
Write(6,*) '-----------------------------------------------------'
|
|
||||||
!
|
|
||||||
! Ask name of calculation (and read if in batch mode )
|
|
||||||
!
|
|
||||||
!
|
|
||||||
! files :
|
|
||||||
!
|
|
||||||
open(9,file='u:\simulations\counter.his',status='old')
|
|
||||||
read(9,*) ifile ! initialize outputfile counter
|
|
||||||
!
|
|
||||||
IF ( iargc() .GT. 0 ) THEN
|
|
||||||
call getarg(1, calculation)
|
|
||||||
Write(6,*) ' Calculation taken from commandline > ',calculation
|
|
||||||
ELSE
|
|
||||||
777 write(6,778)
|
|
||||||
778 format(' '/' Give name of the calculation > ', \)
|
|
||||||
read(5,'(a80)') calculation
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
IF ( calculation(1:1) .NE. ' ' ) THEN
|
|
||||||
l_calc = index( calculation, ' ') - 1
|
|
||||||
open(1,file=calculation(1:l_calc)//'.inp', status='old', action='read', err=777)
|
|
||||||
open(2,file=calculation(1:l_calc)//'.out', status='unknown', action='write')
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
inquire(1,opened=open_inp)
|
|
||||||
IF (open_inp) read(1,'(a80)') comment
|
|
||||||
!
|
|
||||||
open(9,file='u:\simulations\counter.sgl',status='old')
|
|
||||||
read(9,*) ifile
|
|
||||||
!
|
|
||||||
888 IF (open_inp) THEN ! new calculation
|
|
||||||
889 ifile = ifile + 1 ! increase outputfile number
|
|
||||||
rewind(9)
|
|
||||||
write(9,*) ifile ! store for next program
|
|
||||||
write(file_index,'(''_'',i3)') ifile ! generate file_name
|
|
||||||
DO j = 2, 4
|
|
||||||
IF (file_index(j:j) .EQ. ' ' ) file_index(j:j) = '0'
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
! Although the length of the record /spin/ is 3*4 + 3*8 = 36, the length had to be
|
|
||||||
! set to 40, otherwise the writing went wrong (s.c(3) always, except for the last
|
|
||||||
! equal to zero
|
|
||||||
!
|
|
||||||
open(3,file=calculation(1:l_calc)//file_index//'.sgl',status='unknown', &
|
|
||||||
& access='direct',form='binary',recl=40)
|
|
||||||
!
|
|
||||||
890 read(1,'(a80)',end=999) line
|
|
||||||
IF ( line(1:1) .EQ. '!' ) THEN
|
|
||||||
write(6,'(a)') line
|
|
||||||
GOTO 890
|
|
||||||
ELSE
|
|
||||||
read(line,*,err=998,end=999) nsp, d, a, k_F, concentration, &
|
|
||||||
& T_glass, moment, b_ext, &
|
|
||||||
& steps_per_spin
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
! Initialize randomnumber generator "randomly"
|
|
||||||
!
|
|
||||||
call date_and_time( dddd, tttt, zone, dt )
|
|
||||||
DO j = 1, dt(8) ! number milliseconds on the clock
|
|
||||||
dummy = rand(iseed)
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
ELSE
|
|
||||||
!
|
|
||||||
! Ask size of the system
|
|
||||||
!
|
|
||||||
1 write(6,2)
|
|
||||||
2 format( ' How many spins ? '\)
|
|
||||||
read(5,*,err=1) nsp
|
|
||||||
IF ( nsp .LE. 0 ) STOP ' Programm terminated by operator '
|
|
||||||
IF ( nsp .GT. max_spins ) GOTO 1
|
|
||||||
!
|
|
||||||
3 write(6,4)
|
|
||||||
4 format( ' What thickness [nm] ? '\)
|
|
||||||
read(5,*,err=3) d
|
|
||||||
!
|
|
||||||
5 write(6,6)
|
|
||||||
6 format( ' Which concentration [at.%] ? '\)
|
|
||||||
read(5,*,err=5) concentration
|
|
||||||
|
|
||||||
7 write(6,8)
|
|
||||||
8 format(' Give the T_glass and the magnetic moment > '\)
|
|
||||||
read(5,*,err=7) T_glass, moment
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
! end of getting all parameters
|
|
||||||
!
|
|
||||||
c = concentration / 100
|
|
||||||
!
|
|
||||||
! Calculate the magnetic field energy in Kelvin
|
|
||||||
!
|
|
||||||
b_ext_K = moment * (0.927 / 1.38) * b_ext
|
|
||||||
!
|
|
||||||
start_time = dtime(runtime) ! record the starttime
|
|
||||||
!
|
|
||||||
! Calculate the 'rounded' number of spins for a lattice n*m*m for
|
|
||||||
! the given concentration
|
|
||||||
!
|
|
||||||
n = floor( d / ah )
|
|
||||||
nat = floor( nsp / c )
|
|
||||||
m = floor( sqrt( 2.0 * float(nat) / float(n) ) )
|
|
||||||
mh = m / 2
|
|
||||||
nat = m * m * n / 2
|
|
||||||
nspin = floor( nat * c )
|
|
||||||
!
|
|
||||||
write(6,*) ' n = ', n,' m = ', m
|
|
||||||
write(6,*) ' nat = ', nat
|
|
||||||
write(6,*) ' nspin = ', nspin
|
|
||||||
!
|
|
||||||
write(2,*) ' n = ', n,' m = ', m
|
|
||||||
write(2,*) ' nat = ', nat
|
|
||||||
write(2,*) ' nspin = ', nspin
|
|
||||||
!
|
|
||||||
! Place the spins on the lattice
|
|
||||||
!
|
|
||||||
nspin = 0
|
|
||||||
DO j = 0, n-1
|
|
||||||
DO k = 0, m-1
|
|
||||||
DO l = 0, m-1
|
|
||||||
IF ( mod(j+k+l,2) .EQ. 0 ) THEN
|
|
||||||
IF ( ran(iseed) .LT. c ) THEN
|
|
||||||
nspin = nspin + 1
|
|
||||||
s(nspin).x = j
|
|
||||||
s(nspin).y = k
|
|
||||||
s(nspin).z = l
|
|
||||||
END IF
|
|
||||||
END IF
|
|
||||||
END DO
|
|
||||||
END DO
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
! Calculate the 100 shortest distances
|
|
||||||
!
|
|
||||||
write(6,*) ' '
|
|
||||||
write(6,*) ' '
|
|
||||||
!
|
|
||||||
DO j = 1, nspin
|
|
||||||
write(6,9) j, char(13)
|
|
||||||
9 format(' Considering spin ', i5, a1,\)
|
|
||||||
DO k = 1, nspin
|
|
||||||
IF ( k .EQ. j ) THEN
|
|
||||||
dd(k) = 1e10
|
|
||||||
ELSE
|
|
||||||
ix = s(j).x - s(k).x
|
|
||||||
iy = s(j).y - s(k).y
|
|
||||||
IF ( iy .LT. -mh ) iy = iy + m ! periodic boundary along y-axis
|
|
||||||
IF ( iy .GT. mh ) iy = iy - m
|
|
||||||
iz = s(j).z - s(k).z
|
|
||||||
IF ( iz .LT. -mh ) iz = iz + m ! periodic boundary along z-axis
|
|
||||||
IF ( iz .GT. mh ) iz = iz - m
|
|
||||||
dd(k) = (ix*ix + iy*iy + iz*iz)
|
|
||||||
END IF
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
DO ii = 1, 100
|
|
||||||
dd_min = 1E+10
|
|
||||||
DO k = 1, nspin
|
|
||||||
IF ( dd(k) .LT. dd_min ) THEN
|
|
||||||
l = k
|
|
||||||
dd_min = dd(k)
|
|
||||||
END IF
|
|
||||||
END DO
|
|
||||||
i(ii,j).si = l
|
|
||||||
i(ii,j).val = ah * sqrt(dd(l))
|
|
||||||
dd(l) = 1e10
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
! translate distance into interaction strength
|
|
||||||
!
|
|
||||||
DO ii = 1, 100
|
|
||||||
i(ii,j).val = rkky( i(ii,j).val, k_F, T_glass )
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
end_time = dtime(runtime)
|
|
||||||
write(6,*) ' Finally, nspin = ', nspin,' in ', end_time - start_time,' seconds '
|
|
||||||
write(2,*) ' Finally, nspin = ', nspin,' in ', end_time - start_time,' seconds '
|
|
||||||
!
|
|
||||||
! Initialize the spins
|
|
||||||
!
|
|
||||||
start_time = dtime(runtime)
|
|
||||||
!
|
|
||||||
DO j = 1, nspin
|
|
||||||
DO k = 1, 3
|
|
||||||
s(j).c(k) = 2.0*ran(iseed) - 1.0
|
|
||||||
END DO
|
|
||||||
norm = sqrt( sum( s(j).c * s(j).c ) )
|
|
||||||
s(j).c = s(j).c / norm
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
! Calculated the energy and magnetization
|
|
||||||
!
|
|
||||||
97 e = 0.0
|
|
||||||
mag = 0.0
|
|
||||||
!
|
|
||||||
DO j = 1, nspin
|
|
||||||
p = 0.0
|
|
||||||
DO ii = 1, 100
|
|
||||||
p = p + i(ii,j).val * s(i(ii,j).si).c
|
|
||||||
END DO
|
|
||||||
e = e + sum( p * s(j).c ) + sum( b_ext_K * s(j).c )
|
|
||||||
mag = mag + s(j).c
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
end_time = dtime(runtime)
|
|
||||||
!
|
|
||||||
Write(6,971) mag / float(nspin)
|
|
||||||
Write(2,971) mag / float(nspin)
|
|
||||||
971 format(' Magnetization = ',3F8.4)
|
|
||||||
Write(6,972) e / float(nspin), end_time - start_time
|
|
||||||
Write(2,972) e / float(nspin), end_time - start_time
|
|
||||||
972 format( ' Energy = ', E14.4, ' after ', f8.2, ' seconds ' )
|
|
||||||
!
|
|
||||||
! Now start the serious running
|
|
||||||
!
|
|
||||||
91 IF ( .NOT. open_inp ) THEN
|
|
||||||
98 write(6,99)
|
|
||||||
99 format(' Give the number of steps per spin [0: new glass] > '\)
|
|
||||||
read(5,*,err=98) steps_per_spin
|
|
||||||
IF ( steps_per_spin .LE. 0 ) GOTO 777
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
start_time = dtime(runtime) ! record the starttime
|
|
||||||
write(6,*) ' '
|
|
||||||
Write(6,*) ' ' ! to make space for the hashes
|
|
||||||
!
|
|
||||||
! Now comes the real hard work !!!!!!!!!!!
|
|
||||||
!
|
|
||||||
DO mon = 1, steps_per_spin
|
|
||||||
DO j = 1, nspin
|
|
||||||
e = 0.0
|
|
||||||
p = 0.0
|
|
||||||
DO ii = 1, 100
|
|
||||||
p = p + i(ii,j).val * s(i(ii,j).si).c
|
|
||||||
END DO
|
|
||||||
p = p + b_ext_K
|
|
||||||
norm = sqrt( sum( p * p ) )
|
|
||||||
p = p / norm
|
|
||||||
s(j).c = p
|
|
||||||
END DO
|
|
||||||
IF ( mod(mon,100) .EQ. 0 ) idummy = putc('#')
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
876 write(6,*) ' '
|
|
||||||
write(6,*) ' '
|
|
||||||
write(3,rec=1) n,m,nspin,a,moment,T_glass
|
|
||||||
write(3,rec=2) concentration,b_ext,steps_per_spin
|
|
||||||
DO ispin = 1, nspin
|
|
||||||
write(3,rec=ispin+2) s(ispin)
|
|
||||||
END DO
|
|
||||||
close(3)
|
|
||||||
!
|
|
||||||
IF ( open_inp ) THEN
|
|
||||||
DO j = 1, nspin
|
|
||||||
p = 0.0
|
|
||||||
DO ii = 1, 100
|
|
||||||
p = p + i(ii,j).val * s(i(ii,j).si).c
|
|
||||||
END DO
|
|
||||||
e = e + sum( p * s(j).c ) + sum( b_ext_K * s(j).c )
|
|
||||||
mag = mag + s(j).c
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
end_time = dtime(runtime)
|
|
||||||
!
|
|
||||||
Write(6,971) mag / float(nspin)
|
|
||||||
Write(2,971) mag / float(nspin)
|
|
||||||
Write(6,972) e / float(nspin), end_time - start_time
|
|
||||||
Write(2,972) e / float(nspin), end_time - start_time
|
|
||||||
GOTO 888
|
|
||||||
ELSE
|
|
||||||
GOTO 97
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
998 STOP 'ERROR IN INPUT FILE '
|
|
||||||
!
|
|
||||||
999 STOP 'stopped at end of input'
|
|
||||||
!
|
|
||||||
END
|
|
||||||
!
|
|
||||||
!
|
|
||||||
REAL*8 function RKKY(x, k_F, T_glass)
|
|
||||||
real*8 x, k_F, T_glass, xx
|
|
||||||
!
|
|
||||||
! calculates the RKKY interaction,
|
|
||||||
! Te factor of one thousand makes takes care that the RKKY still only
|
|
||||||
! has to be multiplied by the glass-temperature.
|
|
||||||
!
|
|
||||||
xx = 2.0 * k_F * x
|
|
||||||
rkky = 1.0D+03 * T_glass * ( xx * cos(xx) - sin(xx) ) /(xx*xx*xx*xx)
|
|
||||||
!
|
|
||||||
RETURN
|
|
||||||
END
|
|
||||||
@ -1,108 +0,0 @@
|
|||||||
# Microsoft Developer Studio Project File - Name="make spinglass" - Package Owner=<4>
|
|
||||||
# Microsoft Developer Studio Generated Build File, Format Version 6.00
|
|
||||||
# ** DO NOT EDIT **
|
|
||||||
|
|
||||||
# TARGTYPE "Win32 (x86) Console Application" 0x0103
|
|
||||||
|
|
||||||
CFG=make spinglass - Win32 Debug
|
|
||||||
!MESSAGE This is not a valid makefile. To build this project using NMAKE,
|
|
||||||
!MESSAGE use the Export Makefile command and run
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE NMAKE /f "make spinglass.mak".
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE You can specify a configuration when running NMAKE
|
|
||||||
!MESSAGE by defining the macro CFG on the command line. For example:
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE NMAKE /f "make spinglass.mak" CFG="make spinglass - Win32 Debug"
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE Possible choices for configuration are:
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE "make spinglass - Win32 Release" (based on "Win32 (x86) Console Application")
|
|
||||||
!MESSAGE "make spinglass - Win32 Debug" (based on "Win32 (x86) Console Application")
|
|
||||||
!MESSAGE
|
|
||||||
|
|
||||||
# Begin Project
|
|
||||||
# PROP AllowPerConfigDependencies 0
|
|
||||||
# PROP Scc_ProjName ""
|
|
||||||
# PROP Scc_LocalPath ""
|
|
||||||
CPP=cl.exe
|
|
||||||
F90=df.exe
|
|
||||||
RSC=rc.exe
|
|
||||||
|
|
||||||
!IF "$(CFG)" == "make spinglass - Win32 Release"
|
|
||||||
|
|
||||||
# PROP BASE Use_MFC 0
|
|
||||||
# PROP BASE Use_Debug_Libraries 0
|
|
||||||
# PROP BASE Output_Dir "Release"
|
|
||||||
# PROP BASE Intermediate_Dir "Release"
|
|
||||||
# PROP BASE Target_Dir ""
|
|
||||||
# PROP Use_MFC 0
|
|
||||||
# PROP Use_Debug_Libraries 0
|
|
||||||
# PROP Output_Dir "Release"
|
|
||||||
# PROP Intermediate_Dir "Release"
|
|
||||||
# PROP Ignore_Export_Lib 0
|
|
||||||
# PROP Target_Dir ""
|
|
||||||
# ADD BASE F90 /compile_only /nologo /warn:nofileopt
|
|
||||||
# ADD F90 /compile_only /nologo /warn:nofileopt
|
|
||||||
# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
|
|
||||||
# ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
|
|
||||||
# ADD BASE RSC /l 0x409 /d "NDEBUG"
|
|
||||||
# ADD RSC /l 0x409 /d "NDEBUG"
|
|
||||||
BSC32=bscmake.exe
|
|
||||||
# ADD BASE BSC32 /nologo
|
|
||||||
# ADD BSC32 /nologo
|
|
||||||
LINK32=link.exe
|
|
||||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
|
||||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /machine:I386 /out:"Release/make_spinglass.exe"
|
|
||||||
# SUBTRACT LINK32 /incremental:yes
|
|
||||||
|
|
||||||
!ELSEIF "$(CFG)" == "make spinglass - Win32 Debug"
|
|
||||||
|
|
||||||
# PROP BASE Use_MFC 0
|
|
||||||
# PROP BASE Use_Debug_Libraries 1
|
|
||||||
# PROP BASE Output_Dir "Debug"
|
|
||||||
# PROP BASE Intermediate_Dir "Debug"
|
|
||||||
# PROP BASE Target_Dir ""
|
|
||||||
# PROP Use_MFC 0
|
|
||||||
# PROP Use_Debug_Libraries 1
|
|
||||||
# PROP Output_Dir "Debug"
|
|
||||||
# PROP Intermediate_Dir "Debug"
|
|
||||||
# PROP Ignore_Export_Lib 0
|
|
||||||
# PROP Target_Dir ""
|
|
||||||
# ADD BASE F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
|
|
||||||
# ADD F90 /check:bounds /compile_only /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
|
|
||||||
# ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
|
|
||||||
# ADD CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
|
|
||||||
# ADD BASE RSC /l 0x409 /d "_DEBUG"
|
|
||||||
# ADD RSC /l 0x409 /d "_DEBUG"
|
|
||||||
BSC32=bscmake.exe
|
|
||||||
# ADD BASE BSC32 /nologo
|
|
||||||
# ADD BSC32 /nologo
|
|
||||||
LINK32=link.exe
|
|
||||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
|
|
||||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /incremental:no /debug /machine:I386 /out:"Debug/make_spinglass.exe" /pdbtype:sept
|
|
||||||
|
|
||||||
!ENDIF
|
|
||||||
|
|
||||||
# Begin Target
|
|
||||||
|
|
||||||
# Name "make spinglass - Win32 Release"
|
|
||||||
# Name "make spinglass - Win32 Debug"
|
|
||||||
# Begin Group "Source Files"
|
|
||||||
|
|
||||||
# PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat;f90;for;f;fpp"
|
|
||||||
# Begin Source File
|
|
||||||
|
|
||||||
SOURCE=".\Zero Temperature.f90"
|
|
||||||
# End Source File
|
|
||||||
# End Group
|
|
||||||
# Begin Group "Header Files"
|
|
||||||
|
|
||||||
# PROP Default_Filter "h;hpp;hxx;hm;inl;fi;fd"
|
|
||||||
# End Group
|
|
||||||
# Begin Group "Resource Files"
|
|
||||||
|
|
||||||
# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
|
|
||||||
# End Group
|
|
||||||
# End Target
|
|
||||||
# End Project
|
|
||||||
@ -1,19 +0,0 @@
|
|||||||
<html>
|
|
||||||
<body>
|
|
||||||
<pre>
|
|
||||||
<h1>Build Log</h1>
|
|
||||||
<h3>
|
|
||||||
--------------------Configuration: make spinglass - Win32 Debug--------------------
|
|
||||||
</h3>
|
|
||||||
<h3>Command Lines</h3>
|
|
||||||
Creating command line "link.exe kernel32.lib /nologo /subsystem:console /incremental:no /pdb:"Debug/make_spinglass.pdb" /debug /machine:I386 /out:"Debug/make_spinglass.exe" /pdbtype:sept ".\Debug\Zero Temperature.obj" "
|
|
||||||
<h3>Output Window</h3>
|
|
||||||
Linking...
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
<h3>Results</h3>
|
|
||||||
make_spinglass.exe - 0 error(s), 0 warning(s)
|
|
||||||
</pre>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
@ -1,89 +0,0 @@
|
|||||||
Microsoft Developer Studio Workspace File, Format Version 6.00
|
|
||||||
# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
|
|
||||||
|
|
||||||
###############################################################################
|
|
||||||
|
|
||||||
Project: "dipole field calculation"=".\dipole field calculation\dipole field calculation.dsp" - Package Owner=<4>
|
|
||||||
|
|
||||||
Package=<5>
|
|
||||||
{{{
|
|
||||||
}}}
|
|
||||||
|
|
||||||
Package=<4>
|
|
||||||
{{{
|
|
||||||
}}}
|
|
||||||
|
|
||||||
###############################################################################
|
|
||||||
|
|
||||||
Project: "dynamics"=.\dynamics\dynamics.dsp - Package Owner=<4>
|
|
||||||
|
|
||||||
Package=<5>
|
|
||||||
{{{
|
|
||||||
}}}
|
|
||||||
|
|
||||||
Package=<4>
|
|
||||||
{{{
|
|
||||||
}}}
|
|
||||||
|
|
||||||
###############################################################################
|
|
||||||
|
|
||||||
Project: "index"=.\index\index.dsp - Package Owner=<4>
|
|
||||||
|
|
||||||
Package=<5>
|
|
||||||
{{{
|
|
||||||
}}}
|
|
||||||
|
|
||||||
Package=<4>
|
|
||||||
{{{
|
|
||||||
}}}
|
|
||||||
|
|
||||||
###############################################################################
|
|
||||||
|
|
||||||
Project: "make spinglass"=".\make spinglass\make spinglass.dsp" - Package Owner=<4>
|
|
||||||
|
|
||||||
Package=<5>
|
|
||||||
{{{
|
|
||||||
}}}
|
|
||||||
|
|
||||||
Package=<4>
|
|
||||||
{{{
|
|
||||||
}}}
|
|
||||||
|
|
||||||
###############################################################################
|
|
||||||
|
|
||||||
Project: "test"=.\test\test.dsp - Package Owner=<4>
|
|
||||||
|
|
||||||
Package=<5>
|
|
||||||
{{{
|
|
||||||
}}}
|
|
||||||
|
|
||||||
Package=<4>
|
|
||||||
{{{
|
|
||||||
}}}
|
|
||||||
|
|
||||||
###############################################################################
|
|
||||||
|
|
||||||
Project: "to_plot"=.\to_plot\to_plot.dsp - Package Owner=<4>
|
|
||||||
|
|
||||||
Package=<5>
|
|
||||||
{{{
|
|
||||||
}}}
|
|
||||||
|
|
||||||
Package=<4>
|
|
||||||
{{{
|
|
||||||
}}}
|
|
||||||
|
|
||||||
###############################################################################
|
|
||||||
|
|
||||||
Global:
|
|
||||||
|
|
||||||
Package=<5>
|
|
||||||
{{{
|
|
||||||
}}}
|
|
||||||
|
|
||||||
Package=<3>
|
|
||||||
{{{
|
|
||||||
}}}
|
|
||||||
|
|
||||||
###############################################################################
|
|
||||||
|
|
||||||
Binary file not shown.
Binary file not shown.
@ -1,60 +0,0 @@
|
|||||||
|
|
||||||
------------------------------------------------------------------------------
|
|
||||||
u:\simulations\output_5.txt
|
|
||||||
------------------------------------------------------------------------------
|
|
||||||
Calculation started 2005- 9-29 at 15:32
|
|
||||||
------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
sample = 5.0 nanometer thick, and 30.0 nanometer wide.
|
|
||||||
concentration = 2.0 at. %
|
|
||||||
anisotropy = F
|
|
||||||
number of muons = 5000
|
|
||||||
number of spins = 1
|
|
||||||
average field = -0.597E-06 -0.612E-06 0.236E-06 tesla
|
|
||||||
second moment = 0.584E-05 0.472E-05 0.363E-05 tesla
|
|
||||||
cpu_time = -0.313E-01 seconds
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
|
||||||
u:\simulations\output_5.txt
|
|
||||||
------------------------------------------------------------------------------
|
|
||||||
Calculation started 2005- 9-29 at 15:32
|
|
||||||
------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
sample = 5.0 nanometer thick, and 50.0 nanometer wide.
|
|
||||||
concentration = 2.0 at. %
|
|
||||||
anisotropy = F
|
|
||||||
number of muons = 5000
|
|
||||||
number of spins = 4
|
|
||||||
average field = -0.448E-05 0.175E-07 0.759E-06 tesla
|
|
||||||
second moment = 0.317E-04 0.236E-04 0.221E-04 tesla
|
|
||||||
cpu_time = -0.156E-01 seconds
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
|
||||||
u:\simulations\output_5.txt
|
|
||||||
------------------------------------------------------------------------------
|
|
||||||
Calculation started 2005- 9-29 at 15:32
|
|
||||||
------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
sample = 5.0 nanometer thick, and 15.0 nanometer wide.
|
|
||||||
concentration = 2.0 at. %
|
|
||||||
anisotropy = F
|
|
||||||
number of muons = 5000
|
|
||||||
number of spins = 3
|
|
||||||
average field = 0.780E-05 0.826E-06 -0.503E-05 tesla
|
|
||||||
second moment = 0.228E-04 0.128E-04 0.193E-04 tesla
|
|
||||||
cpu_time = 0.000E+00 seconds
|
|
||||||
|
|
||||||
------------------------------------------------------------------------------
|
|
||||||
u:\simulations\output_5.txt
|
|
||||||
------------------------------------------------------------------------------
|
|
||||||
Calculation started 2005- 9-29 at 15:32
|
|
||||||
------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
sample = 5.0 nanometer thick, and 10.0 nanometer wide.
|
|
||||||
concentration = 2.0 at. %
|
|
||||||
anisotropy = F
|
|
||||||
number of muons = 5000
|
|
||||||
number of spins = 1
|
|
||||||
average field = -0.323E-05 -0.223E-05 0.446E-05 tesla
|
|
||||||
second moment = 0.483E-05 0.404E-05 0.583E-05 tesla
|
|
||||||
cpu_time = 0.000E+00 seconds
|
|
||||||
@ -1,644 +0,0 @@
|
|||||||
! Program to calculate dipolar fields in spinglasses,
|
|
||||||
! their distribution and the depolarization of the muon
|
|
||||||
!
|
|
||||||
! Ge Nieuwenhuys, March, September, October 2005
|
|
||||||
!
|
|
||||||
! October 12: periodic boundary conditions in y- z plane
|
|
||||||
! October 14: random number start randomly (based on clock) for
|
|
||||||
! batch calculations.
|
|
||||||
! October 14: output-file-names are automatically indexed.
|
|
||||||
! October 17: oversized the recordlength of the direct-accessfile for
|
|
||||||
! unknown, but apparently essential reasons.
|
|
||||||
!
|
|
||||||
! Spins are located on a fcc lattice
|
|
||||||
!
|
|
||||||
! nspin number of spins
|
|
||||||
! nsp number of spins asked
|
|
||||||
! d thickness
|
|
||||||
! a lattice constant
|
|
||||||
! ah half of lattice constant
|
|
||||||
!
|
|
||||||
Use DFPORT ! library only needed for obtaining CPU-time
|
|
||||||
Use DFLIB
|
|
||||||
!
|
|
||||||
! Structure to store the position (as lattice site-indexes)
|
|
||||||
! and the direction-cosines of each spin.
|
|
||||||
!
|
|
||||||
structure /spin/
|
|
||||||
integer*4 x,y,z
|
|
||||||
real*8 dir(3)
|
|
||||||
end structure
|
|
||||||
!
|
|
||||||
! Declarations, maximumnumber of spins: max_spins, maxd is the maximum number of
|
|
||||||
! unitcell-distance for which the spin in included in the calculation
|
|
||||||
!
|
|
||||||
parameter( max_spins = 3000000, & ! maximum number of magnetic moments
|
|
||||||
& gyro = 135.5, & ! gyromagnetic ratio of muon
|
|
||||||
& twpi = 6.2831, & ! two times Pi
|
|
||||||
& radius = 2.0, & ! maxinum distance [nm] for
|
|
||||||
! the dipole-field will be calculated
|
|
||||||
& range = 10.0, & ! maximum absolute value of the field expected
|
|
||||||
& mrange = 4000, & ! range of the integer histograms
|
|
||||||
& nrange = 80 ) ! range of the normalized histograms
|
|
||||||
!
|
|
||||||
character*10 dddd, tttt, zone
|
|
||||||
character*4 file_index
|
|
||||||
integer*4 dt(8), ifile, l_calc
|
|
||||||
character*80 comment, calculation, line
|
|
||||||
logical in_open, out_open, g_t_open, his_open, sgl, sgl_open
|
|
||||||
integer*4 j,k,l,m,n, nsp, nspin, nat, id, ihist(3,-mrange:mrange)
|
|
||||||
integer*4 iseed, maxfield, minfield, ihis, ibin, nd1, nd2, kd, ld, mh
|
|
||||||
record /spin/ s(max_spins)
|
|
||||||
real*8 d, concentration, c, dd(max_spins), w, depth1, depth2
|
|
||||||
real*8 px(max_spins),py(max_spins), pz(max_spins)
|
|
||||||
real*8 b(3), factor, moment, help, r_3, r_5, r(3), p_r, sq_3, h(3)
|
|
||||||
real*8 fraction, norm, aver_b(3), sigma_b(3), delta(3), anisotropy, b_ext(3)
|
|
||||||
real*8 g_t(3,0:999), omega, b_abs, b_sq, ca_sq, his, radiussq
|
|
||||||
real*4 runtime(2), start_time, end_time
|
|
||||||
real*8 eb(3), emu(3), cc, ss, theta, phi
|
|
||||||
!
|
|
||||||
Write(6,*) ' '
|
|
||||||
Write(6,*) ' ---------------------------------------------------------------------'
|
|
||||||
Write(6,*) ' | Program field-calculation of muons due to random static spins |'
|
|
||||||
Write(6,*) ' | Version of October 31, 2005 |'
|
|
||||||
Write(6,*) ' | |'
|
|
||||||
Write(6,*) ' | Input can also be read from an input file that should be named |'
|
|
||||||
Write(6,*) ' | <calculation>.inp and contain: |'
|
|
||||||
Write(6,*) ' | |'
|
|
||||||
Write(6,*) ' | ext. field(3) ,thickness, width, c, number_of_muons, |'
|
|
||||||
Write(6,*) ' | lattice-constant [nm], magnetic moment [mu_B], |'
|
|
||||||
Write(6,*) ' | initial-muon-direction(theta, phi)[degrees], |'
|
|
||||||
Write(6,*) ' | (muon-positions from) depth1, (to) depth2 [nm], |'
|
|
||||||
Write(6,*) ' | anisotropy [isotropic=1, planar <1, axial >1 |'
|
|
||||||
Write(6,*) ' | (neg: ferromagnetic along the |'
|
|
||||||
Write(6,*) ' | x - axis (anisotropy = -1.0) |'
|
|
||||||
Write(6,*) ' | y - axis (anisotropy = -2.0) |'
|
|
||||||
Write(6,*) ' | z - axis (anisotropy = -3.0) |'
|
|
||||||
Write(6,*) ' | |'
|
|
||||||
Write(6,*) ' | O R |'
|
|
||||||
Write(6,*) ' | |'
|
|
||||||
Write(6,*) ' | name of the <spin-glass>.sgl file produced by |'
|
|
||||||
Write(6,*) ' | MAKE SPINGLASS (starting on the first position), |'
|
|
||||||
Write(6,*) ' | number_of_muons, |'
|
|
||||||
Write(6,*) ' | initial-muon-direction(theta, phi)[degrees], |'
|
|
||||||
Write(6,*) ' | (muon-positions from) depth1, (to) depth2 [nm], |'
|
|
||||||
Write(6,*) ' | |'
|
|
||||||
write(6,*) ' | Lines starting with ! (first position) are treated as comments. |'
|
|
||||||
Write(6,*) ' | <calculation> can be issued as a commandline parameter |'
|
|
||||||
Write(6,*) ' ---------------------------------------------------------------------'
|
|
||||||
!
|
|
||||||
! files :
|
|
||||||
!
|
|
||||||
open(9,file='\simulations\counter.his',status='old')
|
|
||||||
read(9,*) ifile ! initialize outputfile counter
|
|
||||||
!
|
|
||||||
! write(6,*) ' iargc = ', iargc()
|
|
||||||
IF ( iargc() .GT. 0 ) THEN
|
|
||||||
call getarg(1, calculation)
|
|
||||||
Write(6,*) ' Calculation taken from commandline > ',calculation
|
|
||||||
ELSE
|
|
||||||
200 write(6,201)
|
|
||||||
201 format(' '/' Give name of the calculation > ', \)
|
|
||||||
read(5,'(a60)') calculation
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
l_calc = index( calculation, ' ') - 1
|
|
||||||
!
|
|
||||||
IF ( l_calc .GT. 0 ) THEN
|
|
||||||
open(1,file=calculation(1:l_calc)//'.inp',status='old',action='read',err=200 )
|
|
||||||
open(2,file=calculation(1:l_calc)//'.out',status='unknown',action='write')
|
|
||||||
!
|
|
||||||
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
inquire(1, opened = in_open )
|
|
||||||
inquire(2, opened = out_open )
|
|
||||||
!
|
|
||||||
! initialization of randomumber generator
|
|
||||||
!
|
|
||||||
iseed = 1234567
|
|
||||||
!
|
|
||||||
! Get eventually other values from the iput file
|
|
||||||
!
|
|
||||||
111 IF (in_open) THEN
|
|
||||||
!
|
|
||||||
! Read everything from the input file, one line per calculation
|
|
||||||
!
|
|
||||||
ifile = ifile + 1 ! increase outputfile number
|
|
||||||
rewind(9)
|
|
||||||
write(9,*) ifile ! store for next program
|
|
||||||
write(file_index,'(''_'',i3)') ifile ! generate file_name
|
|
||||||
DO j = 2, 4
|
|
||||||
IF (file_index(j:j) .EQ. ' ' ) file_index(j:j) = '0'
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
|
|
||||||
open(3,file=calculation(1:l_calc)//file_index//'.g_t',status='unknown',action='write')
|
|
||||||
open(4,file=calculation(1:l_calc)//file_index//'.his',status='unknown',action='write')
|
|
||||||
!
|
|
||||||
inquire(3, opened = g_t_open )
|
|
||||||
inquire(4, opened = his_open )
|
|
||||||
!
|
|
||||||
112 read(1,'(a80)',end=999) line
|
|
||||||
IF ( ( line(1:1) .GE. 'a' .AND. line(1:1) .LE. 'z' ) .OR. &
|
|
||||||
& ( line(1:1) .GE. 'A' .AND. line(1:1) .LE. 'Z' ) ) THEN
|
|
||||||
l = index( line, ' ') - 1
|
|
||||||
write(6,*) line(1:l)
|
|
||||||
open(7,file=line(1:l)//'.sgl',status='old', &
|
|
||||||
& access='direct',form='binary',recl=40,action='read',err=998)
|
|
||||||
read(line(l+1:80),*,err=998,end=999) n_site, theta, phi, depth1, depth2
|
|
||||||
ELSE
|
|
||||||
IF ( line(1:1) .EQ. '!' ) THEN
|
|
||||||
write(2,'(a)') line
|
|
||||||
GOTO 112
|
|
||||||
ELSE
|
|
||||||
read(line,*,err=998,end=999) a, moment, b_ext, d, w, concentration, &
|
|
||||||
& n_site, theta, phi, depth1, depth2, anisotropy
|
|
||||||
END IF
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
! Initialize randomnumber generator "randomly"
|
|
||||||
!
|
|
||||||
call date_and_time( dddd, tttt, zone, dt )
|
|
||||||
DO i = 1, dt(8) ! number milliseconds on the clock
|
|
||||||
dummy = rand(iseed)
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
ELSE
|
|
||||||
!
|
|
||||||
! put standard values in the case of on-line calculation
|
|
||||||
! for the lattice (4 nm), moment (2 uB), external field (0,0,0) and
|
|
||||||
! initial_muon_spin in y-direction
|
|
||||||
!
|
|
||||||
!
|
|
||||||
a = 0.4 ! Assume 0.4 nanometer
|
|
||||||
moment = 2.0 ! Assume 2 Bohrmagneton per spin
|
|
||||||
b_ext = 0.0 ! No external field
|
|
||||||
emu = 0.0
|
|
||||||
emu(2) = 1.0 ! initial muon direction along y-axis
|
|
||||||
!
|
|
||||||
!
|
|
||||||
! Ask size of the system
|
|
||||||
!
|
|
||||||
3 write(6,4)
|
|
||||||
4 format( ' What thickness [nm] (0=stop) ? '\)
|
|
||||||
read(5,*,err=3) d
|
|
||||||
IF ( d .LT. 0.0 ) GOTO 3
|
|
||||||
IF ( d .EQ. 0.0 ) THEN
|
|
||||||
Write(6,*) ' '
|
|
||||||
STOP ' program terminated by operator'
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
5 write(6,6)
|
|
||||||
6 format( ' What width [nm] ? '\)
|
|
||||||
read(5,*,err=5) w
|
|
||||||
IF ( w .LE. 0.0 ) GOTO 5
|
|
||||||
depth1 = 0.0
|
|
||||||
depth2 = w
|
|
||||||
!
|
|
||||||
7 write(6,8)
|
|
||||||
8 format( ' Which concentration [at.%] ? '\)
|
|
||||||
read(5,*,err=7) concentration
|
|
||||||
IF ( concentration .LE. 0.0 ) GOTO 7
|
|
||||||
!
|
|
||||||
! Ask for the anisotropy.
|
|
||||||
! The random value of the direction cosin in the x-direction is multiplied
|
|
||||||
! by anisotropy before normalization
|
|
||||||
!
|
|
||||||
9 write(6,10)
|
|
||||||
10 format( ' The random value of the direction cosin in the x-direction'/ &
|
|
||||||
& ' is multiplied by anisotropy before normalization'/ &
|
|
||||||
& ' Anisotropy [isotrope == 1] ? '\)
|
|
||||||
read(5,*,err=9) anisotropy
|
|
||||||
!
|
|
||||||
20 write(6,21)
|
|
||||||
21 format( ' Give value of the external field (x=perp to film,'/ &
|
|
||||||
& ' y=initial_muon > '\)
|
|
||||||
read(5,*,err=20) b_ext
|
|
||||||
!
|
|
||||||
END IF ! end reading from input file / keyboard
|
|
||||||
!
|
|
||||||
!----------------------------------------------------------------------------------------
|
|
||||||
! Start calculation
|
|
||||||
!----------------------------------------------------------------------------------------
|
|
||||||
call date_and_time( dddd, tttt, zone, dt )
|
|
||||||
!
|
|
||||||
! If a spinglass has been simulated by MAKE SPINGLASS, then
|
|
||||||
! the <calculation>.sgl file will be read, ELSE a random
|
|
||||||
! glass will be generated here.
|
|
||||||
!
|
|
||||||
inquire(7, opened = sgl_open )
|
|
||||||
!
|
|
||||||
IF ( sgl_open ) THEN ! spin glass has been made
|
|
||||||
read(7,rec=1) n,m,nspin,a,moment,T_glass
|
|
||||||
read(7,rec=2) concentration,b_ext,steps_per_spin
|
|
||||||
DO ispin = 1, nspin
|
|
||||||
read(7,rec=ispin+2) s(ispin)
|
|
||||||
END DO
|
|
||||||
close(7)
|
|
||||||
!
|
|
||||||
ELSE ! spin glass has NOT been made
|
|
||||||
!
|
|
||||||
c = concentration / 100.0
|
|
||||||
!
|
|
||||||
! Calculate the 'rounded' number of spins for a lattice n*m*m for
|
|
||||||
! the given concentration.
|
|
||||||
! n is the number of atoms (half unitcells) perpendicular
|
|
||||||
! to the layer (== x-direction).
|
|
||||||
! m is the size of the layer in the y- ad z-direction
|
|
||||||
!
|
|
||||||
n = floor(2.0 * d / a ) + 2
|
|
||||||
m = floor(2.0 * w / a ) + 2
|
|
||||||
nat = m * m * n / 2
|
|
||||||
nspin = floor( nat * c )
|
|
||||||
!
|
|
||||||
IF (nspin .GE. max_spins ) THEN
|
|
||||||
Write(6,*) ' '
|
|
||||||
Write(6,*) ' Too many spins: ', nspin
|
|
||||||
IF ( out_open ) Write(2,*) ' Too many spins: ', nspin
|
|
||||||
GOTO 111
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
! Place the spins randomly on the fcc-lattice
|
|
||||||
! Run over a whole simple cubic lattice in steps
|
|
||||||
! of half of the fcc-unitcell.
|
|
||||||
! Then take care of the fcc-structure and
|
|
||||||
! decide whether or not to place a spin.
|
|
||||||
!
|
|
||||||
nspin = 0
|
|
||||||
!
|
|
||||||
DO j = 0, n-1
|
|
||||||
DO k = 0, m-1
|
|
||||||
DO l = 0, m-1
|
|
||||||
IF ( mod(j+k+l,2) .EQ. 0 ) THEN ! This takes care of the fcc structure.
|
|
||||||
IF ( ran(iseed) .LT. c ) THEN
|
|
||||||
nspin = nspin + 1
|
|
||||||
s(nspin).x = j
|
|
||||||
s(nspin).y = k
|
|
||||||
s(nspin).z = l
|
|
||||||
|
|
||||||
IF (anisotropy .GE. 0.0 ) THEN
|
|
||||||
!
|
|
||||||
! Give the spin an arbitrary direction
|
|
||||||
!
|
|
||||||
DO i = 1, 3
|
|
||||||
h(i) = 2.0D+00 * ran(iseed) - 1.0D+00
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
! The anisotropy is taken care off by
|
|
||||||
! multiplying the direction cosine in
|
|
||||||
! the x-direction with ANOSOTROPY
|
|
||||||
! before normalizing the direction cosines.
|
|
||||||
!
|
|
||||||
h(1) = anisotropy * h(1)
|
|
||||||
norm = sum( h * h )
|
|
||||||
h = h / sqrt( norm )
|
|
||||||
ELSE
|
|
||||||
h = 0.0
|
|
||||||
h(-int(anisotropy)) = 1.0
|
|
||||||
END IF
|
|
||||||
|
|
||||||
s(nspin).dir = h
|
|
||||||
!
|
|
||||||
END IF
|
|
||||||
END IF
|
|
||||||
END DO
|
|
||||||
END DO
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
! The sample has been grown now.
|
|
||||||
!
|
|
||||||
Write(6,*) ' '
|
|
||||||
Write(6,*) 'The sample has been grown, calculation can start'
|
|
||||||
Write(6,*) ' '
|
|
||||||
!
|
|
||||||
END IF ! Of reading ,calculation>.sgl or
|
|
||||||
! growing magnetic structure
|
|
||||||
!
|
|
||||||
! Now start the serious work.
|
|
||||||
!
|
|
||||||
! Use half of the lattice parameter as unit of length
|
|
||||||
!
|
|
||||||
ah = a / 2.0
|
|
||||||
!
|
|
||||||
! help for periodic boundary conditions
|
|
||||||
!
|
|
||||||
mh = m / 2
|
|
||||||
!
|
|
||||||
! the maximum distance squared in units of ah:
|
|
||||||
!
|
|
||||||
radiussq = radius * radius / ( ah * ah )
|
|
||||||
!
|
|
||||||
! Calculate factor to translate to the correct dimensions.
|
|
||||||
!
|
|
||||||
! factor is ( mu_o / 4 Pi ) * moment * mu_B / ( ah^3 )
|
|
||||||
! -- ALL in MKS units --
|
|
||||||
! so that the "field" can be calculated as
|
|
||||||
! 1/r^5 ( 3 * (s.dir *** r) * r - r^2 s.dir ),
|
|
||||||
! where s.dir is the unit vector to the direction of the magnetic moment,
|
|
||||||
! and *** stands for the dot-product.
|
|
||||||
!
|
|
||||||
factor = 1D-07 * moment * 9.2740019D-24 / ( ah*ah*ah * 1D-27 )
|
|
||||||
!
|
|
||||||
! see where the muons should go
|
|
||||||
!
|
|
||||||
nd1 = floor( depth1 / ah )
|
|
||||||
nd2 = floor( depth2 / ah )
|
|
||||||
IF ( mod( nd1 , 2 ) .EQ. 0 ) nd1 = nd1 + 1 ! nd1 should be odd
|
|
||||||
IF ( nd2 .LT. nd1 + 1 ) nd2 = nd1 + 1
|
|
||||||
!
|
|
||||||
! calculate unit vector along the initial muon-spin direction
|
|
||||||
!
|
|
||||||
emu(1) = sin( twpi * theta / 360.0 ) * cos( twpi * phi / 360.0)
|
|
||||||
emu(2) = sin( twpi * theta / 360.0 ) * sin( twpi * phi / 360.0)
|
|
||||||
emu(3) = cos( twpi * theta / 360.0 )
|
|
||||||
!
|
|
||||||
! Ask the number of sites to calculated, about 10,000 is reasonable
|
|
||||||
!
|
|
||||||
IF ( .NOT. in_open ) THEN ! read keyboard if no input file
|
|
||||||
!
|
|
||||||
write(6,*) ' total number of muon-sites :', (m-1)*(m-1)*(nd2-nd1+1) / 8
|
|
||||||
write(6,*) ' '
|
|
||||||
11 write(6,12)
|
|
||||||
12 format(' Give number of sites to be calculated > ' $)
|
|
||||||
read(5,*,err=11) n_site
|
|
||||||
!
|
|
||||||
END IF ! of reading keyboard
|
|
||||||
!
|
|
||||||
fraction = dble( float(n_site) / float( (m-1)*(m-1)*(nd2-nd1+1)/8 ))
|
|
||||||
!
|
|
||||||
! make some space
|
|
||||||
!
|
|
||||||
Write(6,*) ' '
|
|
||||||
Write(6,*) ' '
|
|
||||||
!
|
|
||||||
start_time = dtime(runtime) ! record the starttime
|
|
||||||
!
|
|
||||||
! Initialize the averages
|
|
||||||
!
|
|
||||||
ib = 0 ! index of field calculation
|
|
||||||
aver_b = 0 ! average of the field
|
|
||||||
sigma_b = 0 ! average of the field squared
|
|
||||||
hist = 0 ! histograms
|
|
||||||
g_t = 0.0 ! initialize the line
|
|
||||||
!
|
|
||||||
! Assume the muon to be in the center of the fcc-cube
|
|
||||||
!
|
|
||||||
DO j = nd1, nd2, 2
|
|
||||||
DO k = 1, m-1, 2
|
|
||||||
DO l = 1, m-1, 2
|
|
||||||
!
|
|
||||||
! These do-loops run over all sites, which is probably too much (time consuming)
|
|
||||||
! Therefore select randomly sufficient (see above) fraction of
|
|
||||||
! the possible muon sites and calculate the dipolar field.
|
|
||||||
!
|
|
||||||
IF ( ran(iseed) .LT. fraction ) THEN
|
|
||||||
!
|
|
||||||
! Calculate the field by running over all spins.
|
|
||||||
! In calculating the mutual distance, periodic boundaryconditions are applied
|
|
||||||
! in the y- and z-direction, but NOT in the x-direction, since that is supposed
|
|
||||||
! perpendicular to the film
|
|
||||||
!
|
|
||||||
! The field is only calculated when the distance is smaller then radius
|
|
||||||
!
|
|
||||||
b = 0
|
|
||||||
!
|
|
||||||
DO i = 1, nspin
|
|
||||||
r(1) = dble(float(j-s(i).x))
|
|
||||||
kd = k - s(i).y
|
|
||||||
IF ( kd .LT. -mh ) kd = kd + m ! periodic boundary condition
|
|
||||||
IF ( kd .GT. mh ) kd = kd - m ! periodic boundary condition
|
|
||||||
r(2) = dble(float(kd))
|
|
||||||
ld = l - s(i).z
|
|
||||||
IF ( ld .LT. -mh ) ld = ld + m ! periodic boundary condition
|
|
||||||
IF ( ld .GT. mh ) ld = ld - m ! periodic boundary condition
|
|
||||||
r(3) = dble(float(ld))
|
|
||||||
r_2 = sum( r * r )
|
|
||||||
!
|
|
||||||
IF ( r_2 .LE. radiussq ) THEN ! skip calculation if distance is too large
|
|
||||||
help = sqrt( r_2 )
|
|
||||||
r_3 = r_2 * help
|
|
||||||
r_5 = r_2 * r_3
|
|
||||||
h = s(i).dir
|
|
||||||
p_r = sum( h * r )
|
|
||||||
b = b + ( 3.0D+00 * p_r * r - r_2 * h ) / r_5
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
ib = ib + 1 ! count the sites calculated.
|
|
||||||
b = factor * b ! get correct dimensions
|
|
||||||
aver_b = aver_b + b ! add the field to the averages
|
|
||||||
sigma_b = sigma_b + b*b
|
|
||||||
!
|
|
||||||
!
|
|
||||||
! Count for histograms
|
|
||||||
!
|
|
||||||
DO ih = 1, 3
|
|
||||||
ival = int( float(mrange) * b(ih) / range + 0.5D+00 )
|
|
||||||
IF ( abs(ival) .LE. mrange ) ihist(ih,ival) = ihist(ih,ival) + 1
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
b = b + b_ext ! add external field
|
|
||||||
b_sq = sum( b * b ) ! square of the field
|
|
||||||
b_abs = sqrt( b_sq ) ! absolute value
|
|
||||||
eb = b / b_abs ! unit vector
|
|
||||||
omega = gyro * twpi * b_abs ! precession frequency
|
|
||||||
!
|
|
||||||
! Calculate the rotation of the muonspin for 1000 time-steps.
|
|
||||||
! The contribution to the asymmetry equals the components of the temporal
|
|
||||||
! muonspin, assuming the counters to be forward-backward, left-right ,and up-down,
|
|
||||||
! respectively.
|
|
||||||
!
|
|
||||||
DO it = 0, 999
|
|
||||||
t = 1.0D-02 * dble(float(it))
|
|
||||||
cc = cos( omega * t )
|
|
||||||
ss = sin( omega * t )
|
|
||||||
!
|
|
||||||
g_t(1,it) = g_t(1,it) + &
|
|
||||||
& ( cc+eb(1)*eb(1)*(1-cc)) * emu(1) + &
|
|
||||||
& ( -eb(3)*ss+eb(1)*eb(2)*(1-cc)) * emu(2) + &
|
|
||||||
& ( eb(2)*ss+eb(1)*eb(3)*(1-cc)) * emu(3)
|
|
||||||
!
|
|
||||||
g_t(2,it) = g_t(2,it) + &
|
|
||||||
& ( eb(3)*ss+eb(1)*eb(2)*(1-cc)) * emu(1) + &
|
|
||||||
& ( cc+eb(2)*eb(2)*(1-cc)) * emu(2) + &
|
|
||||||
& ( -eb(1)*ss+eb(2)*eb(3)*(1-cc)) * emu(3)
|
|
||||||
!
|
|
||||||
g_t(3,it) = g_t(3,it) + &
|
|
||||||
& ( -eb(2)*ss+eb(1)*eb(3)*(1-cc)) * emu(1) + &
|
|
||||||
& ( eb(1)*ss+eb(2)*eb(3)*(1-cc)) * emu(2) + &
|
|
||||||
& ( cc+eb(3)*eb(3)*(1-cc)) * emu(3)
|
|
||||||
!
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
IF ( mod(ib,1000) .EQ. 0 ) idummy = putc('#')
|
|
||||||
!
|
|
||||||
END IF ! decision on fraction of muon sites
|
|
||||||
END DO
|
|
||||||
END DO
|
|
||||||
END DO ! l, k, j loops
|
|
||||||
!
|
|
||||||
! Average over all calculaled sites.
|
|
||||||
!
|
|
||||||
norm = dble( float(ib))
|
|
||||||
aver_b = aver_b / norm
|
|
||||||
sigma_b = sqrt( (sigma_b - aver_b * aver_b ) / norm )
|
|
||||||
delta = gyro * sigma_b
|
|
||||||
g_t = g_t / norm
|
|
||||||
!
|
|
||||||
! Renormalize histograms
|
|
||||||
!
|
|
||||||
IF ( his_open ) THEN ! Should the histogram be calculated ??
|
|
||||||
Write(4,*) '-------------------------------------------------------'
|
|
||||||
!
|
|
||||||
! Check whether the maximum calculated field exceeds the range
|
|
||||||
!
|
|
||||||
IF ( ihist(1,-mrange) .EQ. 0 .AND. ihist(1,mrange) .EQ. 0 .AND. &
|
|
||||||
& ihist(2,-mrange) .EQ. 0 .AND. ihist(2,mrange) .EQ. 0 .AND. &
|
|
||||||
& ihist(3,-mrange) .EQ. 0 .AND. ihist(3,mrange) .EQ. 0 ) THEN
|
|
||||||
!
|
|
||||||
! determine the range of fields found
|
|
||||||
!
|
|
||||||
DO j = 1, 3
|
|
||||||
DO k = -mrange, mrange
|
|
||||||
IF ( ihist(j, k) .GT. 0 ) maxfield = k
|
|
||||||
IF ( ihist(j,-k) .GT. 0 ) minfield = -k
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
! adjust binning of histogram and write values
|
|
||||||
!
|
|
||||||
ibin = (maxfield - minfield) / nrange + 1
|
|
||||||
x = float(minfield) * range / float(mrange)
|
|
||||||
step = range * float(ibin) / float(mrange)
|
|
||||||
!
|
|
||||||
write(6,*) ' The field histogram vaues are: '
|
|
||||||
write(6,*) minfield, maxfield, ibin, x, step
|
|
||||||
!
|
|
||||||
DO i = minfield, maxfield, ibin
|
|
||||||
ihis = 0
|
|
||||||
DO k = 0, ibin-1
|
|
||||||
ihis = ihis + ihist(j,i+k)
|
|
||||||
END DO
|
|
||||||
his = float(ihis) / norm
|
|
||||||
Write(4,'(2E16.6)') x, his
|
|
||||||
x = x + step
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
Write(4,*) ' '
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
ELSE
|
|
||||||
Write(4,*) ' Fields exceed the maximum field for histogram calculation '
|
|
||||||
END IF
|
|
||||||
END IF ! Histogram calculation
|
|
||||||
!
|
|
||||||
end_time = dtime(runtime)
|
|
||||||
!
|
|
||||||
write(6,*) ' '
|
|
||||||
write(2,100) comment(1:73),(dt(j),j=1,3),(dt(j),j=5,8)
|
|
||||||
write(6,101) n*ah, m*ah
|
|
||||||
write(6,301) nd1*ah, nd2*ah
|
|
||||||
write(6,102) concentration
|
|
||||||
write(6,103) anisotropy, int(-anisotropy)
|
|
||||||
write(6,104) n_site
|
|
||||||
write(6,304) theta, phi
|
|
||||||
write(6,105) nspin
|
|
||||||
write(6,106) aver_b
|
|
||||||
write(6,107) sigma_b
|
|
||||||
write(6,108) delta
|
|
||||||
write(6,308) b_ext
|
|
||||||
write(6,109) end_time - start_time
|
|
||||||
!
|
|
||||||
! Look whether data have to be written to file
|
|
||||||
!
|
|
||||||
IF ( out_open ) THEN
|
|
||||||
write(2,100) comment(1:73),(dt(j),j=1,3),(dt(j),j=5,8)
|
|
||||||
write(2,101) n*ah, m*ah
|
|
||||||
write(2,301) nd1*ah, nd2*ah
|
|
||||||
write(2,102) concentration
|
|
||||||
write(2,103) anisotropy, int(-anisotropy)
|
|
||||||
write(2,104) n_site
|
|
||||||
write(2,304) theta, phi
|
|
||||||
write(2,105) nspin
|
|
||||||
write(2,106) aver_b
|
|
||||||
write(2,107) sigma_b
|
|
||||||
write(2,108) delta
|
|
||||||
write(2,308) b_ext
|
|
||||||
write(2,109) end_time - start_time
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
100 format(' '/' ',73('-')/' ',a73/' ',73('-')/ &
|
|
||||||
& ' Calculation started ',i5,'-',i2,'-',i2, &
|
|
||||||
& ' at ',2(i2,':'),i2,'.',i3/' ',73('-')/' ')
|
|
||||||
101 format(' sample = ', F6.1, ' nanometer thick, and ', F6.1, ' nanometer wide.')
|
|
||||||
102 format(' concentration = ', F12.1, ' at. %')
|
|
||||||
103 format(' anisotropy = ', E12.3,' (int) ',I2)
|
|
||||||
104 format(' number of muons = ', I12)
|
|
||||||
105 format(' number of spins = ', I12)
|
|
||||||
106 format(' average field = ', 3E12.3,' tesla')
|
|
||||||
107 format(' second moment = ', 3E12.3,' tesla')
|
|
||||||
108 format(' corres. delta = ', 3E12.3,' 1/microseconde')
|
|
||||||
109 format(' cpu_time = ', E12.3, ' seconds')
|
|
||||||
308 format(' ext. field = ', 3E12.3,' tesla')
|
|
||||||
301 format(' penetration from = ', F6.1,' to ',F6.1' nanometer.')
|
|
||||||
304 format(' initial muon spin, theta = ',f6.2,' phi = ', f6.2)
|
|
||||||
!
|
|
||||||
! Write G(t) if the file is open
|
|
||||||
!
|
|
||||||
500 IF ( g_t_open ) THEN
|
|
||||||
!
|
|
||||||
DO k = 0, 999
|
|
||||||
write(3,'(3E20.6)') (g_t(id,k),id=1,3) ! output
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
! Go back to read new parameters
|
|
||||||
!
|
|
||||||
GOTO 111
|
|
||||||
!
|
|
||||||
! On error in input_file
|
|
||||||
!
|
|
||||||
998 Write(6,*) ' '
|
|
||||||
Write(6,*) ' There is an error in the input file. '
|
|
||||||
IF ( out_open ) Write(2,*) ' There is an error in the input file. '
|
|
||||||
!
|
|
||||||
999 IF ( in_open ) close(1)
|
|
||||||
IF ( out_open ) close(2)
|
|
||||||
IF ( g_t_open ) close(3)
|
|
||||||
IF ( his_open ) close(4)
|
|
||||||
END
|
|
||||||
!
|
|
||||||
! End of program
|
|
||||||
!-------------------------------------------------------------------------------------------
|
|
||||||
!
|
|
||||||
! Functions and Subroutines
|
|
||||||
!
|
|
||||||
!-------------------------------------------------------------------------------------------
|
|
||||||
real*8 FUNCTION length( v )
|
|
||||||
real*8 v(3)
|
|
||||||
length = sqrt( sum( v * v ) )
|
|
||||||
RETURN
|
|
||||||
END
|
|
||||||
!
|
|
||||||
real*8 FUNCTION scalar_product( v, w )
|
|
||||||
real*8 v(3), w(3)
|
|
||||||
scalar_product = sum( v * w )
|
|
||||||
RETURN
|
|
||||||
END
|
|
||||||
!
|
|
||||||
real*8 FUNCTION length_vector_product( v, w )
|
|
||||||
real*8 v(3), w(3), vp(3), length
|
|
||||||
call vector_product( vp, v, w )
|
|
||||||
length_vector_product = length( vp )
|
|
||||||
RETURN
|
|
||||||
END
|
|
||||||
!
|
|
||||||
SUBROUTINE vector_product( vp, v, w )
|
|
||||||
real*8 v(3), w(3), vp(3)
|
|
||||||
vp(1) = v(2) * w(3) - v(3) * w(2)
|
|
||||||
vp(2) = v(3) * w(1) - v(1) * w(3)
|
|
||||||
vp(3) = v(1) * w(2) - v(2) * w(1)
|
|
||||||
RETURN
|
|
||||||
END
|
|
||||||
@ -1,716 +0,0 @@
|
|||||||
! Program to calculate dipolar fields in spinglasses,
|
|
||||||
! their distribution and the depolarization of the muon
|
|
||||||
!
|
|
||||||
! Ge Nieuwenhuys, March, September, October 2005
|
|
||||||
!
|
|
||||||
! October 12: periodic boundary conditions in y- z plane
|
|
||||||
! October 14: random number start randomly (based on clock) for
|
|
||||||
! batch calculations.
|
|
||||||
! October 14: output-file-names are automatically indexed.
|
|
||||||
! October 17: oversized the recordlength of the direct-accessfile for
|
|
||||||
! unknown, but apparently essential reasons.
|
|
||||||
!
|
|
||||||
! Spins are located on a fcc lattice
|
|
||||||
!
|
|
||||||
! nspin number of spins
|
|
||||||
! nsp number of spins asked
|
|
||||||
! d thickness
|
|
||||||
! a lattice constant
|
|
||||||
! ah half of lattice constant
|
|
||||||
!
|
|
||||||
Use DFPORT ! library only needed for obtaining CPU-time
|
|
||||||
Use DFLIB
|
|
||||||
!
|
|
||||||
! Structure to store the position (as lattice site-indexes)
|
|
||||||
! and the direction-cosines of each spin.
|
|
||||||
!
|
|
||||||
structure /spin/
|
|
||||||
integer*4 x,y,z
|
|
||||||
real*8 dir(3)
|
|
||||||
end structure
|
|
||||||
!
|
|
||||||
! Declarations, maximumnumber of spins: max_spins, maxd is the maximum number of
|
|
||||||
! unitcell-distance for which the spin in included in the calculation
|
|
||||||
!
|
|
||||||
parameter( max_spins = 3000000, & ! maximum number of magnetic moments
|
|
||||||
& gyro = 135.5, & ! gyromagnetic ratio of muon
|
|
||||||
& twpi = 6.2831, & ! two times Pi
|
|
||||||
& radius = 2.0, & ! maxinum distance [nm] for
|
|
||||||
! the dipole-field will be calculated
|
|
||||||
& range = 10.0, & ! maximum absolute value of the field expected
|
|
||||||
& mrange = 4000, & ! range of the integer histograms
|
|
||||||
& nrange = 80 ) ! range of the normalized histograms
|
|
||||||
!
|
|
||||||
character*10 dddd, tttt, zone
|
|
||||||
character*4 file_index
|
|
||||||
integer*4 dt(8), ifile, l_calc, bond
|
|
||||||
character*80 comment, calculation, line
|
|
||||||
logical in_open, out_open, g_t_open, his_open, sgl, sgl_open
|
|
||||||
integer*4 j,k,l,m,n, nsp, nspin, nat, id, ihist(3,-mrange:mrange)
|
|
||||||
integer*4 iseed, maxfield, minfield, ihis, ibin, nd1, nd2, kd, ld, mh
|
|
||||||
record /spin/ s(max_spins)
|
|
||||||
real*8 d, concentration, c, dd(max_spins), w, depth1, depth2
|
|
||||||
real*8 px(max_spins),py(max_spins), pz(max_spins)
|
|
||||||
real*8 b(3), factor, moment, help, r_3, r_5, r(3), p_r, sq_3, h(3)
|
|
||||||
real*8 fraction, norm, aver_b(3), sigma_b(3), delta(3), anisotropy, b_ext(3)
|
|
||||||
real*8 g_t(3,0:999), omega, b_abs, b_sq, ca_sq, his, radiussq
|
|
||||||
real*4 runtime(2), start_time, end_time
|
|
||||||
real*8 eb(3), emu(3), cc, ss, theta, phi
|
|
||||||
!
|
|
||||||
real*8 gaas(16,3)
|
|
||||||
!
|
|
||||||
! Coordinates of bond sites
|
|
||||||
!
|
|
||||||
gaas(1,1) = 1
|
|
||||||
gaas(1,2) = 1
|
|
||||||
gaas(1,3) = 7
|
|
||||||
|
|
||||||
gaas(2,1) = 3
|
|
||||||
gaas(2,2) = 3
|
|
||||||
gaas(2,3) = 7
|
|
||||||
|
|
||||||
gaas(3,1) = 1
|
|
||||||
gaas(3,2) = 3
|
|
||||||
gaas(3,3) = 5
|
|
||||||
|
|
||||||
gaas(4,1) = 3
|
|
||||||
gaas(4,2) = 1
|
|
||||||
gaas(4,3) = 5
|
|
||||||
|
|
||||||
gaas(5,1) = 7
|
|
||||||
gaas(5,2) = 7
|
|
||||||
gaas(5,3) = 7
|
|
||||||
|
|
||||||
gaas(6,1) = 5
|
|
||||||
gaas(6,2) = 5
|
|
||||||
gaas(6,3) = 7
|
|
||||||
|
|
||||||
gaas(7,1) = 7
|
|
||||||
gaas(7,2) = 5
|
|
||||||
gaas(7,3) = 5
|
|
||||||
|
|
||||||
gaas(8,1) = 5
|
|
||||||
gaas(8,2) = 7
|
|
||||||
gaas(8,3) = 5
|
|
||||||
|
|
||||||
gaas(9,1) = 3
|
|
||||||
gaas(9,2) = 7
|
|
||||||
gaas(9,3) = 3
|
|
||||||
|
|
||||||
gaas(10,1) = 1
|
|
||||||
gaas(10,2) = 5
|
|
||||||
gaas(10,3) = 3
|
|
||||||
|
|
||||||
gaas(11,1) = 1
|
|
||||||
gaas(11,2) = 7
|
|
||||||
gaas(11,3) = 1
|
|
||||||
|
|
||||||
gaas(12,1) = 3
|
|
||||||
gaas(12,2) = 5
|
|
||||||
gaas(12,3) = 1
|
|
||||||
|
|
||||||
gaas(13,1) = 7
|
|
||||||
gaas(13,2) = 3
|
|
||||||
gaas(13,3) = 3
|
|
||||||
|
|
||||||
gaas(14,1) = 5
|
|
||||||
gaas(14,2) = 1
|
|
||||||
gaas(14,3) = 3
|
|
||||||
|
|
||||||
gaas(15,1) = 7
|
|
||||||
gaas(15,2) = 1
|
|
||||||
gaas(15,3) = 1
|
|
||||||
|
|
||||||
gaas(16,1) = 5
|
|
||||||
gaas(16,2) = 3
|
|
||||||
gaas(16,3) = 1
|
|
||||||
!
|
|
||||||
gaas = gaas / 4.0 ! concert to units of half lattice constant
|
|
||||||
!
|
|
||||||
Write(6,*) ' '
|
|
||||||
Write(6,*) ' ---------------------------------------------------------------------'
|
|
||||||
Write(6,*) ' | Program field-calculation of muons due to random static spins |'
|
|
||||||
Write(6,*) ' | Version of October 31, 2005 |'
|
|
||||||
Write(6,*) ' | |'
|
|
||||||
Write(6,*) ' | Input can also be read from an input file that should be named |'
|
|
||||||
Write(6,*) ' | <calculation>.inp and contain: |'
|
|
||||||
Write(6,*) ' | |'
|
|
||||||
Write(6,*) ' | ext. field(3) ,thickness, width, c, number_of_muons, |'
|
|
||||||
Write(6,*) ' | lattice-constant [nm], magnetic moment [mu_B], |'
|
|
||||||
Write(6,*) ' | initial-muon-direction(theta, phi)[degrees], |'
|
|
||||||
Write(6,*) ' | (muon-positions from) depth1, (to) depth2 [nm], |'
|
|
||||||
Write(6,*) ' | anisotropy [isotropic=1, planar <1, axial >1 |'
|
|
||||||
Write(6,*) ' | (neg: ferromagnetic along the |'
|
|
||||||
Write(6,*) ' | x - axis (anisotropy = -1.0) |'
|
|
||||||
Write(6,*) ' | y - axis (anisotropy = -2.0) |'
|
|
||||||
Write(6,*) ' | z - axis (anisotropy = -3.0) |'
|
|
||||||
Write(6,*) ' | |'
|
|
||||||
Write(6,*) ' | O R |'
|
|
||||||
Write(6,*) ' | |'
|
|
||||||
Write(6,*) ' | name of the <spin-glass>.sgl file produced by |'
|
|
||||||
Write(6,*) ' | MAKE SPINGLASS (starting on the first position), |'
|
|
||||||
Write(6,*) ' | number_of_muons, |'
|
|
||||||
Write(6,*) ' | initial-muon-direction(theta, phi)[degrees], |'
|
|
||||||
Write(6,*) ' | (muon-positions from) depth1, (to) depth2 [nm], |'
|
|
||||||
Write(6,*) ' | |'
|
|
||||||
write(6,*) ' | Lines starting with ! (first position) are treated as comments. |'
|
|
||||||
Write(6,*) ' | <calculation> can be issued as a commandline parameter |'
|
|
||||||
Write(6,*) ' ---------------------------------------------------------------------'
|
|
||||||
!
|
|
||||||
! files :
|
|
||||||
!
|
|
||||||
open(9,file='\simulations\counter.his',status='old')
|
|
||||||
read(9,*) ifile ! initialize outputfile counter
|
|
||||||
!
|
|
||||||
! write(6,*) ' iargc = ', iargc()
|
|
||||||
IF ( iargc() .GT. 0 ) THEN
|
|
||||||
call getarg(1, calculation)
|
|
||||||
Write(6,*) ' Calculation taken from commandline > ',calculation
|
|
||||||
ELSE
|
|
||||||
200 write(6,201)
|
|
||||||
201 format(' '/' Give name of the calculation > ', \)
|
|
||||||
read(5,'(a60)') calculation
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
l_calc = index( calculation, ' ') - 1
|
|
||||||
!
|
|
||||||
IF ( l_calc .GT. 0 ) THEN
|
|
||||||
open(1,file=calculation(1:l_calc)//'.inp',status='old',action='read',err=200 )
|
|
||||||
open(2,file=calculation(1:l_calc)//'.out',status='unknown',action='write')
|
|
||||||
!
|
|
||||||
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
inquire(1, opened = in_open )
|
|
||||||
inquire(2, opened = out_open )
|
|
||||||
!
|
|
||||||
! initialization of randomumber generator
|
|
||||||
!
|
|
||||||
iseed = 1234567
|
|
||||||
!
|
|
||||||
! Get eventually other values from the iput file
|
|
||||||
!
|
|
||||||
111 IF (in_open) THEN
|
|
||||||
!
|
|
||||||
! Read everything from the input file, one line per calculation
|
|
||||||
!
|
|
||||||
ifile = ifile + 1 ! increase outputfile number
|
|
||||||
rewind(9)
|
|
||||||
write(9,*) ifile ! store for next program
|
|
||||||
write(file_index,'(''_'',i3)') ifile ! generate file_name
|
|
||||||
DO j = 2, 4
|
|
||||||
IF (file_index(j:j) .EQ. ' ' ) file_index(j:j) = '0'
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
|
|
||||||
open(3,file=calculation(1:l_calc)//file_index//'.g_t',status='unknown',action='write')
|
|
||||||
open(4,file=calculation(1:l_calc)//file_index//'.his',status='unknown',action='write')
|
|
||||||
!
|
|
||||||
inquire(3, opened = g_t_open )
|
|
||||||
inquire(4, opened = his_open )
|
|
||||||
!
|
|
||||||
112 read(1,'(a80)',end=999) line
|
|
||||||
IF ( ( line(1:1) .GE. 'a' .AND. line(1:1) .LE. 'z' ) .OR. &
|
|
||||||
& ( line(1:1) .GE. 'A' .AND. line(1:1) .LE. 'Z' ) ) THEN
|
|
||||||
l = index( line, ' ') - 1
|
|
||||||
write(6,*) line(1:l)
|
|
||||||
open(7,file=line(1:l)//'.sgl',status='old', &
|
|
||||||
& access='direct',form='binary',recl=40,action='read',err=998)
|
|
||||||
read(line(l+1:80),*,err=998,end=999) n_site, theta, phi, depth1, depth2
|
|
||||||
ELSE
|
|
||||||
IF ( line(1:1) .EQ. '!' ) THEN
|
|
||||||
write(2,'(a)') line
|
|
||||||
GOTO 112
|
|
||||||
ELSE
|
|
||||||
read(line,*,err=998,end=999) a, moment, b_ext, d, w, concentration, &
|
|
||||||
& n_site, theta, phi, depth1, depth2, anisotropy
|
|
||||||
END IF
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
! Initialize randomnumber generator "randomly"
|
|
||||||
!
|
|
||||||
call date_and_time( dddd, tttt, zone, dt )
|
|
||||||
DO i = 1, dt(8) ! number milliseconds on the clock
|
|
||||||
dummy = rand(iseed)
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
ELSE
|
|
||||||
!
|
|
||||||
! put standard values in the case of on-line calculation
|
|
||||||
! for the lattice (4 nm), moment (2 uB), external field (0,0,0) and
|
|
||||||
! initial_muon_spin in y-direction
|
|
||||||
!
|
|
||||||
!
|
|
||||||
a = 0.4 ! Assume 0.4 nanometer
|
|
||||||
moment = 2.0 ! Assume 2 Bohrmagneton per spin
|
|
||||||
b_ext = 0.0 ! No external field
|
|
||||||
emu = 0.0
|
|
||||||
emu(2) = 1.0 ! initial muon direction along y-axis
|
|
||||||
!
|
|
||||||
!
|
|
||||||
! Ask size of the system
|
|
||||||
!
|
|
||||||
3 write(6,4)
|
|
||||||
4 format( ' What thickness [nm] (0=stop) ? '\)
|
|
||||||
read(5,*,err=3) d
|
|
||||||
IF ( d .LT. 0.0 ) GOTO 3
|
|
||||||
IF ( d .EQ. 0.0 ) THEN
|
|
||||||
Write(6,*) ' '
|
|
||||||
STOP ' program terminated by operator'
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
5 write(6,6)
|
|
||||||
6 format( ' What width [nm] ? '\)
|
|
||||||
read(5,*,err=5) w
|
|
||||||
IF ( w .LE. 0.0 ) GOTO 5
|
|
||||||
depth1 = 0.0
|
|
||||||
depth2 = w
|
|
||||||
!
|
|
||||||
7 write(6,8)
|
|
||||||
8 format( ' Which concentration [at.%] ? '\)
|
|
||||||
read(5,*,err=7) concentration
|
|
||||||
IF ( concentration .LE. 0.0 ) GOTO 7
|
|
||||||
!
|
|
||||||
! Ask for the anisotropy.
|
|
||||||
! The random value of the direction cosin in the x-direction is multiplied
|
|
||||||
! by anisotropy before normalization
|
|
||||||
!
|
|
||||||
9 write(6,10)
|
|
||||||
10 format( ' The random value of the direction cosin in the x-direction'/ &
|
|
||||||
& ' is multiplied by anisotropy before normalization'/ &
|
|
||||||
& ' Anisotropy [isotrope == 1] ? '\)
|
|
||||||
read(5,*,err=9) anisotropy
|
|
||||||
!
|
|
||||||
20 write(6,21)
|
|
||||||
21 format( ' Give value of the external field (x=perp to film,'/ &
|
|
||||||
& ' y=initial_muon > '\)
|
|
||||||
read(5,*,err=20) b_ext
|
|
||||||
!
|
|
||||||
END IF ! end reading from input file / keyboard
|
|
||||||
!
|
|
||||||
!----------------------------------------------------------------------------------------
|
|
||||||
! Start calculation
|
|
||||||
!----------------------------------------------------------------------------------------
|
|
||||||
call date_and_time( dddd, tttt, zone, dt )
|
|
||||||
!
|
|
||||||
! If a spinglass has been simulated by MAKE SPINGLASS, then
|
|
||||||
! the <calculation>.sgl file will be read, ELSE a random
|
|
||||||
! glass will be generated here.
|
|
||||||
!
|
|
||||||
inquire(7, opened = sgl_open )
|
|
||||||
!
|
|
||||||
IF ( sgl_open ) THEN ! spin glass has been made
|
|
||||||
read(7,rec=1) n,m,nspin,a,moment,T_glass
|
|
||||||
read(7,rec=2) concentration,b_ext,steps_per_spin
|
|
||||||
DO ispin = 1, nspin
|
|
||||||
read(7,rec=ispin+2) s(ispin)
|
|
||||||
END DO
|
|
||||||
close(7)
|
|
||||||
!
|
|
||||||
ELSE ! spin glass has NOT been made
|
|
||||||
!
|
|
||||||
c = concentration / 100.0
|
|
||||||
!
|
|
||||||
! Calculate the 'rounded' number of spins for a lattice n*m*m for
|
|
||||||
! the given concentration.
|
|
||||||
! n is the number of atoms (half unitcells) perpendicular
|
|
||||||
! to the layer (== x-direction).
|
|
||||||
! m is the size of the layer in the y- ad z-direction
|
|
||||||
!
|
|
||||||
n = floor(2.0 * d / a ) + 2
|
|
||||||
m = floor(2.0 * w / a ) + 2
|
|
||||||
nat = m * m * n / 2
|
|
||||||
nspin = floor( nat * c )
|
|
||||||
!
|
|
||||||
IF (nspin .GE. max_spins ) THEN
|
|
||||||
Write(6,*) ' '
|
|
||||||
Write(6,*) ' Too many spins: ', nspin
|
|
||||||
IF ( out_open ) Write(2,*) ' Too many spins: ', nspin
|
|
||||||
GOTO 111
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
! Place the spins randomly on the fcc-lattice
|
|
||||||
! Run over a whole simple cubic lattice in steps
|
|
||||||
! of half of the fcc-unitcell.
|
|
||||||
! Then take care of the fcc-structure and
|
|
||||||
! decide whether or not to place a spin.
|
|
||||||
!
|
|
||||||
nspin = 0
|
|
||||||
!
|
|
||||||
DO j = 0, n-1
|
|
||||||
DO k = 0, m-1
|
|
||||||
DO l = 0, m-1
|
|
||||||
IF ( mod(j+k+l,2) .EQ. 0 ) THEN ! This takes care of the fcc structure.
|
|
||||||
IF ( ran(iseed) .LT. c ) THEN
|
|
||||||
nspin = nspin + 1
|
|
||||||
s(nspin).x = j
|
|
||||||
s(nspin).y = k
|
|
||||||
s(nspin).z = l
|
|
||||||
|
|
||||||
IF (anisotropy .GE. 0.0 ) THEN
|
|
||||||
!
|
|
||||||
! Give the spin an arbitrary direction
|
|
||||||
!
|
|
||||||
DO i = 1, 3
|
|
||||||
h(i) = 2.0D+00 * ran(iseed) - 1.0D+00
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
! The anisotropy is taken care off by
|
|
||||||
! multiplying the direction cosine in
|
|
||||||
! the x-direction with ANOSOTROPY
|
|
||||||
! before normalizing the direction cosines.
|
|
||||||
!
|
|
||||||
h(1) = anisotropy * h(1)
|
|
||||||
norm = sum( h * h )
|
|
||||||
h = h / sqrt( norm )
|
|
||||||
ELSE
|
|
||||||
h = 0.0
|
|
||||||
h(-int(anisotropy)) = 1.0
|
|
||||||
END IF
|
|
||||||
|
|
||||||
s(nspin).dir = h
|
|
||||||
!
|
|
||||||
END IF
|
|
||||||
END IF
|
|
||||||
END DO
|
|
||||||
END DO
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
! The sample has been grown now.
|
|
||||||
!
|
|
||||||
Write(6,*) ' '
|
|
||||||
Write(6,*) 'The sample has been grown, calculation can start'
|
|
||||||
Write(6,*) ' '
|
|
||||||
!
|
|
||||||
END IF ! Of reading ,calculation>.sgl or
|
|
||||||
! growing magnetic structure
|
|
||||||
!
|
|
||||||
! Now start the serious work.
|
|
||||||
!
|
|
||||||
! Use half of the lattice parameter as unit of length
|
|
||||||
!
|
|
||||||
ah = a / 2.0
|
|
||||||
!
|
|
||||||
! help for periodic boundary conditions
|
|
||||||
!
|
|
||||||
mh = m / 2
|
|
||||||
!
|
|
||||||
! the maximum distance squared in units of ah:
|
|
||||||
!
|
|
||||||
radiussq = radius * radius / ( ah * ah )
|
|
||||||
!
|
|
||||||
! Calculate factor to translate to the correct dimensions.
|
|
||||||
!
|
|
||||||
! factor is ( mu_o / 4 Pi ) * moment * mu_B / ( ah^3 )
|
|
||||||
! -- ALL in MKS units --
|
|
||||||
! so that the "field" can be calculated as
|
|
||||||
! 1/r^5 ( 3 * (s.dir *** r) * r - r^2 s.dir ),
|
|
||||||
! where s.dir is the unit vector to the direction of the magnetic moment,
|
|
||||||
! and *** stands for the dot-product.
|
|
||||||
!
|
|
||||||
factor = 1D-07 * moment * 9.2740019D-24 / ( ah*ah*ah * 1D-27 )
|
|
||||||
!
|
|
||||||
! see where the muons should go
|
|
||||||
!
|
|
||||||
nd1 = floor( depth1 / ah )
|
|
||||||
nd2 = floor( depth2 / ah )
|
|
||||||
IF ( mod( nd1 , 2 ) .EQ. 0 ) nd1 = nd1 + 1 ! nd1 should be odd
|
|
||||||
IF ( nd2 .LT. nd1 + 1 ) nd2 = nd1 + 1
|
|
||||||
!
|
|
||||||
! calculate unit vector along the initial muon-spin direction
|
|
||||||
!
|
|
||||||
emu(1) = sin( twpi * theta / 360.0 ) * cos( twpi * phi / 360.0)
|
|
||||||
emu(2) = sin( twpi * theta / 360.0 ) * sin( twpi * phi / 360.0)
|
|
||||||
emu(3) = cos( twpi * theta / 360.0 )
|
|
||||||
!
|
|
||||||
! Ask the number of sites to calculated, about 10,000 is reasonable
|
|
||||||
!
|
|
||||||
IF ( .NOT. in_open ) THEN ! read keyboard if no input file
|
|
||||||
!
|
|
||||||
write(6,*) ' total number of muon-sites :', 2*(m-1)*(m-1)*(nd2-nd1+1)
|
|
||||||
write(6,*) ' '
|
|
||||||
11 write(6,12)
|
|
||||||
12 format(' Give number of sites to be calculated > ' $)
|
|
||||||
read(5,*,err=11) n_site
|
|
||||||
!
|
|
||||||
END IF ! of reading keyboard
|
|
||||||
!
|
|
||||||
fraction = dble( float(n_site) / float( 2*(m-1)*(m-1)*(nd2-nd1+1)))
|
|
||||||
!
|
|
||||||
! make some space
|
|
||||||
!
|
|
||||||
Write(6,*) ' '
|
|
||||||
Write(6,*) ' '
|
|
||||||
!
|
|
||||||
start_time = dtime(runtime) ! record the starttime
|
|
||||||
!
|
|
||||||
! Initialize the averages
|
|
||||||
!
|
|
||||||
ib = 0 ! index of field calculation
|
|
||||||
aver_b = 0 ! average of the field
|
|
||||||
sigma_b = 0 ! average of the field squared
|
|
||||||
hist = 0 ! histograms
|
|
||||||
g_t = 0.0 ! initialize the line
|
|
||||||
!
|
|
||||||
! Assume the muon to be in the center of the fcc-cube
|
|
||||||
!
|
|
||||||
DO j = nd1-1, nd2-1, 2
|
|
||||||
DO k = 0, m-2, 2
|
|
||||||
DO l = 0, m-2, 2
|
|
||||||
DO bond = 1, 16 ! loop over the 16 bonds
|
|
||||||
!
|
|
||||||
! These do-loops run over all sites, which is probably too much (time consuming)
|
|
||||||
! Therefore select randomly sufficient (see above) fraction of
|
|
||||||
! the possible muon sites and calculate the dipolar field.
|
|
||||||
!
|
|
||||||
IF ( ran(iseed) .LT. fraction ) THEN
|
|
||||||
!
|
|
||||||
! Calculate the field by running over all spins.
|
|
||||||
! In calculating the mutual distance, periodic boundaryconditions are applied
|
|
||||||
! in the y- and z-direction, but NOT in the x-direction, since that is supposed
|
|
||||||
! perpendicular to the film
|
|
||||||
!
|
|
||||||
! The field is only calculated when the distance is smaller then radius
|
|
||||||
!
|
|
||||||
b = 0
|
|
||||||
!
|
|
||||||
DO i = 1, nspin
|
|
||||||
r(1) = dble(float(j-s(i).x)) + gaas(bond,1)
|
|
||||||
kd = k - s(i).y
|
|
||||||
IF ( kd .LT. -mh ) kd = kd + m ! periodic boundary condition
|
|
||||||
IF ( kd .GT. mh ) kd = kd - m ! periodic boundary condition
|
|
||||||
r(2) = dble(float(kd)) + gaas(bond,2)
|
|
||||||
ld = l - s(i).z
|
|
||||||
IF ( ld .LT. -mh ) ld = ld + m ! periodic boundary condition
|
|
||||||
IF ( ld .GT. mh ) ld = ld - m ! periodic boundary condition
|
|
||||||
r(3) = dble(float(ld)) + gaas(bond,3)
|
|
||||||
r_2 = sum( r * r )
|
|
||||||
!
|
|
||||||
IF ( r_2 .LE. radiussq ) THEN ! skip calculation if distance is too large
|
|
||||||
help = sqrt( r_2 )
|
|
||||||
r_3 = r_2 * help
|
|
||||||
r_5 = r_2 * r_3
|
|
||||||
h = s(i).dir
|
|
||||||
p_r = sum( h * r )
|
|
||||||
b = b + ( 3.0D+00 * p_r * r - r_2 * h ) / r_5
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
ib = ib + 1 ! count the sites calculated.
|
|
||||||
b = factor * b ! get correct dimensions
|
|
||||||
aver_b = aver_b + b ! add the field to the averages
|
|
||||||
sigma_b = sigma_b + b*b
|
|
||||||
!
|
|
||||||
!
|
|
||||||
! Count for histograms
|
|
||||||
!
|
|
||||||
DO ih = 1, 3
|
|
||||||
ival = int( float(mrange) * b(ih) / range + 0.5D+00 )
|
|
||||||
IF ( abs(ival) .LE. mrange ) ihist(ih,ival) = ihist(ih,ival) + 1
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
b = b + b_ext ! add external field
|
|
||||||
b_sq = sum( b * b ) ! square of the field
|
|
||||||
b_abs = sqrt( b_sq ) ! absolute value
|
|
||||||
eb = b / b_abs ! unit vector
|
|
||||||
omega = gyro * twpi * b_abs ! precession frequency
|
|
||||||
!
|
|
||||||
! Calculate the rotation of the muonspin for 1000 time-steps.
|
|
||||||
! The contribution to the asymmetry equals the components of the temporal
|
|
||||||
! muonspin, assuming the counters to be forward-backward, left-right ,and up-down,
|
|
||||||
! respectively.
|
|
||||||
!
|
|
||||||
DO it = 0, 999
|
|
||||||
t = 1.0D-02 * dble(float(it))
|
|
||||||
cc = cos( omega * t )
|
|
||||||
ss = sin( omega * t )
|
|
||||||
!
|
|
||||||
g_t(1,it) = g_t(1,it) + &
|
|
||||||
& ( cc+eb(1)*eb(1)*(1-cc)) * emu(1) + &
|
|
||||||
& ( -eb(3)*ss+eb(1)*eb(2)*(1-cc)) * emu(2) + &
|
|
||||||
& ( eb(2)*ss+eb(1)*eb(3)*(1-cc)) * emu(3)
|
|
||||||
!
|
|
||||||
g_t(2,it) = g_t(2,it) + &
|
|
||||||
& ( eb(3)*ss+eb(1)*eb(2)*(1-cc)) * emu(1) + &
|
|
||||||
& ( cc+eb(2)*eb(2)*(1-cc)) * emu(2) + &
|
|
||||||
& ( -eb(1)*ss+eb(2)*eb(3)*(1-cc)) * emu(3)
|
|
||||||
!
|
|
||||||
g_t(3,it) = g_t(3,it) + &
|
|
||||||
& ( -eb(2)*ss+eb(1)*eb(3)*(1-cc)) * emu(1) + &
|
|
||||||
& ( eb(1)*ss+eb(2)*eb(3)*(1-cc)) * emu(2) + &
|
|
||||||
& ( cc+eb(3)*eb(3)*(1-cc)) * emu(3)
|
|
||||||
!
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
IF ( mod(ib,1000) .EQ. 0 ) idummy = putc('#')
|
|
||||||
!
|
|
||||||
END IF ! decision on fraction of muon sites
|
|
||||||
END DO ! over bond loop
|
|
||||||
END DO
|
|
||||||
END DO
|
|
||||||
END DO ! l, k, j loops
|
|
||||||
!
|
|
||||||
! Average over all calculaled sites.
|
|
||||||
!
|
|
||||||
norm = dble( float(ib))
|
|
||||||
aver_b = aver_b / norm
|
|
||||||
sigma_b = sqrt( (sigma_b - aver_b * aver_b ) / norm )
|
|
||||||
delta = gyro * sigma_b
|
|
||||||
g_t = g_t / norm
|
|
||||||
!
|
|
||||||
! Renormalize histograms
|
|
||||||
!
|
|
||||||
IF ( his_open ) THEN ! Should the histogram be calculated ??
|
|
||||||
Write(4,*) '-------------------------------------------------------'
|
|
||||||
!
|
|
||||||
! Check whether the maximum calculated field exceeds the range
|
|
||||||
!
|
|
||||||
IF ( ihist(1,-mrange) .EQ. 0 .AND. ihist(1,mrange) .EQ. 0 .AND. &
|
|
||||||
& ihist(2,-mrange) .EQ. 0 .AND. ihist(2,mrange) .EQ. 0 .AND. &
|
|
||||||
& ihist(3,-mrange) .EQ. 0 .AND. ihist(3,mrange) .EQ. 0 ) THEN
|
|
||||||
!
|
|
||||||
! determine the range of fields found
|
|
||||||
!
|
|
||||||
DO j = 1, 3
|
|
||||||
DO k = -mrange, mrange
|
|
||||||
IF ( ihist(j, k) .GT. 0 ) maxfield = k
|
|
||||||
IF ( ihist(j,-k) .GT. 0 ) minfield = -k
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
! adjust binning of histogram and write values
|
|
||||||
!
|
|
||||||
ibin = (maxfield - minfield) / nrange + 1
|
|
||||||
x = float(minfield) * range / float(mrange)
|
|
||||||
step = range * float(ibin) / float(mrange)
|
|
||||||
!
|
|
||||||
write(6,*) ' The field histogram vaues are: '
|
|
||||||
write(6,*) minfield, maxfield, ibin, x, step
|
|
||||||
!
|
|
||||||
DO i = minfield, maxfield, ibin
|
|
||||||
ihis = 0
|
|
||||||
DO k = 0, ibin-1
|
|
||||||
ihis = ihis + ihist(j,i+k)
|
|
||||||
END DO
|
|
||||||
his = float(ihis) / norm
|
|
||||||
Write(4,'(2E16.6)') x, his
|
|
||||||
x = x + step
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
Write(4,*) ' '
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
ELSE
|
|
||||||
Write(4,*) ' Fields exceed the maximum field for histogram calculation '
|
|
||||||
END IF
|
|
||||||
END IF ! Histogram calculation
|
|
||||||
!
|
|
||||||
end_time = dtime(runtime)
|
|
||||||
!
|
|
||||||
write(6,*) ' '
|
|
||||||
write(2,100) comment(1:73),(dt(j),j=1,3),(dt(j),j=5,8)
|
|
||||||
write(6,101) n*ah, m*ah
|
|
||||||
write(6,301) nd1*ah, nd2*ah
|
|
||||||
write(6,102) concentration
|
|
||||||
write(6,103) anisotropy, int(-anisotropy)
|
|
||||||
write(6,104) n_site
|
|
||||||
write(6,304) theta, phi
|
|
||||||
write(6,105) nspin
|
|
||||||
write(6,106) aver_b
|
|
||||||
write(6,107) sigma_b
|
|
||||||
write(6,108) delta
|
|
||||||
write(6,308) b_ext
|
|
||||||
write(6,109) end_time - start_time
|
|
||||||
!
|
|
||||||
! Look whether data have to be written to file
|
|
||||||
!
|
|
||||||
IF ( out_open ) THEN
|
|
||||||
write(2,100) comment(1:73),(dt(j),j=1,3),(dt(j),j=5,8)
|
|
||||||
write(2,101) n*ah, m*ah
|
|
||||||
write(2,301) nd1*ah, nd2*ah
|
|
||||||
write(2,102) concentration
|
|
||||||
write(2,103) anisotropy, int(-anisotropy)
|
|
||||||
write(2,104) n_site
|
|
||||||
write(2,304) theta, phi
|
|
||||||
write(2,105) nspin
|
|
||||||
write(2,106) aver_b
|
|
||||||
write(2,107) sigma_b
|
|
||||||
write(2,108) delta
|
|
||||||
write(2,308) b_ext
|
|
||||||
write(2,109) end_time - start_time
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
100 format(' '/' ',73('-')/' ',a73/' ',73('-')/ &
|
|
||||||
& ' Calculation started ',i5,'-',i2,'-',i2, &
|
|
||||||
& ' at ',2(i2,':'),i2,'.',i3/' ',73('-')/' ')
|
|
||||||
101 format(' sample = ', F6.1, ' nanometer thick, and ', F6.1, ' nanometer wide.')
|
|
||||||
102 format(' concentration = ', F12.1, ' at. %')
|
|
||||||
103 format(' anisotropy = ', E12.3,' (int) ',I2)
|
|
||||||
104 format(' number of muons = ', I12)
|
|
||||||
105 format(' number of spins = ', I12)
|
|
||||||
106 format(' average field = ', 3E12.3,' tesla')
|
|
||||||
107 format(' second moment = ', 3E12.3,' tesla')
|
|
||||||
108 format(' corres. delta = ', 3E12.3,' 1/microseconde')
|
|
||||||
109 format(' cpu_time = ', E12.3, ' seconds')
|
|
||||||
308 format(' ext. field = ', 3E12.3,' tesla')
|
|
||||||
301 format(' penetration from = ', F6.1,' to ',F6.1' nanometer.')
|
|
||||||
304 format(' initial muon spin, theta = ',f6.2,' phi = ', f6.2)
|
|
||||||
!
|
|
||||||
! Write G(t) if the file is open
|
|
||||||
!
|
|
||||||
500 IF ( g_t_open ) THEN
|
|
||||||
!
|
|
||||||
DO k = 0, 999
|
|
||||||
write(3,'(3E20.6)') (g_t(id,k),id=1,3) ! output
|
|
||||||
END DO
|
|
||||||
!
|
|
||||||
END IF
|
|
||||||
!
|
|
||||||
! Go back to read new parameters
|
|
||||||
!
|
|
||||||
GOTO 111
|
|
||||||
!
|
|
||||||
! On error in input_file
|
|
||||||
!
|
|
||||||
998 Write(6,*) ' '
|
|
||||||
Write(6,*) ' There is an error in the input file. '
|
|
||||||
IF ( out_open ) Write(2,*) ' There is an error in the input file. '
|
|
||||||
!
|
|
||||||
999 IF ( in_open ) close(1)
|
|
||||||
IF ( out_open ) close(2)
|
|
||||||
IF ( g_t_open ) close(3)
|
|
||||||
IF ( his_open ) close(4)
|
|
||||||
END
|
|
||||||
!
|
|
||||||
! End of program
|
|
||||||
!-------------------------------------------------------------------------------------------
|
|
||||||
!
|
|
||||||
! Functions and Subroutines
|
|
||||||
!
|
|
||||||
!-------------------------------------------------------------------------------------------
|
|
||||||
real*8 FUNCTION length( v )
|
|
||||||
real*8 v(3)
|
|
||||||
length = sqrt( sum( v * v ) )
|
|
||||||
RETURN
|
|
||||||
END
|
|
||||||
!
|
|
||||||
real*8 FUNCTION scalar_product( v, w )
|
|
||||||
real*8 v(3), w(3)
|
|
||||||
scalar_product = sum( v * w )
|
|
||||||
RETURN
|
|
||||||
END
|
|
||||||
!
|
|
||||||
real*8 FUNCTION length_vector_product( v, w )
|
|
||||||
real*8 v(3), w(3), vp(3), length
|
|
||||||
call vector_product( vp, v, w )
|
|
||||||
length_vector_product = length( vp )
|
|
||||||
RETURN
|
|
||||||
END
|
|
||||||
!
|
|
||||||
SUBROUTINE vector_product( vp, v, w )
|
|
||||||
real*8 v(3), w(3), vp(3)
|
|
||||||
vp(1) = v(2) * w(3) - v(3) * w(2)
|
|
||||||
vp(2) = v(3) * w(1) - v(1) * w(3)
|
|
||||||
vp(3) = v(1) * w(2) - v(2) * w(1)
|
|
||||||
RETURN
|
|
||||||
END
|
|
||||||
@ -1,3 +0,0 @@
|
|||||||
Write(6,*) ' het werkt weer '
|
|
||||||
stop
|
|
||||||
end
|
|
||||||
@ -1,98 +0,0 @@
|
|||||||
# Microsoft Developer Studio Project File - Name="thinfilm" - Package Owner=<4>
|
|
||||||
# Microsoft Developer Studio Generated Build File, Format Version 5.00
|
|
||||||
# ** DO NOT EDIT **
|
|
||||||
|
|
||||||
# TARGTYPE "Win32 (x86) Console Application" 0x0103
|
|
||||||
|
|
||||||
CFG=thinfilm - Win32 Debug
|
|
||||||
!MESSAGE This is not a valid makefile. To build this project using NMAKE,
|
|
||||||
!MESSAGE use the Export Makefile command and run
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE NMAKE /f "thinfilm.mak".
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE You can specify a configuration when running NMAKE
|
|
||||||
!MESSAGE by defining the macro CFG on the command line. For example:
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE NMAKE /f "thinfilm.mak" CFG="thinfilm - Win32 Debug"
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE Possible choices for configuration are:
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE "thinfilm - Win32 Release" (based on\
|
|
||||||
"Win32 (x86) Console Application")
|
|
||||||
!MESSAGE "thinfilm - Win32 Debug" (based on "Win32 (x86) Console Application")
|
|
||||||
!MESSAGE
|
|
||||||
|
|
||||||
# Begin Project
|
|
||||||
# PROP Scc_ProjName ""
|
|
||||||
# PROP Scc_LocalPath ""
|
|
||||||
F90=df.exe
|
|
||||||
RSC=rc.exe
|
|
||||||
|
|
||||||
!IF "$(CFG)" == "thinfilm - Win32 Release"
|
|
||||||
|
|
||||||
# PROP BASE Use_MFC 0
|
|
||||||
# PROP BASE Use_Debug_Libraries 0
|
|
||||||
# PROP BASE Output_Dir "Release"
|
|
||||||
# PROP BASE Intermediate_Dir "Release"
|
|
||||||
# PROP BASE Target_Dir ""
|
|
||||||
# PROP Use_MFC 0
|
|
||||||
# PROP Use_Debug_Libraries 0
|
|
||||||
# PROP Output_Dir "Release"
|
|
||||||
# PROP Intermediate_Dir "Release"
|
|
||||||
# PROP Target_Dir ""
|
|
||||||
# ADD BASE F90 /include:"Release/" /compile_only /nologo /warn:nofileopt
|
|
||||||
# ADD F90 /include:"Release/" /compile_only /nologo /warn:nofileopt
|
|
||||||
# ADD BASE RSC /l 0x413 /d "NDEBUG"
|
|
||||||
# ADD RSC /l 0x413 /d "NDEBUG"
|
|
||||||
BSC32=bscmake.exe
|
|
||||||
# ADD BASE BSC32 /nologo
|
|
||||||
# ADD BSC32 /nologo
|
|
||||||
LINK32=link.exe
|
|
||||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
|
||||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
|
||||||
|
|
||||||
!ELSEIF "$(CFG)" == "thinfilm - Win32 Debug"
|
|
||||||
|
|
||||||
# PROP BASE Use_MFC 0
|
|
||||||
# PROP BASE Use_Debug_Libraries 1
|
|
||||||
# PROP BASE Output_Dir "Debug"
|
|
||||||
# PROP BASE Intermediate_Dir "Debug"
|
|
||||||
# PROP BASE Target_Dir ""
|
|
||||||
# PROP Use_MFC 0
|
|
||||||
# PROP Use_Debug_Libraries 1
|
|
||||||
# PROP Output_Dir "Debug"
|
|
||||||
# PROP Intermediate_Dir "Debug"
|
|
||||||
# PROP Target_Dir ""
|
|
||||||
# ADD BASE F90 /include:"Debug/" /compile_only /nologo /debug:full /optimize:0 /warn:nofileopt
|
|
||||||
# ADD F90 /include:"Debug/" /compile_only /nologo /debug:full /optimize:0 /warn:nofileopt
|
|
||||||
# ADD BASE RSC /l 0x413 /d "_DEBUG"
|
|
||||||
# ADD RSC /l 0x413 /d "_DEBUG"
|
|
||||||
BSC32=bscmake.exe
|
|
||||||
# ADD BASE BSC32 /nologo
|
|
||||||
# ADD BSC32 /nologo
|
|
||||||
LINK32=link.exe
|
|
||||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
|
|
||||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
|
|
||||||
|
|
||||||
!ENDIF
|
|
||||||
|
|
||||||
# Begin Target
|
|
||||||
|
|
||||||
# Name "thinfilm - Win32 Release"
|
|
||||||
# Name "thinfilm - Win32 Debug"
|
|
||||||
# Begin Source File
|
|
||||||
|
|
||||||
SOURCE=.\field_calculation.f90
|
|
||||||
# End Source File
|
|
||||||
# Begin Source File
|
|
||||||
|
|
||||||
SOURCE=.\field_simulation.f90
|
|
||||||
# PROP Exclude_From_Build 1
|
|
||||||
# End Source File
|
|
||||||
# Begin Source File
|
|
||||||
|
|
||||||
SOURCE=.\test.f90
|
|
||||||
# PROP Exclude_From_Build 1
|
|
||||||
# End Source File
|
|
||||||
# End Target
|
|
||||||
# End Project
|
|
||||||
@ -1,106 +0,0 @@
|
|||||||
# Microsoft Developer Studio Project File - Name="thinfilm" - Package Owner=<4>
|
|
||||||
# Microsoft Developer Studio Generated Build File, Format Version 6.00
|
|
||||||
# ** DO NOT EDIT **
|
|
||||||
|
|
||||||
# TARGTYPE "Win32 (x86) Console Application" 0x0103
|
|
||||||
|
|
||||||
CFG=thinfilm - Win32 Debug
|
|
||||||
!MESSAGE This is not a valid makefile. To build this project using NMAKE,
|
|
||||||
!MESSAGE use the Export Makefile command and run
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE NMAKE /f "thinfilm.mak".
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE You can specify a configuration when running NMAKE
|
|
||||||
!MESSAGE by defining the macro CFG on the command line. For example:
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE NMAKE /f "thinfilm.mak" CFG="thinfilm - Win32 Debug"
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE Possible choices for configuration are:
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE "thinfilm - Win32 Release" (based on "Win32 (x86) Console Application")
|
|
||||||
!MESSAGE "thinfilm - Win32 Debug" (based on "Win32 (x86) Console Application")
|
|
||||||
!MESSAGE
|
|
||||||
|
|
||||||
# Begin Project
|
|
||||||
# PROP AllowPerConfigDependencies 0
|
|
||||||
# PROP Scc_ProjName ""
|
|
||||||
# PROP Scc_LocalPath ""
|
|
||||||
CPP=cl.exe
|
|
||||||
F90=df.exe
|
|
||||||
RSC=rc.exe
|
|
||||||
|
|
||||||
!IF "$(CFG)" == "thinfilm - Win32 Release"
|
|
||||||
|
|
||||||
# PROP BASE Use_MFC 0
|
|
||||||
# PROP BASE Use_Debug_Libraries 0
|
|
||||||
# PROP BASE Output_Dir "Release"
|
|
||||||
# PROP BASE Intermediate_Dir "Release"
|
|
||||||
# PROP BASE Target_Dir ""
|
|
||||||
# PROP Use_MFC 0
|
|
||||||
# PROP Use_Debug_Libraries 0
|
|
||||||
# PROP Output_Dir "Release"
|
|
||||||
# PROP Intermediate_Dir "Release"
|
|
||||||
# PROP Target_Dir ""
|
|
||||||
# ADD BASE F90 /compile_only /include:"Release/" /nologo /warn:nofileopt
|
|
||||||
# ADD F90 /compile_only /include:"Release/" /nologo /warn:nofileopt
|
|
||||||
# ADD BASE RSC /l 0x413 /d "NDEBUG"
|
|
||||||
# ADD RSC /l 0x413 /d "NDEBUG"
|
|
||||||
BSC32=bscmake.exe
|
|
||||||
# ADD BASE BSC32 /nologo
|
|
||||||
# ADD BSC32 /nologo
|
|
||||||
LINK32=link.exe
|
|
||||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
|
||||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
|
||||||
|
|
||||||
!ELSEIF "$(CFG)" == "thinfilm - Win32 Debug"
|
|
||||||
|
|
||||||
# PROP BASE Use_MFC 0
|
|
||||||
# PROP BASE Use_Debug_Libraries 1
|
|
||||||
# PROP BASE Output_Dir "Debug"
|
|
||||||
# PROP BASE Intermediate_Dir "Debug"
|
|
||||||
# PROP BASE Target_Dir ""
|
|
||||||
# PROP Use_MFC 0
|
|
||||||
# PROP Use_Debug_Libraries 1
|
|
||||||
# PROP Output_Dir "Debug"
|
|
||||||
# PROP Intermediate_Dir "Debug"
|
|
||||||
# PROP Target_Dir ""
|
|
||||||
# ADD BASE F90 /compile_only /debug:full /include:"Debug/" /nologo /warn:nofileopt
|
|
||||||
# ADD F90 /compile_only /debug:full /include:"Debug/" /nologo /warn:nofileopt
|
|
||||||
# ADD BASE RSC /l 0x413 /d "_DEBUG"
|
|
||||||
# ADD RSC /l 0x413 /d "_DEBUG"
|
|
||||||
BSC32=bscmake.exe
|
|
||||||
# ADD BASE BSC32 /nologo
|
|
||||||
# ADD BSC32 /nologo
|
|
||||||
LINK32=link.exe
|
|
||||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
|
|
||||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
|
|
||||||
|
|
||||||
!ENDIF
|
|
||||||
|
|
||||||
# Begin Target
|
|
||||||
|
|
||||||
# Name "thinfilm - Win32 Release"
|
|
||||||
# Name "thinfilm - Win32 Debug"
|
|
||||||
# Begin Source File
|
|
||||||
|
|
||||||
SOURCE=.\field_calculation.f90
|
|
||||||
|
|
||||||
!IF "$(CFG)" == "thinfilm - Win32 Release"
|
|
||||||
|
|
||||||
!ELSEIF "$(CFG)" == "thinfilm - Win32 Debug"
|
|
||||||
|
|
||||||
!ENDIF
|
|
||||||
|
|
||||||
# End Source File
|
|
||||||
# Begin Source File
|
|
||||||
|
|
||||||
SOURCE=.\field_simulation.f90
|
|
||||||
# PROP Exclude_From_Build 1
|
|
||||||
# End Source File
|
|
||||||
# Begin Source File
|
|
||||||
|
|
||||||
SOURCE=.\test.f90
|
|
||||||
# PROP Exclude_From_Build 1
|
|
||||||
# End Source File
|
|
||||||
# End Target
|
|
||||||
# End Project
|
|
||||||
@ -1,26 +0,0 @@
|
|||||||
<html>
|
|
||||||
<body>
|
|
||||||
<pre>
|
|
||||||
<h1>Build Log</h1>
|
|
||||||
<h3>
|
|
||||||
--------------------Configuration: thinfilm - Win32 Release--------------------
|
|
||||||
</h3>
|
|
||||||
<h3>Command Lines</h3>
|
|
||||||
Creating temporary file "C:\DOCUME~1\NIEUWE~1\LOCALS~1\Temp\RSP28A.tmp" with contents
|
|
||||||
[
|
|
||||||
/compile_only /include:"Release/" /nologo /warn:nofileopt /module:"Release/" /object:"Release/"
|
|
||||||
"U:\monte_carlo\thinfilm\field_calculation.f90"
|
|
||||||
]
|
|
||||||
Creating command line "link.exe kernel32.lib /nologo /subsystem:console /incremental:no /pdb:"Release/thinfilm.pdb" /machine:I386 /out:"Release/thinfilm.exe" .\Release\field_calculation.obj "
|
|
||||||
<h3>Output Window</h3>
|
|
||||||
Compiling Fortran...
|
|
||||||
U:\monte_carlo\thinfilm\field_calculation.f90
|
|
||||||
Linking...
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
<h3>Results</h3>
|
|
||||||
thinfilm.exe - 0 error(s), 0 warning(s)
|
|
||||||
</pre>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -1,105 +0,0 @@
|
|||||||
# Microsoft Developer Studio Project File - Name="to_plot" - Package Owner=<4>
|
|
||||||
# Microsoft Developer Studio Generated Build File, Format Version 6.00
|
|
||||||
# ** DO NOT EDIT **
|
|
||||||
|
|
||||||
# TARGTYPE "Win32 (x86) Console Application" 0x0103
|
|
||||||
|
|
||||||
CFG=to_plot - Win32 Debug
|
|
||||||
!MESSAGE This is not a valid makefile. To build this project using NMAKE,
|
|
||||||
!MESSAGE use the Export Makefile command and run
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE NMAKE /f "to_plot.mak".
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE You can specify a configuration when running NMAKE
|
|
||||||
!MESSAGE by defining the macro CFG on the command line. For example:
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE NMAKE /f "to_plot.mak" CFG="to_plot - Win32 Debug"
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE Possible choices for configuration are:
|
|
||||||
!MESSAGE
|
|
||||||
!MESSAGE "to_plot - Win32 Release" (based on "Win32 (x86) Console Application")
|
|
||||||
!MESSAGE "to_plot - Win32 Debug" (based on "Win32 (x86) Console Application")
|
|
||||||
!MESSAGE
|
|
||||||
|
|
||||||
# Begin Project
|
|
||||||
# PROP AllowPerConfigDependencies 0
|
|
||||||
# PROP Scc_ProjName ""
|
|
||||||
# PROP Scc_LocalPath ""
|
|
||||||
CPP=cl.exe
|
|
||||||
F90=df.exe
|
|
||||||
RSC=rc.exe
|
|
||||||
|
|
||||||
!IF "$(CFG)" == "to_plot - Win32 Release"
|
|
||||||
|
|
||||||
# PROP BASE Use_MFC 0
|
|
||||||
# PROP BASE Use_Debug_Libraries 0
|
|
||||||
# PROP BASE Output_Dir "Release"
|
|
||||||
# PROP BASE Intermediate_Dir "Release"
|
|
||||||
# PROP BASE Target_Dir ""
|
|
||||||
# PROP Use_MFC 0
|
|
||||||
# PROP Use_Debug_Libraries 0
|
|
||||||
# PROP Output_Dir "Release"
|
|
||||||
# PROP Intermediate_Dir "Release"
|
|
||||||
# PROP Target_Dir ""
|
|
||||||
# ADD BASE F90 /compile_only /nologo /warn:nofileopt
|
|
||||||
# ADD F90 /compile_only /nologo /warn:nofileopt
|
|
||||||
# ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
|
|
||||||
# ADD CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /c
|
|
||||||
# ADD BASE RSC /l 0x409 /d "NDEBUG"
|
|
||||||
# ADD RSC /l 0x409 /d "NDEBUG"
|
|
||||||
BSC32=bscmake.exe
|
|
||||||
# ADD BASE BSC32 /nologo
|
|
||||||
# ADD BSC32 /nologo
|
|
||||||
LINK32=link.exe
|
|
||||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
|
||||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /machine:I386
|
|
||||||
|
|
||||||
!ELSEIF "$(CFG)" == "to_plot - Win32 Debug"
|
|
||||||
|
|
||||||
# PROP BASE Use_MFC 0
|
|
||||||
# PROP BASE Use_Debug_Libraries 1
|
|
||||||
# PROP BASE Output_Dir "Debug"
|
|
||||||
# PROP BASE Intermediate_Dir "Debug"
|
|
||||||
# PROP BASE Target_Dir ""
|
|
||||||
# PROP Use_MFC 0
|
|
||||||
# PROP Use_Debug_Libraries 1
|
|
||||||
# PROP Output_Dir "Debug"
|
|
||||||
# PROP Intermediate_Dir "Debug"
|
|
||||||
# PROP Target_Dir ""
|
|
||||||
# ADD BASE F90 /check:bounds /compile_only /dbglibs /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
|
|
||||||
# ADD F90 /check:bounds /compile_only /dbglibs /debug:full /nologo /traceback /warn:argument_checking /warn:nofileopt
|
|
||||||
# ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
|
|
||||||
# ADD CPP /nologo /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_CONSOLE" /D "_MBCS" /YX /FD /GZ /c
|
|
||||||
# ADD BASE RSC /l 0x409 /d "_DEBUG"
|
|
||||||
# ADD RSC /l 0x409 /d "_DEBUG"
|
|
||||||
BSC32=bscmake.exe
|
|
||||||
# ADD BASE BSC32 /nologo
|
|
||||||
# ADD BSC32 /nologo
|
|
||||||
LINK32=link.exe
|
|
||||||
# ADD BASE LINK32 kernel32.lib /nologo /subsystem:console /debug /machine:I386 /pdbtype:sept
|
|
||||||
# ADD LINK32 kernel32.lib /nologo /subsystem:console /incremental:no /debug /machine:I386 /pdbtype:sept
|
|
||||||
|
|
||||||
!ENDIF
|
|
||||||
|
|
||||||
# Begin Target
|
|
||||||
|
|
||||||
# Name "to_plot - Win32 Release"
|
|
||||||
# Name "to_plot - Win32 Debug"
|
|
||||||
# Begin Group "Source Files"
|
|
||||||
|
|
||||||
# PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat;f90;for;f;fpp"
|
|
||||||
# Begin Source File
|
|
||||||
|
|
||||||
SOURCE=.\to_plot.f90
|
|
||||||
# End Source File
|
|
||||||
# End Group
|
|
||||||
# Begin Group "Header Files"
|
|
||||||
|
|
||||||
# PROP Default_Filter "h;hpp;hxx;hm;inl;fi;fd"
|
|
||||||
# End Group
|
|
||||||
# Begin Group "Resource Files"
|
|
||||||
|
|
||||||
# PROP Default_Filter "ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
|
|
||||||
# End Group
|
|
||||||
# End Target
|
|
||||||
# End Project
|
|
||||||
@ -1,88 +0,0 @@
|
|||||||
! to_plot.f90
|
|
||||||
!
|
|
||||||
! FUNCTIONS:
|
|
||||||
! to_plot - Entry point of console application.
|
|
||||||
!
|
|
||||||
|
|
||||||
!****************************************************************************
|
|
||||||
!
|
|
||||||
! PROGRAM: to_plot
|
|
||||||
!
|
|
||||||
! PURPOSE: To put several *g_t files in a multicolumn file and in the ZF
|
|
||||||
! cases correct for the fact that all simulations were done
|
|
||||||
! with 50 degree phase angle (should have been 0 for ZF)
|
|
||||||
!
|
|
||||||
!****************************************************************************
|
|
||||||
|
|
||||||
program to_plot
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
! Variables
|
|
||||||
|
|
||||||
integer*4 i,j,k,n,is,l,max_l
|
|
||||||
real*4 x(40,1000), y(40,1000), xi, yi, yj
|
|
||||||
character*512 out
|
|
||||||
character*80 filename, file_out
|
|
||||||
character*1 y_n
|
|
||||||
logical*4 ZF
|
|
||||||
|
|
||||||
! Body of to_plot
|
|
||||||
|
|
||||||
1 write(6,2)
|
|
||||||
2 format(' Give simulation numbers > '$)
|
|
||||||
read(5,*,err=1) is, k, n
|
|
||||||
3 write(6,4)
|
|
||||||
4 format(' Zero-Field ? '$)
|
|
||||||
read(5,'(a1)') y_n
|
|
||||||
ZF = ( y_n .EQ. 'y' .OR. y_n .EQ. 'Y' )
|
|
||||||
5 write(6,6)
|
|
||||||
6 format(' Give output file name > '$)
|
|
||||||
read(5,'(a80)') file_out
|
|
||||||
|
|
||||||
max_l = 0
|
|
||||||
x = 0.0
|
|
||||||
y = 0.0
|
|
||||||
|
|
||||||
DO i = k, n
|
|
||||||
write(filename,50) is, i
|
|
||||||
50 format('u:\simulations\dynamics-',i2,'_',i3,'.g_t')
|
|
||||||
write(6,*) filename
|
|
||||||
open(1,file=filename,status='old',err=55)
|
|
||||||
write(out( 14*(i-k)+1:14*(i-k+1) ),51) is,i
|
|
||||||
51 format(' time ',i2,'_',i3)
|
|
||||||
|
|
||||||
l = 0
|
|
||||||
|
|
||||||
read(1,*) xi, yi, yj
|
|
||||||
|
|
||||||
|
|
||||||
DO WHILE( xi .LT. 5.0 .AND. (.NOT. Eof(1) ) )
|
|
||||||
l = l + 1
|
|
||||||
IF ( ZF ) yi = sqrt( yi*yi + yj*yj )
|
|
||||||
x(i-k+1,l) = xi
|
|
||||||
y(i-k+1,l) = yi
|
|
||||||
read(1,*) xi, yi, yj
|
|
||||||
END DO
|
|
||||||
|
|
||||||
IF ( max_l .LT. l ) max_l = l
|
|
||||||
close(1)
|
|
||||||
|
|
||||||
55 END DO
|
|
||||||
|
|
||||||
open(2,file='u:\simulations\'//file_out,status='new')
|
|
||||||
write( 2, '(a)' ) out(1:14*(n-k+1))
|
|
||||||
|
|
||||||
DO j = 1, max_l
|
|
||||||
write(out,'(35(f6.3,f8.3))') ( (x(i,j),y(i,j)),i=1,n-k+1 )
|
|
||||||
DO i = 1, n-k+1
|
|
||||||
IF ( x(i,j) .LT. 0.0 ) out( 14*(i-1)+1:14*i ) = ' '
|
|
||||||
END DO
|
|
||||||
write(2,'(a)') out(1:14*(n-k+1))
|
|
||||||
END DO
|
|
||||||
|
|
||||||
close(2)
|
|
||||||
goto 1
|
|
||||||
|
|
||||||
end program to_plot
|
|
||||||
|
|
||||||
@ -1,24 +0,0 @@
|
|||||||
<html>
|
|
||||||
<body>
|
|
||||||
<pre>
|
|
||||||
<h1>Build Log</h1>
|
|
||||||
<h3>
|
|
||||||
--------------------Configuration: to_plot - Win32 Release--------------------
|
|
||||||
</h3>
|
|
||||||
<h3>Command Lines</h3>
|
|
||||||
Creating temporary file "C:\DOCUME~1\NIEUWE~1\LOCALS~1\Temp\RSP3.tmp" with contents
|
|
||||||
[
|
|
||||||
/compile_only /nologo /warn:nofileopt /module:"Release/" /object:"Release/"
|
|
||||||
"N:\simulations\dynamics.f90"
|
|
||||||
]
|
|
||||||
<h3>Output Window</h3>
|
|
||||||
Compiling Fortran...
|
|
||||||
N:\simulations\dynamics.f90
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
<h3>Results</h3>
|
|
||||||
dynamics.obj - 0 error(s), 0 warning(s)
|
|
||||||
</pre>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
339
accel/COPYING
339
accel/COPYING
@ -1,339 +0,0 @@
|
|||||||
GNU GENERAL PUBLIC LICENSE
|
|
||||||
Version 2, June 1991
|
|
||||||
|
|
||||||
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
|
|
||||||
675 Mass Ave, Cambridge, MA 02139, USA
|
|
||||||
Everyone is permitted to copy and distribute verbatim copies
|
|
||||||
of this license document, but changing it is not allowed.
|
|
||||||
|
|
||||||
Preamble
|
|
||||||
|
|
||||||
The licenses for most software are designed to take away your
|
|
||||||
freedom to share and change it. By contrast, the GNU General Public
|
|
||||||
License is intended to guarantee your freedom to share and change free
|
|
||||||
software--to make sure the software is free for all its users. This
|
|
||||||
General Public License applies to most of the Free Software
|
|
||||||
Foundation's software and to any other program whose authors commit to
|
|
||||||
using it. (Some other Free Software Foundation software is covered by
|
|
||||||
the GNU Library General Public License instead.) You can apply it to
|
|
||||||
your programs, too.
|
|
||||||
|
|
||||||
When we speak of free software, we are referring to freedom, not
|
|
||||||
price. Our General Public Licenses are designed to make sure that you
|
|
||||||
have the freedom to distribute copies of free software (and charge for
|
|
||||||
this service if you wish), that you receive source code or can get it
|
|
||||||
if you want it, that you can change the software or use pieces of it
|
|
||||||
in new free programs; and that you know you can do these things.
|
|
||||||
|
|
||||||
To protect your rights, we need to make restrictions that forbid
|
|
||||||
anyone to deny you these rights or to ask you to surrender the rights.
|
|
||||||
These restrictions translate to certain responsibilities for you if you
|
|
||||||
distribute copies of the software, or if you modify it.
|
|
||||||
|
|
||||||
For example, if you distribute copies of such a program, whether
|
|
||||||
gratis or for a fee, you must give the recipients all the rights that
|
|
||||||
you have. You must make sure that they, too, receive or can get the
|
|
||||||
source code. And you must show them these terms so they know their
|
|
||||||
rights.
|
|
||||||
|
|
||||||
We protect your rights with two steps: (1) copyright the software, and
|
|
||||||
(2) offer you this license which gives you legal permission to copy,
|
|
||||||
distribute and/or modify the software.
|
|
||||||
|
|
||||||
Also, for each author's protection and ours, we want to make certain
|
|
||||||
that everyone understands that there is no warranty for this free
|
|
||||||
software. If the software is modified by someone else and passed on, we
|
|
||||||
want its recipients to know that what they have is not the original, so
|
|
||||||
that any problems introduced by others will not reflect on the original
|
|
||||||
authors' reputations.
|
|
||||||
|
|
||||||
Finally, any free program is threatened constantly by software
|
|
||||||
patents. We wish to avoid the danger that redistributors of a free
|
|
||||||
program will individually obtain patent licenses, in effect making the
|
|
||||||
program proprietary. To prevent this, we have made it clear that any
|
|
||||||
patent must be licensed for everyone's free use or not licensed at all.
|
|
||||||
|
|
||||||
The precise terms and conditions for copying, distribution and
|
|
||||||
modification follow.
|
|
||||||
|
|
||||||
GNU GENERAL PUBLIC LICENSE
|
|
||||||
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
|
|
||||||
|
|
||||||
0. This License applies to any program or other work which contains
|
|
||||||
a notice placed by the copyright holder saying it may be distributed
|
|
||||||
under the terms of this General Public License. The "Program", below,
|
|
||||||
refers to any such program or work, and a "work based on the Program"
|
|
||||||
means either the Program or any derivative work under copyright law:
|
|
||||||
that is to say, a work containing the Program or a portion of it,
|
|
||||||
either verbatim or with modifications and/or translated into another
|
|
||||||
language. (Hereinafter, translation is included without limitation in
|
|
||||||
the term "modification".) Each licensee is addressed as "you".
|
|
||||||
|
|
||||||
Activities other than copying, distribution and modification are not
|
|
||||||
covered by this License; they are outside its scope. The act of
|
|
||||||
running the Program is not restricted, and the output from the Program
|
|
||||||
is covered only if its contents constitute a work based on the
|
|
||||||
Program (independent of having been made by running the Program).
|
|
||||||
Whether that is true depends on what the Program does.
|
|
||||||
|
|
||||||
1. You may copy and distribute verbatim copies of the Program's
|
|
||||||
source code as you receive it, in any medium, provided that you
|
|
||||||
conspicuously and appropriately publish on each copy an appropriate
|
|
||||||
copyright notice and disclaimer of warranty; keep intact all the
|
|
||||||
notices that refer to this License and to the absence of any warranty;
|
|
||||||
and give any other recipients of the Program a copy of this License
|
|
||||||
along with the Program.
|
|
||||||
|
|
||||||
You may charge a fee for the physical act of transferring a copy, and
|
|
||||||
you may at your option offer warranty protection in exchange for a fee.
|
|
||||||
|
|
||||||
2. You may modify your copy or copies of the Program or any portion
|
|
||||||
of it, thus forming a work based on the Program, and copy and
|
|
||||||
distribute such modifications or work under the terms of Section 1
|
|
||||||
above, provided that you also meet all of these conditions:
|
|
||||||
|
|
||||||
a) You must cause the modified files to carry prominent notices
|
|
||||||
stating that you changed the files and the date of any change.
|
|
||||||
|
|
||||||
b) You must cause any work that you distribute or publish, that in
|
|
||||||
whole or in part contains or is derived from the Program or any
|
|
||||||
part thereof, to be licensed as a whole at no charge to all third
|
|
||||||
parties under the terms of this License.
|
|
||||||
|
|
||||||
c) If the modified program normally reads commands interactively
|
|
||||||
when run, you must cause it, when started running for such
|
|
||||||
interactive use in the most ordinary way, to print or display an
|
|
||||||
announcement including an appropriate copyright notice and a
|
|
||||||
notice that there is no warranty (or else, saying that you provide
|
|
||||||
a warranty) and that users may redistribute the program under
|
|
||||||
these conditions, and telling the user how to view a copy of this
|
|
||||||
License. (Exception: if the Program itself is interactive but
|
|
||||||
does not normally print such an announcement, your work based on
|
|
||||||
the Program is not required to print an announcement.)
|
|
||||||
|
|
||||||
These requirements apply to the modified work as a whole. If
|
|
||||||
identifiable sections of that work are not derived from the Program,
|
|
||||||
and can be reasonably considered independent and separate works in
|
|
||||||
themselves, then this License, and its terms, do not apply to those
|
|
||||||
sections when you distribute them as separate works. But when you
|
|
||||||
distribute the same sections as part of a whole which is a work based
|
|
||||||
on the Program, the distribution of the whole must be on the terms of
|
|
||||||
this License, whose permissions for other licensees extend to the
|
|
||||||
entire whole, and thus to each and every part regardless of who wrote it.
|
|
||||||
|
|
||||||
Thus, it is not the intent of this section to claim rights or contest
|
|
||||||
your rights to work written entirely by you; rather, the intent is to
|
|
||||||
exercise the right to control the distribution of derivative or
|
|
||||||
collective works based on the Program.
|
|
||||||
|
|
||||||
In addition, mere aggregation of another work not based on the Program
|
|
||||||
with the Program (or with a work based on the Program) on a volume of
|
|
||||||
a storage or distribution medium does not bring the other work under
|
|
||||||
the scope of this License.
|
|
||||||
|
|
||||||
3. You may copy and distribute the Program (or a work based on it,
|
|
||||||
under Section 2) in object code or executable form under the terms of
|
|
||||||
Sections 1 and 2 above provided that you also do one of the following:
|
|
||||||
|
|
||||||
a) Accompany it with the complete corresponding machine-readable
|
|
||||||
source code, which must be distributed under the terms of Sections
|
|
||||||
1 and 2 above on a medium customarily used for software interchange; or,
|
|
||||||
|
|
||||||
b) Accompany it with a written offer, valid for at least three
|
|
||||||
years, to give any third party, for a charge no more than your
|
|
||||||
cost of physically performing source distribution, a complete
|
|
||||||
machine-readable copy of the corresponding source code, to be
|
|
||||||
distributed under the terms of Sections 1 and 2 above on a medium
|
|
||||||
customarily used for software interchange; or,
|
|
||||||
|
|
||||||
c) Accompany it with the information you received as to the offer
|
|
||||||
to distribute corresponding source code. (This alternative is
|
|
||||||
allowed only for noncommercial distribution and only if you
|
|
||||||
received the program in object code or executable form with such
|
|
||||||
an offer, in accord with Subsection b above.)
|
|
||||||
|
|
||||||
The source code for a work means the preferred form of the work for
|
|
||||||
making modifications to it. For an executable work, complete source
|
|
||||||
code means all the source code for all modules it contains, plus any
|
|
||||||
associated interface definition files, plus the scripts used to
|
|
||||||
control compilation and installation of the executable. However, as a
|
|
||||||
special exception, the source code distributed need not include
|
|
||||||
anything that is normally distributed (in either source or binary
|
|
||||||
form) with the major components (compiler, kernel, and so on) of the
|
|
||||||
operating system on which the executable runs, unless that component
|
|
||||||
itself accompanies the executable.
|
|
||||||
|
|
||||||
If distribution of executable or object code is made by offering
|
|
||||||
access to copy from a designated place, then offering equivalent
|
|
||||||
access to copy the source code from the same place counts as
|
|
||||||
distribution of the source code, even though third parties are not
|
|
||||||
compelled to copy the source along with the object code.
|
|
||||||
|
|
||||||
4. You may not copy, modify, sublicense, or distribute the Program
|
|
||||||
except as expressly provided under this License. Any attempt
|
|
||||||
otherwise to copy, modify, sublicense or distribute the Program is
|
|
||||||
void, and will automatically terminate your rights under this License.
|
|
||||||
However, parties who have received copies, or rights, from you under
|
|
||||||
this License will not have their licenses terminated so long as such
|
|
||||||
parties remain in full compliance.
|
|
||||||
|
|
||||||
5. You are not required to accept this License, since you have not
|
|
||||||
signed it. However, nothing else grants you permission to modify or
|
|
||||||
distribute the Program or its derivative works. These actions are
|
|
||||||
prohibited by law if you do not accept this License. Therefore, by
|
|
||||||
modifying or distributing the Program (or any work based on the
|
|
||||||
Program), you indicate your acceptance of this License to do so, and
|
|
||||||
all its terms and conditions for copying, distributing or modifying
|
|
||||||
the Program or works based on it.
|
|
||||||
|
|
||||||
6. Each time you redistribute the Program (or any work based on the
|
|
||||||
Program), the recipient automatically receives a license from the
|
|
||||||
original licensor to copy, distribute or modify the Program subject to
|
|
||||||
these terms and conditions. You may not impose any further
|
|
||||||
restrictions on the recipients' exercise of the rights granted herein.
|
|
||||||
You are not responsible for enforcing compliance by third parties to
|
|
||||||
this License.
|
|
||||||
|
|
||||||
7. If, as a consequence of a court judgment or allegation of patent
|
|
||||||
infringement or for any other reason (not limited to patent issues),
|
|
||||||
conditions are imposed on you (whether by court order, agreement or
|
|
||||||
otherwise) that contradict the conditions of this License, they do not
|
|
||||||
excuse you from the conditions of this License. If you cannot
|
|
||||||
distribute so as to satisfy simultaneously your obligations under this
|
|
||||||
License and any other pertinent obligations, then as a consequence you
|
|
||||||
may not distribute the Program at all. For example, if a patent
|
|
||||||
license would not permit royalty-free redistribution of the Program by
|
|
||||||
all those who receive copies directly or indirectly through you, then
|
|
||||||
the only way you could satisfy both it and this License would be to
|
|
||||||
refrain entirely from distribution of the Program.
|
|
||||||
|
|
||||||
If any portion of this section is held invalid or unenforceable under
|
|
||||||
any particular circumstance, the balance of the section is intended to
|
|
||||||
apply and the section as a whole is intended to apply in other
|
|
||||||
circumstances.
|
|
||||||
|
|
||||||
It is not the purpose of this section to induce you to infringe any
|
|
||||||
patents or other property right claims or to contest validity of any
|
|
||||||
such claims; this section has the sole purpose of protecting the
|
|
||||||
integrity of the free software distribution system, which is
|
|
||||||
implemented by public license practices. Many people have made
|
|
||||||
generous contributions to the wide range of software distributed
|
|
||||||
through that system in reliance on consistent application of that
|
|
||||||
system; it is up to the author/donor to decide if he or she is willing
|
|
||||||
to distribute software through any other system and a licensee cannot
|
|
||||||
impose that choice.
|
|
||||||
|
|
||||||
This section is intended to make thoroughly clear what is believed to
|
|
||||||
be a consequence of the rest of this License.
|
|
||||||
|
|
||||||
8. If the distribution and/or use of the Program is restricted in
|
|
||||||
certain countries either by patents or by copyrighted interfaces, the
|
|
||||||
original copyright holder who places the Program under this License
|
|
||||||
may add an explicit geographical distribution limitation excluding
|
|
||||||
those countries, so that distribution is permitted only in or among
|
|
||||||
countries not thus excluded. In such case, this License incorporates
|
|
||||||
the limitation as if written in the body of this License.
|
|
||||||
|
|
||||||
9. The Free Software Foundation may publish revised and/or new versions
|
|
||||||
of the General Public License from time to time. Such new versions will
|
|
||||||
be similar in spirit to the present version, but may differ in detail to
|
|
||||||
address new problems or concerns.
|
|
||||||
|
|
||||||
Each version is given a distinguishing version number. If the Program
|
|
||||||
specifies a version number of this License which applies to it and "any
|
|
||||||
later version", you have the option of following the terms and conditions
|
|
||||||
either of that version or of any later version published by the Free
|
|
||||||
Software Foundation. If the Program does not specify a version number of
|
|
||||||
this License, you may choose any version ever published by the Free Software
|
|
||||||
Foundation.
|
|
||||||
|
|
||||||
10. If you wish to incorporate parts of the Program into other free
|
|
||||||
programs whose distribution conditions are different, write to the author
|
|
||||||
to ask for permission. For software which is copyrighted by the Free
|
|
||||||
Software Foundation, write to the Free Software Foundation; we sometimes
|
|
||||||
make exceptions for this. Our decision will be guided by the two goals
|
|
||||||
of preserving the free status of all derivatives of our free software and
|
|
||||||
of promoting the sharing and reuse of software generally.
|
|
||||||
|
|
||||||
NO WARRANTY
|
|
||||||
|
|
||||||
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
|
|
||||||
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
|
|
||||||
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
|
|
||||||
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
|
|
||||||
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
|
|
||||||
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
|
|
||||||
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
|
|
||||||
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
|
|
||||||
REPAIR OR CORRECTION.
|
|
||||||
|
|
||||||
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
|
|
||||||
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
|
|
||||||
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
|
|
||||||
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
|
|
||||||
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
|
|
||||||
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
|
|
||||||
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
|
|
||||||
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
|
|
||||||
POSSIBILITY OF SUCH DAMAGES.
|
|
||||||
|
|
||||||
END OF TERMS AND CONDITIONS
|
|
||||||
|
|
||||||
Appendix: How to Apply These Terms to Your New Programs
|
|
||||||
|
|
||||||
If you develop a new program, and you want it to be of the greatest
|
|
||||||
possible use to the public, the best way to achieve this is to make it
|
|
||||||
free software which everyone can redistribute and change under these terms.
|
|
||||||
|
|
||||||
To do so, attach the following notices to the program. It is safest
|
|
||||||
to attach them to the start of each source file to most effectively
|
|
||||||
convey the exclusion of warranty; and each file should have at least
|
|
||||||
the "copyright" line and a pointer to where the full notice is found.
|
|
||||||
|
|
||||||
<one line to give the program's name and a brief idea of what it does.>
|
|
||||||
Copyright (C) 19yy <name of author>
|
|
||||||
|
|
||||||
This program is free software; you can redistribute it and/or modify
|
|
||||||
it under the terms of the GNU General Public License as published by
|
|
||||||
the Free Software Foundation; either version 2 of the License, or
|
|
||||||
(at your option) any later version.
|
|
||||||
|
|
||||||
This program is distributed in the hope that it will be useful,
|
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
||||||
GNU General Public License for more details.
|
|
||||||
|
|
||||||
You should have received a copy of the GNU General Public License
|
|
||||||
along with this program; if not, write to the Free Software
|
|
||||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
||||||
|
|
||||||
Also add information on how to contact you by electronic and paper mail.
|
|
||||||
|
|
||||||
If the program is interactive, make it output a short notice like this
|
|
||||||
when it starts in an interactive mode:
|
|
||||||
|
|
||||||
Gnomovision version 69, Copyright (C) 19yy name of author
|
|
||||||
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
|
|
||||||
This is free software, and you are welcome to redistribute it
|
|
||||||
under certain conditions; type `show c' for details.
|
|
||||||
|
|
||||||
The hypothetical commands `show w' and `show c' should show the appropriate
|
|
||||||
parts of the General Public License. Of course, the commands you use may
|
|
||||||
be called something other than `show w' and `show c'; they could even be
|
|
||||||
mouse-clicks or menu items--whatever suits your program.
|
|
||||||
|
|
||||||
You should also get your employer (if you work as a programmer) or your
|
|
||||||
school, if any, to sign a "copyright disclaimer" for the program, if
|
|
||||||
necessary. Here is a sample; alter the names:
|
|
||||||
|
|
||||||
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
|
|
||||||
`Gnomovision' (which makes passes at compilers) written by James Hacker.
|
|
||||||
|
|
||||||
<signature of Ty Coon>, 1 April 1989
|
|
||||||
Ty Coon, President of Vice
|
|
||||||
|
|
||||||
This General Public License does not permit incorporating your program into
|
|
||||||
proprietary programs. If your program is a subroutine library, you may
|
|
||||||
consider it more useful to permit linking proprietary applications with the
|
|
||||||
library. If this is what you want to do, use the GNU Library General
|
|
||||||
Public License instead of this License.
|
|
||||||
@ -1,8 +0,0 @@
|
|||||||
$! in case a privious submitted batchjob didn't end properly:
|
|
||||||
$ FILE = F$SEARCH("SYS$SCRATCH:ACCEL.MESSAGE")
|
|
||||||
$ IF FILE .NES. """" THEN DELETE SYS$SCRATCH:ACCEL.MESSAGE.* /NOCON
|
|
||||||
$! run accel$EXEdirectory:ACCEL
|
|
||||||
$ ACCEL
|
|
||||||
$! in case ACCEL didn't end properly:
|
|
||||||
$ FILE = F$SEARCH("SYS$SCRATCH:ACCEL.MESSAGE")
|
|
||||||
$ IF FILE .NES. """" THEN DELETE SYS$SCRATCH:ACCEL.MESSAGE.* /NOCON
|
|
||||||
@ -1,33 +0,0 @@
|
|||||||
$!******************************************************************************
|
|
||||||
$! DIESE KOMMANDOPROZEDUR DEFINIERT ALLGEMEINE LOGICALS UND SYMBOLS FUER DIE
|
|
||||||
$! ARBEIT MIT ACCEL (ALS BATCH UND INTERAKTIV)
|
|
||||||
$!******************************************************************************
|
|
||||||
$ node = "PSW264"
|
|
||||||
$
|
|
||||||
$ define /trans=con accelSRC$directory "UD1:[simula.accel.]"
|
|
||||||
$ define accel$COMdirectory "accelSRC$directory:[com]"
|
|
||||||
$ define accel$MAPPENdirectory "UD1:[simula.mappen.accel]", -
|
|
||||||
"UD1:[simula.mappen.testmappen]", -
|
|
||||||
"UD2:[simula.mappen]"
|
|
||||||
$ define accel$EXEdirectory "accelSRC$directory:[exe]"
|
|
||||||
$!==============================================================================
|
|
||||||
$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha"
|
|
||||||
$ ACCEL :== "RUN accel$EXEdirectory:ACCEL_''archi'.EXE"
|
|
||||||
$ ACDIR :== "dir accel$OUTdirectory:AC*.*.*
|
|
||||||
$ ACLIST :== "dir accel$OUTdirectory:AC*.LOG.
|
|
||||||
$ LSEAC :== "LSE accel$READdirectory:accel.input"
|
|
||||||
$ LSEACNR :== "LSE accel$NRdirectory:accel_nr.dat
|
|
||||||
$ ACSTAT :== "@ mutrack$COMdirectory:PLOT_BATCH_STATUS ACCEL AC CEL"
|
|
||||||
$ WRITEACLOG :== "@ accel$COMdirectory:WRITELOG.COM"
|
|
||||||
$ MAKEACCODE :== "@ mutrack$COMdirectory:MAKE_CODENUMMERN-LIST.COM ACCEL _AC MAKE
|
|
||||||
$ ACCODE :== "@ mutrack$COMdirectory:MAKE_CODENUMMERN-LIST.COM ACCEL _AC TYPE
|
|
||||||
$ ACCOPY :== "@ mutrack$COMdirectory:COPY.COM ACCEL AC"
|
|
||||||
$ MAKE_E0LIST :== "RUN accel$COMdirectory:MAKE_E0_LIST.EXE"
|
|
||||||
$!------------------------------------------------------------------------------
|
|
||||||
$ SUBAC*CEL :== -
|
|
||||||
"SUBMIT/NOTIFY/NOPRINT/NAME=ACCEL/LOG_FILE=accel$OUTdirectory accel$COMdirectory:ACCEL"
|
|
||||||
$ SUBACLIST*BATCH :== "@ mutrack$COMdirectory:SUB_LIST AC ACCEL ''node'_BATCH"
|
|
||||||
$ SUBACLISTF*AST :== "@ mutrack$COMdirectory:SUB_LIST AC ACCEL ''node'_FAST"
|
|
||||||
$ SUBACLISTS*LOW :== "@ mutrack$COMdirectory:SUB_LIST AC ACCEL ''node'_SLOW"
|
|
||||||
$ SUBACLISTD*EAD :== "@ mutrack$COMdirectory:SUB_LIST AC ACCEL ''node'_DEAD"
|
|
||||||
$!==============================================================================
|
|
||||||
@ -1,11 +0,0 @@
|
|||||||
$!******************************************************************************
|
|
||||||
$! DIESE KOMMANDOPROZEDUR DEFINIERT ALLGEMEINE LOGICALS UND SYMBOLS FUER DIE
|
|
||||||
$! ARBEIT MIT ACCEL (ALS BATCH UND INTERAKTIV)
|
|
||||||
$! SIE WIRD VON LOGIN.COM AUS AUFGERUFEN.
|
|
||||||
$!******************************************************************************
|
|
||||||
$ define accel$directory "UD1:[simula.accel.calc]"
|
|
||||||
$ define accel$READdirectory "accel$directory"
|
|
||||||
$ define accel$OUTdirectory "accel$directory"
|
|
||||||
$ define accel$NrDirectory "accel$directory"
|
|
||||||
$ accalc :== "SET DEF accel$directory"
|
|
||||||
$!==============================================================================
|
|
||||||
@ -1,19 +0,0 @@
|
|||||||
$!******************************************************************************
|
|
||||||
$! DIESE KOMMANDOPROZEDUR DEFINIERT LOGICALS UND SYMBOLS FUER DIE PROGRAMMIER-
|
|
||||||
$! ARBEIT, DAS KOMPILIEREN UND LINKEN VON ACCEL (INTERAKTIV)
|
|
||||||
$! SIE WIRD VON LOGIN.COM AUS AUFGERUFEN.
|
|
||||||
$!******************************************************************************
|
|
||||||
$ define accel$OBJdirectory "accelSRC$directory:[EXE]"
|
|
||||||
$ OLDAC :== "define accel$SOURCEdirectory UD1:[SIMULA.ACCEL.OLD_SOURCE]"
|
|
||||||
$ NEWAC :== "define accel$SOURCEdirectory UD1:[SIMULA.ACCEL.SOURCE]"
|
|
||||||
$ NEWAC
|
|
||||||
$!------------------------------------------------------------------------------
|
|
||||||
$ ACCOM :== "SET DEF UD1:[SIMULA.ACCEL.COM]"
|
|
||||||
$ ACSOURCE :== "SET DEF accel$SOURCEdirectory"
|
|
||||||
$ ACMAP :== "SET DEF accel$MAPPENdirectory"
|
|
||||||
$ FORAC :== "@mutrack$COMdirectory:compile.com ACCEL _AC "
|
|
||||||
$ LINKAC :== "@accel$COMdirectory:linkac.com"
|
|
||||||
$ LINKACV :== "@accel$COMdirectory:linkacv.com"
|
|
||||||
$ LINKACD :== "@accel$COMdirectory:linkacd.com"
|
|
||||||
$ LINKACVD :== "@accel$COMdirectory:linkacvd.com"
|
|
||||||
$!==============================================================================
|
|
||||||
@ -1,6 +0,0 @@
|
|||||||
DEFINE VERB MakeWriteLogOut
|
|
||||||
IMAGE "accel$COMdirectory:MAKEWRITELOGOUT"
|
|
||||||
PARAMETER P1
|
|
||||||
LABEL = RUNNUMBER
|
|
||||||
VALUE (REQUIRED)
|
|
||||||
PROMPT = "vierstellige Runnummer"
|
|
||||||
@ -1 +0,0 @@
|
|||||||
copy /log PSICLU::USR_SCROOT:[AHOFER]AC_'P1'.*. accel$OUTdirectory:*.*.
|
|
||||||
@ -1 +0,0 @@
|
|||||||
copy /log PSICLU::USR_SCROOT:[GLUECKLER]AC_'P1'.*. accel$OUTdirectory:*.*.
|
|
||||||
@ -1,31 +0,0 @@
|
|||||||
$ set noverify
|
|
||||||
$ set noon
|
|
||||||
$!==============================================================================
|
|
||||||
$ prog= "accel"
|
|
||||||
$ ext = "_AC"
|
|
||||||
$!==============================================================================
|
|
||||||
$ sourceDir = "''prog'$SOURCEdirectory"
|
|
||||||
$ objectDir = "''prog'$OBJdirectory"
|
|
||||||
$ executeDir = "''prog'$EXEdirectory"
|
|
||||||
$!==============================================================================
|
|
||||||
$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha"
|
|
||||||
$ ext = "''ext'_''archi'"
|
|
||||||
$ set verify
|
|
||||||
$!==============================================================================
|
|
||||||
$ link -
|
|
||||||
'objectDir':ACCEL'ext', -
|
|
||||||
'objectDir':SUB_ARTLIST'ext', -
|
|
||||||
'objectDir':SUB_INTEGR_1'ext', -
|
|
||||||
'objectDir':SUB_INTEGR_2'ext', -
|
|
||||||
'objectDir':SUB_INTEGR_3'ext', -
|
|
||||||
'objectDir':SUB_INTEGR_4'ext', -
|
|
||||||
'objectDir':SUB_INTEGR_5'ext', -
|
|
||||||
'objectDir':SUB_INTEGR_6'ext', -
|
|
||||||
'objectDir':SUB_INPUT'ext', -
|
|
||||||
'objectDir':SUB_PICTURE'ext', -
|
|
||||||
'objectDir':SUB_OUTPUT'ext',-
|
|
||||||
'cernlibs' /exe='executeDir':ACCEL_'archi'
|
|
||||||
$ purge 'executeDir':*.EXE
|
|
||||||
$ set on
|
|
||||||
$ set noverify
|
|
||||||
$!==============================================================================
|
|
||||||
@ -1,16 +0,0 @@
|
|||||||
$ set verify
|
|
||||||
$ link -
|
|
||||||
accel$directory:[exe]ACCEL, -
|
|
||||||
accel$directory:[exe]SUB_ARTLIST, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_1, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_2, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_3, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_4, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_5, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_6, -
|
|
||||||
accel$directory:[exe]SUB_INPUT, -
|
|
||||||
accel$directory:[exe]SUB_PICTURE, -
|
|
||||||
accel$directory:[exe]SUB_OUTPUT,-
|
|
||||||
'cernlibs' /debug /exe=accel$directory:[exe]accel
|
|
||||||
$ purge /log accel$directory:[exe]
|
|
||||||
$ set noverify
|
|
||||||
@ -1,76 +0,0 @@
|
|||||||
$ set noverify
|
|
||||||
$!==============================================================================
|
|
||||||
$! Author: Anselm Hofer
|
|
||||||
$!
|
|
||||||
$! Commandoprozedur fuer das Compilieren und Linken des kompletten ACCEL-
|
|
||||||
$! Quelltextes. Aufzurufen mittels '$ LINKACV'. ('V' steht fuer 'Vollstaendig').
|
|
||||||
$!==============================================================================
|
|
||||||
$ set noon
|
|
||||||
$!==============================================================================
|
|
||||||
$ prog= "accel"
|
|
||||||
$ ext = "_AC"
|
|
||||||
$!==============================================================================
|
|
||||||
$ sourceDir = "''prog'$SOURCEdirectory"
|
|
||||||
$ objectDir = "''prog'$OBJdirectory"
|
|
||||||
$ executeDir = "''prog'$EXEdirectory"
|
|
||||||
$!==============================================================================
|
|
||||||
$ options = "/fast /nolist"
|
|
||||||
$! options = "/fast /nolist /warn=nogeneral"
|
|
||||||
$!==============================================================================
|
|
||||||
$ archi = F$GETSYI("ARCH_NAME") ! Host OS either "VAX" or "Alpha"
|
|
||||||
$ ext = "''ext'_''archi'"
|
|
||||||
$ if archi .EQS. "VAX" then options = ""
|
|
||||||
$ if P1 .NES. "" then options = "''options' ''P1'"
|
|
||||||
$
|
|
||||||
$ file = "ACCEL"
|
|
||||||
$ CALL compile
|
|
||||||
$ file = "SUB_ARTLIST
|
|
||||||
$ CALL compile
|
|
||||||
$ file = "SUB_INTEGR_1
|
|
||||||
$ CALL compile
|
|
||||||
$ file = "SUB_INTEGR_2
|
|
||||||
$ CALL compile
|
|
||||||
$ file = "SUB_INTEGR_3
|
|
||||||
$ CALL compile
|
|
||||||
$ file = "SUB_INTEGR_4
|
|
||||||
$ CALL compile
|
|
||||||
$ file = "SUB_INTEGR_5
|
|
||||||
$ CALL compile
|
|
||||||
$ file = "SUB_INTEGR_6
|
|
||||||
$ CALL compile
|
|
||||||
$ file = "SUB_INPUT
|
|
||||||
$ CALL compile
|
|
||||||
$ file = "SUB_PICTURE
|
|
||||||
$ CALL compile
|
|
||||||
$ file = "SUB_OUTPUT
|
|
||||||
$ CALL compile
|
|
||||||
$!==============================================================================
|
|
||||||
$ set verify
|
|
||||||
$ purge 'objectDir':*.OBJ
|
|
||||||
$ link -
|
|
||||||
'objectDir':ACCEL'ext', -
|
|
||||||
'objectDir':SUB_ARTLIST'ext', -
|
|
||||||
'objectDir':SUB_INTEGR_1'ext', -
|
|
||||||
'objectDir':SUB_INTEGR_2'ext', -
|
|
||||||
'objectDir':SUB_INTEGR_3'ext', -
|
|
||||||
'objectDir':SUB_INTEGR_4'ext', -
|
|
||||||
'objectDir':SUB_INTEGR_5'ext', -
|
|
||||||
'objectDir':SUB_INTEGR_6'ext', -
|
|
||||||
'objectDir':SUB_INPUT'ext', -
|
|
||||||
'objectDir':SUB_PICTURE'ext', -
|
|
||||||
'objectDir':SUB_OUTPUT'ext',-
|
|
||||||
'cernlibs' /exe='executeDir':ACCEL_'archi'
|
|
||||||
$ purge 'executeDir':*.EXE
|
|
||||||
$ set on
|
|
||||||
$ set noverify
|
|
||||||
$ EXIT
|
|
||||||
$
|
|
||||||
$!==============================================================================
|
|
||||||
$
|
|
||||||
$ COMPILE: SUBROUTINE
|
|
||||||
$ comp = "fortran ''sourceDir':''file' ''options' /object=''objectDir':''file'''ext'"
|
|
||||||
$ write sys$output "=============================================================================="
|
|
||||||
$ write sys$output "''COMP'"
|
|
||||||
$ comp
|
|
||||||
$ ENDSUBROUTINE
|
|
||||||
$!==============================================================================
|
|
||||||
@ -1,38 +0,0 @@
|
|||||||
$ set verify
|
|
||||||
$ fortran accel$SOURCEdirectory:accel /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe]
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_ARTLIST /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe]
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_1 /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe]
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_2 /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe]
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_3 /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe]
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_4 /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe]
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_5 /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe]
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_6 /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe]
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INPUT /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe]
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_PICTURE /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe]
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_OUTPUT /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe]
|
|
||||||
$ link -
|
|
||||||
accel$directory:[exe]accel, -
|
|
||||||
accel$directory:[exe]SUB_ARTLIST, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_1, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_2, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_3, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_4, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_5, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_6, -
|
|
||||||
accel$directory:[exe]SUB_INPUT, -
|
|
||||||
accel$directory:[exe]SUB_PICTURE, -
|
|
||||||
accel$directory:[exe]SUB_OUTPUT,-
|
|
||||||
'cernlibs' /debug /exe=accel$directory:[exe]accel
|
|
||||||
$ purge /log accel$directory:[exe]
|
|
||||||
$ set noverify
|
|
||||||
@ -1,38 +0,0 @@
|
|||||||
$ set verify
|
|
||||||
$ fortran accel$SOURCEdirectory:accel /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_ARTLIST /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_1 /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_2 /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_3 /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_4 /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_5 /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_6 /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INPUT /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_PICTURE /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_OUTPUT /warn=nogen -
|
|
||||||
/check /list /debug /noopt /object=accel$directory:[exe] /d_line
|
|
||||||
$ link -
|
|
||||||
accel$directory:[exe]accel, -
|
|
||||||
accel$directory:[exe]SUB_ARTLIST, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_1, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_2, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_3, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_4, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_5, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_6, -
|
|
||||||
accel$directory:[exe]SUB_INPUT, -
|
|
||||||
accel$directory:[exe]SUB_PICTURE, -
|
|
||||||
accel$directory:[exe]SUB_OUTPUT,-
|
|
||||||
'cernlibs' /debug /exe=accel$directory:[exe]accel
|
|
||||||
$ purge /log accel$directory:[exe]
|
|
||||||
$ set noverify
|
|
||||||
@ -1,47 +0,0 @@
|
|||||||
$ set verify
|
|
||||||
$ fortran accel$SOURCEdirectory:ACCEL -
|
|
||||||
/warn=nogeneral /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_ARTLIST -
|
|
||||||
/warn=nogeneral /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_1 -
|
|
||||||
/warn=nogeneral /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_2 -
|
|
||||||
/warn=nogeneral /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_3 -
|
|
||||||
/warn=nogeneral /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_4 -
|
|
||||||
/warn=nogeneral /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_5 -
|
|
||||||
/warn=nogeneral /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INTEGR_6 -
|
|
||||||
/warn=nogeneral /object=accel$directory:[exe] /d_line
|
|
||||||
$! fortran accel$SOURCEdirectory:SUB_INTEGR_7 -
|
|
||||||
$! /warn=nogeneral /object=accel$directory:[exe] /d_line
|
|
||||||
$! fortran accel$SOURCEdirectory:SUB_INTEGR_8 -
|
|
||||||
$! /warn=nogeneral /object=accel$directory:[exe] /d_line
|
|
||||||
$! fortran accel$SOURCEdirectory:SUB_INTEGR_9 -
|
|
||||||
$! /warn=nogeneral /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_INPUT -
|
|
||||||
/warn=nogeneral /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_ACPIC -
|
|
||||||
/warn=nogeneral /object=accel$directory:[exe] /d_line
|
|
||||||
$ fortran accel$SOURCEdirectory:SUB_OUTPUT -
|
|
||||||
/warn=nogeneral /object=accel$directory:[exe] /d_line
|
|
||||||
$ link -
|
|
||||||
accel$directory:[exe]ACCEL, -
|
|
||||||
accel$directory:[exe]SUB_ARTLIST, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_1, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_2, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_3, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_4, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_5, -
|
|
||||||
accel$directory:[exe]SUB_INTEGR_6, -
|
|
||||||
$! accel$directory:[exe]SUB_INTEGR_7, -
|
|
||||||
$! accel$directory:[exe]SUB_INTEGR_8, -
|
|
||||||
$! accel$directory:[exe]SUB_INTEGR_9, -
|
|
||||||
accel$directory:[exe]SUB_INPUT, -
|
|
||||||
accel$directory:[exe]SUB_ACPIC, -
|
|
||||||
accel$directory:[exe]SUB_OUTPUT,-
|
|
||||||
'cernlibs' /exe=accel$directory:[exe]ACCEL
|
|
||||||
$ purge /log accel$directory:[exe]
|
|
||||||
$ set noverify
|
|
||||||
@ -1,10 +0,0 @@
|
|||||||
$ fortran p-source$directory:[source]SUB_INTEGR -
|
|
||||||
/warn=nogeneral /object=p-source$directory:[exe]
|
|
||||||
$ link -
|
|
||||||
p-source$directory:[exe]P-SOURCE, -
|
|
||||||
p-source$directory:[exe]SUB_ARTLIST, -
|
|
||||||
p-source$directory:[exe]SUB_INTEGR, -
|
|
||||||
p-source$directory:[exe]SUB_INPUT, -
|
|
||||||
p-source$directory:[exe]SUB_PPIC, -
|
|
||||||
p-source$directory:[exe]SUB_OUTPUT,-
|
|
||||||
'cernlibs' /exe=p-source$directory:[exe]p-source
|
|
||||||
@ -1,98 +0,0 @@
|
|||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
c PROGRAM WRITELOG
|
|
||||||
c ================
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
c Dieses Programm uebernimmt aus der Command Zeile eine Runnummer und
|
|
||||||
c uebertraegt den Header des zugehoerigen Logfiles in WRITELOG_nnnn.OUT.
|
|
||||||
c gleich wieder loescht.
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
c Deklarationen fuer das Einlesen der Runnummer von der Commandline:
|
|
||||||
|
|
||||||
external cli$get_value
|
|
||||||
integer cli$get_value
|
|
||||||
integer status
|
|
||||||
|
|
||||||
character*4 runNumber
|
|
||||||
integer length
|
|
||||||
|
|
||||||
|
|
||||||
c sonstige Deklarationen:
|
|
||||||
|
|
||||||
character*80 zeile
|
|
||||||
integer i,iostat,marke
|
|
||||||
logical flag
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
|
|
||||||
c Lies Runnummer aus Commandline:
|
|
||||||
|
|
||||||
status = cli$get_value('runNumber',runNumber,length)
|
|
||||||
if (.NOT.status) call lib$signal(%val(status))
|
|
||||||
call str$trim(runNumber,runNumber,length)
|
|
||||||
|
|
||||||
|
|
||||||
c Oeffne zugehoeriges LOGfile:
|
|
||||||
|
|
||||||
open (20,file='accel$OUTdirectory:AC_'//runNumber//'.LOG',status='OLD',
|
|
||||||
+ readonly,iostat=iostat)
|
|
||||||
|
|
||||||
if (iostat.NE.0) then
|
|
||||||
write(*,*)
|
|
||||||
write(*,*)'can''t find accel$OUTdirectory:AC_'//runNumber//'.LOG'
|
|
||||||
write(*,*)'-> STOP'
|
|
||||||
write(*,*)
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
c Oeffne WRITELOG_nnnn.OUT:
|
|
||||||
|
|
||||||
open (21,file='accel$OUTdirectory:WRITELOG_'//runNumber//'.OUT',
|
|
||||||
+ status='NEW')
|
|
||||||
|
|
||||||
|
|
||||||
c Uebertrage die Headerzeilen:
|
|
||||||
|
|
||||||
c do i = 1, 130
|
|
||||||
c read(20,'(A)',end=20) zeile
|
|
||||||
c write(21,'(xA)') zeile
|
|
||||||
c enddo
|
|
||||||
c write(21,*)
|
|
||||||
c write(21,*)' >>>>>>>>>> AUSDRUCK HIER ABGEBROCHEN >>>>>>>>>>'
|
|
||||||
|
|
||||||
c - Teste, ob LOGfile mehr als 140 Zeilen hat. Falls ja, drucke nur den
|
|
||||||
c Haeder. Andernfalls drucke das ganze Logfile
|
|
||||||
|
|
||||||
flag = .false.
|
|
||||||
marke = -10
|
|
||||||
do i = 1, 141
|
|
||||||
read(20,'(A)',end=10) zeile
|
|
||||||
if (index(Zeile,'>>>>> T E S T - R U N <<<<<').NE.0) marke = i
|
|
||||||
enddo
|
|
||||||
flag = .true. ! -> nur Headerzeilen schreiben
|
|
||||||
|
|
||||||
10 rewind (20)
|
|
||||||
do i = 1, 140
|
|
||||||
read(20,'(A)',end=20) zeile
|
|
||||||
if (flag .AND. index(Zeile,'>>> Schleife :').NE.0) goto 20
|
|
||||||
if (i.NE.marke .AND. i.NE.marke+1) then
|
|
||||||
write(21,'(xA)') zeile
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
|
|
||||||
|
|
||||||
c Schliesse die Files:
|
|
||||||
|
|
||||||
20 close (20)
|
|
||||||
close (21)
|
|
||||||
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
@ -1,167 +0,0 @@
|
|||||||
|
|
||||||
options /extend_source
|
|
||||||
|
|
||||||
program MAKE_E0_LIST
|
|
||||||
c ====================
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
c Dieses Fortran-Programm erstellt Files 'E0-Intervalls.input_', die durch
|
|
||||||
c Editieren (falls noetig) und Umbenennen in 'E0-Intervalls.input' (ohne
|
|
||||||
c '_' am Ende) als entsprechende Eingabefiles fuer ACCEL verwendet werden
|
|
||||||
c koennen. Der Inhalt dieser Datei umfasst die Definition von Startenergie-
|
|
||||||
c intervallen, fuer die ACCEL-Simulationen durchgefuehrt werden sollen.
|
|
||||||
c
|
|
||||||
c Hierbei geht es um die Bereitstellung der fuer die Anpassung der Austritts-
|
|
||||||
c energie der langsamen MYonen benoetigten Simulationen.
|
|
||||||
c
|
|
||||||
c Der untere Wert des ersten Startenergieintervalles, die Breite des ersten
|
|
||||||
c Intervalles, und die Zunahme der Intervallbreite von einem zum naechsten
|
|
||||||
c Intervall sowie die Anzahl der so zu erstellenden Intervalle werden zunaechst
|
|
||||||
c eingelesen und die entsprechenden Daten in das Ausgabefile geschrieben.
|
|
||||||
c
|
|
||||||
c Um weiter Intervalle mit anderen Intervallbreiten-Incrementen anhaengen zu
|
|
||||||
c koennen, wird dann wiederum die Breite des ersten hinzuzufuegenden Intervalles
|
|
||||||
c sowie das neue Increment und die Anzahl damit anzuhaengender Intervalle
|
|
||||||
c eingelesen. Das wiederholt sich dann so lange, bis eine negative Zahl
|
|
||||||
c eingegeben wird. Dann wird das File geschlossen und das Programm beendet.
|
|
||||||
c
|
|
||||||
c Das File wird in 'ACCEL$READdirectory' erstellt
|
|
||||||
c
|
|
||||||
c Anselm Hofer
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
integer lunOUT
|
|
||||||
parameter (lunOUT = 10)
|
|
||||||
|
|
||||||
integer E0 /0/ ,E0Binwidth /2/ ,BinwidthIncr /0/
|
|
||||||
integer E0_ ,E0Binwidth_ ,BinwidthIncr_
|
|
||||||
integer nBins /20/, nBins_, i, lun, indx /1/, indx_
|
|
||||||
|
|
||||||
character*10 answer
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
c Oeffnen des Files:
|
|
||||||
|
|
||||||
open (lunOUT,file='E0-Intervalls.input_',status='new',
|
|
||||||
+ defaultFile='ACCEL$READdirectory')
|
|
||||||
|
|
||||||
write(lunOUT,*) '*==============================================================================='
|
|
||||||
write(lunOUT,*) '* In dieser Datei koennen (aneinandergrenzende) E0-Intervalle fuer ACCEL'
|
|
||||||
write(lunOUT,*) '* vorgegeben werden! Die Intervalle laufen dabei von der Angabe der i. bis'
|
|
||||||
write(lunOUT,*) '* zur Angabe der i+1. Datenzeile. Die DATENzeilen 2 bis n-1 geben also'
|
|
||||||
write(lunOUT,*) '* jeweils das Ende des einen sowie gleichzeitig den Anfang des anderen'
|
|
||||||
write(lunOUT,*) '* Intervalls an.'
|
|
||||||
write(lunOUT,*) '*'
|
|
||||||
write(lunOUT,*) '* Die E0-Angaben erfolgen in keV-Einheiten!'
|
|
||||||
write(lunOUT,*) '*'
|
|
||||||
write(lunOUT,*) '* Beispiel:'
|
|
||||||
write(lunOUT,*) '* Die Datenzeilen'
|
|
||||||
write(lunOUT,*) '*'
|
|
||||||
write(lunOUT,*) '* 0.010'
|
|
||||||
write(lunOUT,*) '* 0.040'
|
|
||||||
write(lunOUT,*) '* 0.100'
|
|
||||||
write(lunOUT,*) '*'
|
|
||||||
write(lunOUT,*) '* geben zwei E0-Intervalle an: von 10 eV bis 40 eV und von 40 eV bis 100 eV.'
|
|
||||||
write(lunOUT,*) '*'
|
|
||||||
write(lunOUT,*) '* eine Zeile mit mindestens 5 aufeinanderfolgenden x (''xxxxx'') markiert ge-'
|
|
||||||
write(lunOUT,*) '* gebenenfalls das Ende der Datenzeilen. Nachfolgende Zeilen werden ignoriert.'
|
|
||||||
write(lunOUT,*) '*'
|
|
||||||
write(lunOUT,*) '* Der Inhalt dieser Datei wird mit ''E0InterFromFile = .true.'' in ACCEL.INPUT'
|
|
||||||
write(lunOUT,*) '* aktiviert.'
|
|
||||||
write(lunOUT,*) '*==============================================================================='
|
|
||||||
|
|
||||||
|
|
||||||
1000 format ($,x,A,:' (.LT.0 => finish) [',I4,'] > ')
|
|
||||||
1001 format ($,x,A,:' [',I4,'] > ')
|
|
||||||
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) 'alle Eingaben in eV!'
|
|
||||||
write(*,*)
|
|
||||||
write(*,1001) ' lower E0 ',E0
|
|
||||||
read(*,'(A)') answer
|
|
||||||
if (answer.NE.' ') read(answer,*) E0
|
|
||||||
|
|
||||||
write(lunOUT,'(x,F8.3)') real(E0) / 1000.
|
|
||||||
|
|
||||||
|
|
||||||
c Einlesen und Ausgeben ...:
|
|
||||||
|
|
||||||
10 write(*,*)
|
|
||||||
|
|
||||||
write(*,1000) ' first E0-Binwidth ',E0Binwidth
|
|
||||||
read(*,'(A)') answer
|
|
||||||
if (answer.NE.' ') read(answer,*) E0Binwidth
|
|
||||||
if (E0Binwidth.LE.0) goto 100
|
|
||||||
|
|
||||||
write(*,1000) ' Binwidth-increment ',BinwidthIncr
|
|
||||||
read(*,'(A)') answer
|
|
||||||
if (answer.NE.' ') read(answer,*) BinwidthIncr
|
|
||||||
if (BinwidthIncr.LT.0) goto 100
|
|
||||||
|
|
||||||
write(*,1000) ' number of bins to add ', nBins
|
|
||||||
read(*,'(A)') answer
|
|
||||||
if (answer.NE.' ') read(answer,*) nBins
|
|
||||||
if (nBins.LE.0) goto 100
|
|
||||||
|
|
||||||
E0_ = E0
|
|
||||||
E0Binwidth_ = E0Binwidth
|
|
||||||
BinwidthIncr_ = BinwidthIncr
|
|
||||||
nBins_ = nBins
|
|
||||||
indx_ = indx
|
|
||||||
|
|
||||||
lun = 6
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) ' so, next intervalls would be: (number, lowerE0, upperE0, binWidth)'
|
|
||||||
write(*,*)
|
|
||||||
write(*,2000) indx,E0, E0 + E0BinWidth,E0BinWidth
|
|
||||||
|
|
||||||
2000 format (x,I3,': ',I5,'-',I5, 4x,'(',I4,')')
|
|
||||||
50 do i = 1, nBins
|
|
||||||
indx = indx + 1
|
|
||||||
E0 = E0 + E0BinWidth
|
|
||||||
if (lun.EQ.6) then
|
|
||||||
if (i.NE.nBins) write(*,2000) indx,E0, E0+E0BinWidth+BinwidthIncr,E0BinWidth+BinwidthIncr
|
|
||||||
else
|
|
||||||
write(lun,'(x,F8.3)') real(E0) / 1000.
|
|
||||||
endif
|
|
||||||
E0BinWidth = E0BinWidth + BinwidthIncr
|
|
||||||
enddo
|
|
||||||
|
|
||||||
if (lun.EQ.6) then
|
|
||||||
|
|
||||||
write(*,*)
|
|
||||||
write(*,1001) ' add them to file ? > '
|
|
||||||
read(*,'(A)') answer
|
|
||||||
call str$upcase(answer,answer)
|
|
||||||
|
|
||||||
E0 = E0_
|
|
||||||
E0Binwidth = E0Binwidth_
|
|
||||||
BinwidthIncr = BinwidthIncr_
|
|
||||||
nBins = nBins_
|
|
||||||
indx = indx_
|
|
||||||
|
|
||||||
if (index(answer,'Y').NE.0 .OR. index(answer,'J').NE.0) then
|
|
||||||
lun = lunOUT
|
|
||||||
goto 50
|
|
||||||
else
|
|
||||||
write(*,*) '=> cancel'
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
|
|
||||||
goto 10
|
|
||||||
|
|
||||||
c Schliessen des Ausgabefiles:
|
|
||||||
|
|
||||||
100 close (lunOUT)
|
|
||||||
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) ' -> created file ''accel$READdirectory:E0-Intervalls.input_'''
|
|
||||||
write(*,*)
|
|
||||||
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
@ -1,49 +0,0 @@
|
|||||||
$! KOMMANDOPROZEDUR FUER DEN AUSDRUCK DER HEADERZEILEN VON 'AC_nnnn.LOG'-Dateien
|
|
||||||
$! =============================================================================
|
|
||||||
$!
|
|
||||||
$ SET NOON
|
|
||||||
$ SET NOVERIFY
|
|
||||||
$ SAY := WRITE SYS$OUTPUT
|
|
||||||
$ SET COMMAND accel$COMdirectory:DEF_MAKEWRITELOGOUT.CLD
|
|
||||||
$ ! FILE MIT HEADERZEILEN ERSTELLEN LASSEN:
|
|
||||||
$ IF P1 .EQS. ""
|
|
||||||
$ THEN
|
|
||||||
$ SAY "%WRITELOG: error: NO RUN NUMBER GIVEN IN COMMANDLINE"
|
|
||||||
$ EXIT
|
|
||||||
$ ENDIF
|
|
||||||
$ IF P1 .EQS. "?"
|
|
||||||
$ THEN
|
|
||||||
$ SAY " "
|
|
||||||
$ SAY " WRITEACLOG runNr [destinaton]"
|
|
||||||
$ SAY " "
|
|
||||||
$ SAY " destination not specified -> output to screen"
|
|
||||||
$ SAY " "
|
|
||||||
$ SAY " accepted destinations are: PSW04, PSW23, PRL, PRL2 (have to be given in upper case!)"
|
|
||||||
$ SAY " "
|
|
||||||
$ EXIT
|
|
||||||
$ ENDIF
|
|
||||||
$ IF (P2.NES."PSW04" .AND. P2.NES."PSW23" .AND. P2.NES."PRL" .AND. P2.NES."PRL2" .AND. P2.NES."")
|
|
||||||
$ THEN
|
|
||||||
$ SAY " "
|
|
||||||
$ SAY " ""''P2'"" is not an accepted destination!"
|
|
||||||
$ SAY " accepted destinations are: PSW04, PSW23, PRL, PRL2 (UPPER CASE ONLY!)"
|
|
||||||
$ SAY " "
|
|
||||||
$ EXIT
|
|
||||||
$ ENDIF
|
|
||||||
$!
|
|
||||||
$ MAKEWRITELOGOUT "''P1'"
|
|
||||||
$ OUTFILENAME = "accel$OUTdirectory:WRITELOG_" + "''P1'" + ".OUT;"
|
|
||||||
$ say "''outfilename'"
|
|
||||||
$ IF P2 .EQS. ""
|
|
||||||
$ THEN
|
|
||||||
$ TY 'OUTFILENAME'
|
|
||||||
$ DELETE /NOCON 'OUTFILENAME'
|
|
||||||
$ WRITE SYS$OUTPUT "================================================================================"
|
|
||||||
$ EXIT
|
|
||||||
$ ENDIF
|
|
||||||
$ IF (P2.EQS."PRL" .OR. P2.EQS."PRL2")
|
|
||||||
$ THEN
|
|
||||||
$ PRL2 'OUTFILENAME' /del
|
|
||||||
$ EXIT
|
|
||||||
$ ENDIF
|
|
||||||
$ VPP 'OUTFILENAME' /delete /dev=printer /form=listq /dest= "''P2'"
|
|
||||||
2377
accel/src/ACCEL.FOR
2377
accel/src/ACCEL.FOR
File diff suppressed because it is too large
Load Diff
@ -1,118 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c ADD_MAP.INC
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c Dieser Includefile erledigt fuer die Subroutinen 'ADD_MAP_Nr' das Einlesen
|
|
||||||
c der '_Tgt_Nr'-, der '_Gi1_Nr'- sowie gegebenenfalls der '_Gua_Nr'- Mappen
|
|
||||||
c und das Aufaddieren entsprechend den aktuellen Spannungen.
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_HVs.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_DIRS.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
|
|
||||||
|
|
||||||
real read_memory(0:100)
|
|
||||||
COMMON /read_memory/ read_memory ! COMMON nur, damit nicht jede
|
|
||||||
! Mappe extra Speicher belegt.
|
|
||||||
|
|
||||||
integer i,j,k, ihelp, iostat
|
|
||||||
|
|
||||||
|
|
||||||
c Einlesen der '_Tgt_nr'-Potentialmappe:
|
|
||||||
|
|
||||||
if (mappenName.EQ.'RUN9') then
|
|
||||||
open (lunRead,file='RUN6_NEW_Tgt_'//Nr,
|
|
||||||
+ defaultfile=mappenDir//':.MAPPE',status='old',
|
|
||||||
+ form='unformatted',recl=imax+1,readonly)
|
|
||||||
c + form='unformatted',recl=imax,readonly)
|
|
||||||
else
|
|
||||||
open (lunRead,file=mappenName//'_Tgt_'//Nr,
|
|
||||||
+ defaultfile=mappenDir//':.MAPPE',status='old',
|
|
||||||
+ form='unformatted',recl=imax+1,readonly)
|
|
||||||
c + form='unformatted',recl=imax,readonly)
|
|
||||||
endif
|
|
||||||
write(*,*) 'constructing map '//Nr//' ...'
|
|
||||||
do k = 0, kmax
|
|
||||||
do j = 0, jmax
|
|
||||||
c read(lunREAD,iostat=iostat) (map(i,j,k),i=0,imax)
|
|
||||||
ihelp = (k*(jmax+1)+j)*(imax+1)
|
|
||||||
read(lunREAD,iostat=iostat) (map(ihelp+i),i=0,imax)
|
|
||||||
if (iostat.NE.0) then
|
|
||||||
write(*,*)
|
|
||||||
write(*,999) i,j,k,iostat
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
close(lunREAD)
|
|
||||||
999 format(x/'error reading grid point (i,j,k) = ('i4','i4','
|
|
||||||
+ i4')'/'iostat = 'i4/)
|
|
||||||
|
|
||||||
|
|
||||||
c Angleichen der Potentialmappe an UTgt:
|
|
||||||
|
|
||||||
ihelp = 0
|
|
||||||
do k=0, kmax
|
|
||||||
do j=0, jmax
|
|
||||||
do i=0, imax
|
|
||||||
c map(i,j,k) = UTgt*abs(map(i,j,k))
|
|
||||||
map(ihelp) = UTgt*abs(map(ihelp))
|
|
||||||
ihelp = ihelp + 1
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
|
|
||||||
c Einlesen und Addieren der '_Gua_nr'-Potentialmappe (mit 'UGua' multipliziert):
|
|
||||||
|
|
||||||
if (freeGuard) then
|
|
||||||
open (lunRead,file=mappenName//'_Gua_'//Nr,
|
|
||||||
+ defaultfile=mappenDir//':.MAPPE',status='old',
|
|
||||||
+ form='unformatted',recl=imax+1,readonly)
|
|
||||||
c + form='unformatted',recl=imax,readonly)
|
|
||||||
ihelp = 0
|
|
||||||
do k = 0, kmax
|
|
||||||
do j = 0, jmax
|
|
||||||
read(lunRead,iostat=iostat) (read_memory(i),i=0,imax)
|
|
||||||
if (iostat.NE.0) then
|
|
||||||
write(*,*)
|
|
||||||
write(*,999) i,j,k,iostat
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
do i=0, imax
|
|
||||||
map(ihelp) = map(ihelp) + UGua*abs(read_memory(i))
|
|
||||||
ihelp = ihelp + 1
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
close(lunREAD)
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
c Einlesen und Addieren der '_Gi1_nr'-Potentialmappe (mit 'UG1' multipliziert):
|
|
||||||
|
|
||||||
open (lunRead,file=mappenName//'_Gi1_'//Nr,
|
|
||||||
+ defaultfile=mappenDir//':.MAPPE',status='old',
|
|
||||||
+ form='unformatted',recl=imax+1,readonly)
|
|
||||||
c + form='unformatted',recl=imax,readonly)
|
|
||||||
ihelp = 0
|
|
||||||
do k = 0, kmax
|
|
||||||
do j = 0, jmax
|
|
||||||
read(lunRead,iostat=iostat) (read_memory(i),i=0,imax)
|
|
||||||
if (iostat.NE.0) then
|
|
||||||
write(*,*)
|
|
||||||
write(*,999) i,j,k,iostat
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
do i=0, imax
|
|
||||||
c map(i,j,k) = map(i,j,k) + UG1*abs(read_memory(i))
|
|
||||||
map(ihelp) = map(ihelp) + UG1*abs(read_memory(i))
|
|
||||||
ihelp = ihelp + 1
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
close(lunREAD)
|
|
||||||
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
@ -1,38 +0,0 @@
|
|||||||
c===============================================================================
|
|
||||||
c CALC_3D-FIELD_1
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c Dieses Include-file wird in Unterprogramme 'EFELD_mappenname(x,E)' fuer die
|
|
||||||
c Berechnung von elektrischen Feldstaerken aus dreidimensionalen Potential-
|
|
||||||
c mappen eingebunden.
|
|
||||||
|
|
||||||
c Zusaetzlich zu diesem Includefile wird das Includefile 'CALC_3D-FIELD_2.INC'
|
|
||||||
c benoetigt.
|
|
||||||
|
|
||||||
|
|
||||||
real real_i,real_j,real_k ! x,y,z im Mappensystem in Gittereinheiten
|
|
||||||
|
|
||||||
integer stuetzstelle_i(2) ! naechste Stuetzstellen in x-,
|
|
||||||
integer stuetzstelle_j(2) ! y- und
|
|
||||||
integer stuetzstelle_k(2) ! z- Richtung
|
|
||||||
|
|
||||||
real Abstand_i,Abstand_i_Betrag ! Entfernung zur naechsten Stuetzstelle
|
|
||||||
real Abstand_j,Abstand_j_Betrag ! (in Gittereinheiten!)
|
|
||||||
real Abstand_k,Abstand_k_Betrag
|
|
||||||
|
|
||||||
integer i,j,k, n,m, ihelp
|
|
||||||
|
|
||||||
real x(3),E(3) ! Ort und Feldstaerke
|
|
||||||
real E_(2),E__(2) ! Hilfsspeicher fuer Feldberechnung
|
|
||||||
|
|
||||||
|
|
||||||
c Falls Testort ausserhalb der Mappe liegt oder Anode getroffen hat:
|
|
||||||
|
|
||||||
integer returnCode_EFeld
|
|
||||||
COMMON /returnCode_EFeld/ returnCode_EFeld
|
|
||||||
! 1: Testort hinter der Mappe
|
|
||||||
! 2: Testort neben der Mappe
|
|
||||||
! 3: Testort vor der Mappe
|
|
||||||
! 101: .... getroffene Elektroden
|
|
||||||
|
|
||||||
|
|
||||||
@ -1,195 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c CALC_3D-FIELD_2
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c Dieses Include-file wird in Unterprogramme 'EFELD_mappenname(x,E)' fuer die
|
|
||||||
c Berechnung von elektrischen Feldstaerken aus dreidimensionalen Potential-
|
|
||||||
c mappen eingebunden.
|
|
||||||
|
|
||||||
c Zusaetzlich zu diesem Includefile wird das Includefile 'CALC_3D-FIELD_1.INC'
|
|
||||||
c benoetigt.
|
|
||||||
|
|
||||||
c...............................................................................
|
|
||||||
|
|
||||||
c Teste, ob Raumpunkt innerhalb der Potentialmappe liegt:
|
|
||||||
|
|
||||||
if (real_j.GT.jmax .OR. real_k.GT.kmax) then
|
|
||||||
returnCode_EFeld = 2
|
|
||||||
RETURN 1
|
|
||||||
elseif (real_i.GT.imax) then
|
|
||||||
if (real_i.LT.real(imax)+1.e-5) then
|
|
||||||
real_i = real(imax)
|
|
||||||
else
|
|
||||||
returnCode_EFeld = 1
|
|
||||||
RETURN 1
|
|
||||||
endif
|
|
||||||
elseif (real_i.LT.0.) then
|
|
||||||
if (real_i.GE.-.1e-4) then
|
|
||||||
real_i = 0.
|
|
||||||
else
|
|
||||||
c write(*,*)'x = ',x
|
|
||||||
c write(*,*)'real_i = ',real_i
|
|
||||||
c write(*,*)'xmin,xmax = ',xmin,xmax
|
|
||||||
c write(*,*)'dx_ = ',dx_
|
|
||||||
returnCode_EFeld = 3
|
|
||||||
RETURN 1
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
c Bestimme naechstgelegene Stuetzstellen (stuetzstelle_q(n)) und die
|
|
||||||
c Komponenten des Abstands-Gittervektors zur allernaechsten Stuetzstelle
|
|
||||||
c (Abstand_q) sowie deren Betraege:
|
|
||||||
|
|
||||||
stuetzstelle_i(1) = nint(real_i)
|
|
||||||
Abstand_i = real_i - stuetzstelle_i(1) ! Abstand zur naeheren Stuetzstelle
|
|
||||||
Abstand_i_Betrag = abs(Abstand_i)
|
|
||||||
if (Abstand_i.gt.0.) then
|
|
||||||
stuetzstelle_i(2) = stuetzstelle_i(1) + 1
|
|
||||||
elseif (Abstand_i.lt.0.) then
|
|
||||||
stuetzstelle_i(2) = stuetzstelle_i(1) - 1
|
|
||||||
else
|
|
||||||
stuetzstelle_i(2) = stuetzstelle_i(1)
|
|
||||||
endif
|
|
||||||
|
|
||||||
stuetzstelle_j(1) = nint(real_j)
|
|
||||||
Abstand_j = real_j - stuetzstelle_j(1)
|
|
||||||
Abstand_j_Betrag = abs(Abstand_j)
|
|
||||||
if (Abstand_j.gt.0.) then
|
|
||||||
stuetzstelle_j(2) = stuetzstelle_j(1) + 1
|
|
||||||
elseif (Abstand_j.lt.0.) then
|
|
||||||
stuetzstelle_j(2) = stuetzstelle_j(1) - 1
|
|
||||||
else
|
|
||||||
stuetzstelle_j(2) = stuetzstelle_j(1)
|
|
||||||
endif
|
|
||||||
|
|
||||||
stuetzstelle_k(1) = nint(real_k)
|
|
||||||
Abstand_k = real_k - stuetzstelle_k(1)
|
|
||||||
Abstand_k_Betrag = abs(Abstand_k)
|
|
||||||
if (Abstand_k.gt.0.) then
|
|
||||||
stuetzstelle_k(2) = stuetzstelle_k(1) + 1
|
|
||||||
elseif (Abstand_k.lt.0.) then
|
|
||||||
stuetzstelle_k(2) = stuetzstelle_k(1) - 1
|
|
||||||
else
|
|
||||||
stuetzstelle_k(2) = stuetzstelle_k(1)
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
c...............................................................................
|
|
||||||
c Berechnen des elektrischen Feldes:
|
|
||||||
c ----------------------------------
|
|
||||||
c
|
|
||||||
c In dieser Version wird nicht mehr vorausgesetzt, dass das Potential auf den
|
|
||||||
c Mappenraendern Null ist!
|
|
||||||
c Bei der Berechnung der Feldstaerke ist angenommen, dass die xy-Ebene (k==0)
|
|
||||||
c und die xz-Ebene (j==0) Symmetrieebenen sind:
|
|
||||||
c
|
|
||||||
c map(i,-j,k) == map(i,j,k).
|
|
||||||
c map(i,j,-k) == map(i,j,k).
|
|
||||||
c
|
|
||||||
c Entlang j=0 ist also E(2)=0, entlang k=0 ist E(3)=0.
|
|
||||||
c
|
|
||||||
c (In der vorliegenden Version ist map(i,j,k) durch
|
|
||||||
c map( k*(jmax+1)*(imax+1) + j*(imax+1) + i) =
|
|
||||||
c map( (k*(jmax+1) + j)*(imax+1) + i)
|
|
||||||
c zu ersetzen!)
|
|
||||||
c (i,j,k laufen von 0 weg, ebenso wie die Indizierung von 'map')
|
|
||||||
c...............................................................................
|
|
||||||
|
|
||||||
c Berechne in den beiden naechstgelegenen k-Ebenen die x-Komponente der Feld-
|
|
||||||
c staerke. Danach berechne tatsaechlichen Wert aus linearer Interpolation. Um
|
|
||||||
c die Feldstaerken in den einzelnen k-Ebenen zu bekommen, interpoliere jeweils
|
|
||||||
c linear zwischen den Werten auf den beiden naechstgelegenen j-Ketten der
|
|
||||||
c jeweiligen k-Ebene:
|
|
||||||
|
|
||||||
i = stuetzstelle_i(1)
|
|
||||||
|
|
||||||
do m = 1, 2
|
|
||||||
k = stuetzstelle_k(m)
|
|
||||||
do n = 1, 2
|
|
||||||
j = stuetzstelle_j(n)
|
|
||||||
ihelp = (k*(jmax+1)+ j)*(imax+1) + i
|
|
||||||
if (i.EQ.imax) then
|
|
||||||
c E__(n) = map(imax-1,j,k) - map(imax,j,k)
|
|
||||||
E__(n) = map(ihelp-1) - map(ihelp )
|
|
||||||
elseif (i.GT.0) then
|
|
||||||
c E__(n) = (-0.5+Abstand_i)*(map(i,j,k)-map(i-1,j,k))
|
|
||||||
c + + ( 0.5+Abstand_i)*(map(i,j,k)-map(i+1,j,k))
|
|
||||||
E__(n) = (-0.5+Abstand_i)*(map(ihelp)-map(ihelp-1))
|
|
||||||
+ + ( 0.5+Abstand_i)*(map(ihelp)-map(ihelp+1))
|
|
||||||
else
|
|
||||||
c E__(n) = map(0,j,k) - map(1,j,k)
|
|
||||||
E__(n) = map(ihelp) - map(ihelp+1)
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
E_(m) = E__(1) + Abstand_j_Betrag*(E__(2)-E__(1))
|
|
||||||
enddo
|
|
||||||
E(1) = E_(1) + Abstand_k_Betrag*(E_(2)-E_(1))
|
|
||||||
|
|
||||||
E(1) = E(1) / Dx_ ! Reskalierung entsprechend x-Gitterkonstanten
|
|
||||||
|
|
||||||
|
|
||||||
c Berechne die y-Komponente der Feldstaerke:
|
|
||||||
|
|
||||||
j = stuetzstelle_j(1)
|
|
||||||
|
|
||||||
do m = 1, 2
|
|
||||||
k = stuetzstelle_k(m)
|
|
||||||
do n = 1, 2
|
|
||||||
i = stuetzstelle_i(n)
|
|
||||||
ihelp = (k*(jmax+1)+ j)*(imax+1) + i
|
|
||||||
if (j.EQ.jmax) then
|
|
||||||
c E__(n) = map(i,jmax-1,k) - map(i,jmax,k)
|
|
||||||
E__(n) = map(ihelp-(imax+1)) - map(ihelp)
|
|
||||||
elseif (j.GT.0) then
|
|
||||||
c E__(n) = (-0.5+Abstand_j)*(map(i,j,k)-map(i,j-1,k))
|
|
||||||
c + + ( 0.5+Abstand_j)*(map(i,j,k)-map(i,j+1,k))
|
|
||||||
E__(n) = (-0.5+Abstand_j)*(map(ihelp)-map(ihelp-(imax+1)))
|
|
||||||
+ + ( 0.5+Abstand_j)*(map(ihelp)-map(ihelp+(imax+1)))
|
|
||||||
else ! j=0 -> map(i,j-1,k) = map(i,j+1,k) == map(i,1,k)
|
|
||||||
c E__(n) = 2.0*Abstand_j*(map(i,0,k)-map(i,1,k))
|
|
||||||
E__(n) = 2.0*Abstand_j*(map(ihelp)-map(ihelp+(imax+1)))
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
E_(m) = E__(1) + Abstand_i_Betrag*(E__(2)-E__(1))
|
|
||||||
enddo
|
|
||||||
E(2) = E_(1) + Abstand_k_Betrag*(E_(2)-E_(1))
|
|
||||||
|
|
||||||
E(2) = E(2) / Dy_ ! Reskalierung entsprechend y-Gitterkonstanten
|
|
||||||
if (x(2).LT.0) E(2) = -E(2)
|
|
||||||
|
|
||||||
|
|
||||||
c Berechne die z-Komponente der Feldstaerke:
|
|
||||||
|
|
||||||
k = stuetzstelle_k(1)
|
|
||||||
|
|
||||||
do m = 1, 2
|
|
||||||
j = stuetzstelle_j(m)
|
|
||||||
do n = 1, 2
|
|
||||||
i = stuetzstelle_i(n)
|
|
||||||
ihelp = (k*(jmax+1)+ j)*(imax+1) + i
|
|
||||||
if (k.EQ.kmax) then
|
|
||||||
c E__(n)= map(i,j,kmax-1) - map(i,j,kmax)
|
|
||||||
E__(n) = map(ihelp-(jmax+1)*(imax+1)) - map(ihelp)
|
|
||||||
elseif (k.GT.0) then
|
|
||||||
c E__(n) = (-0.5+Abstand_k)*(map(i,j,k)-map(i,j,k-1))
|
|
||||||
c + + ( 0.5+Abstand_k)*(map(i,j,k)-map(i,j,k+1))
|
|
||||||
E__(n) = (-0.5+Abstand_k)*(map(ihelp)-map(ihelp-(jmax+1)*(imax+1)))
|
|
||||||
+ + ( 0.5+Abstand_k)*(map(ihelp)-map(ihelp+(jmax+1)*(imax+1)))
|
|
||||||
else ! k=0 -> map(i,j,k-1) = map(i,j,k+1) == map(i,j,1)
|
|
||||||
c E__(n) = 2.0*Abstand_k*(map(i,j,0)-map(i,j,1))
|
|
||||||
E__(n) = 2.0*Abstand_k*(map(ihelp)-map(ihelp+(jmax+1)*(imax+1)))
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
E_(m) = E__(1) + Abstand_i_Betrag*(E__(2)-E__(1))
|
|
||||||
enddo
|
|
||||||
E(3) = E_(1) + Abstand_j_Betrag*(E_(2)-E_(1))
|
|
||||||
|
|
||||||
E(3) = E(3) / Dz_ ! Reskalierung entsprechend z-Gitterkonstanten
|
|
||||||
if (x(3).LT.0) E(3) = -E(3)
|
|
||||||
|
|
||||||
cd write(18,*)'x,E = ',x,E
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
@ -1,32 +0,0 @@
|
|||||||
===============================================================================
|
|
||||||
Erstellt am 17-JAN-99 um 17:52:07 durch 'MAKE_CODENUMMERN-LIST.FOR'
|
|
||||||
|
|
||||||
|
|
||||||
=========================================================
|
|
||||||
Die Code-Nummern fuer die verschiedenen Gebiete: 'Gebiet'
|
|
||||||
=========================================================
|
|
||||||
|
|
||||||
( 0: auf Moderatorfolie)
|
|
||||||
1: in 1. Beschl.Stufe
|
|
||||||
2: in 2. Beschl.Stufe
|
|
||||||
3: bis He-Schild
|
|
||||||
4: bis LN-Schild
|
|
||||||
|
|
||||||
|
|
||||||
==========================================================
|
|
||||||
Die Code-Nummern der moeglichen Teilchenschicksale: 'dest'
|
|
||||||
==========================================================
|
|
||||||
|
|
||||||
-5: Testort vor Potentialmappe
|
|
||||||
-4: Potentialmappe verlassen
|
|
||||||
-3: auf Gitter 2 aufgeschlagen
|
|
||||||
-2: auf Gitter 1 aufgeschlagen
|
|
||||||
-1: Targethalter getroffen
|
|
||||||
0: bis jetzt alles ok
|
|
||||||
1: zerfallen
|
|
||||||
2: reflektiert
|
|
||||||
3: aufgeschlagen
|
|
||||||
4: verloren (steps>maxsteps)
|
|
||||||
5: zu oft dt < dtSmall
|
|
||||||
|
|
||||||
===============================================================================
|
|
||||||
@ -1,521 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c COM_ACCEL.INC
|
|
||||||
c===============================================================================
|
|
||||||
c
|
|
||||||
c===============================================================================
|
|
||||||
c I. Konstanten
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c Die Versionsnummer
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
character*(*) version
|
|
||||||
|
|
||||||
parameter ( version = '2.0.0' )
|
|
||||||
|
|
||||||
|
|
||||||
c 1.2.1: Variablen 'dy_TgtHolder','dz_TgtHolder' durch 'outerDy_TgtHolder' und
|
|
||||||
c 'outerDz_TgtHolder' ersetzt. Variablen 'innerDij_TgtHolder' (i=y,z;
|
|
||||||
c j=1,2) neu eingefuehrt (fuer Targetgeometrie bei Run10).
|
|
||||||
c Die neuen Schleifenparmeter B_TD und B_Helm fuer die Magnetfelder von
|
|
||||||
c TD-Spule und Progen-Helmholtzspule neu eingefuehrt, jedoch noch keine
|
|
||||||
c Berechnungen implementiert.
|
|
||||||
c 1.2.2: 26-jan-1998: AH: implementation of 'adjustSigmaE0'
|
|
||||||
c 1.2.3: 02-feb-1998: AH: implementation of 'E0InterFromFile'
|
|
||||||
c 2.0.0: 22-jan-1998: AH: as Verwion 1.2.3. Renamed to 2.0.0 to flag that
|
|
||||||
c this is the last version maintained by A.H.
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c Die Ausgabekanaele
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
integer lunREAD, lunScreen, lunLOG, lunNTP, lunPHYSICA, lunTMP
|
|
||||||
integer lunMESSAGE
|
|
||||||
integer lunINFO,lunStart,lunDecay,lunZwi1,lunZwi2
|
|
||||||
|
|
||||||
|
|
||||||
parameter ( lunScreen = 6 )
|
|
||||||
parameter ( lunTMP = 16 )
|
|
||||||
parameter ( lunREAD = 17 )
|
|
||||||
parameter ( lunLOG = 18 )
|
|
||||||
parameter ( lunNTP = 19 )
|
|
||||||
parameter ( lunPHYSICA = 20 )
|
|
||||||
parameter ( lunMESSAGE = 14 )
|
|
||||||
|
|
||||||
parameter ( lunINFO = 40 )
|
|
||||||
parameter ( lunStart = 41 )
|
|
||||||
parameter ( lunDecay = 42 )
|
|
||||||
parameter ( lunZwi1 = 43 )
|
|
||||||
parameter ( lunZwi2 = 44 )
|
|
||||||
|
|
||||||
|
|
||||||
c Die Tabellenfiles werden entsprechend ihrer Nummer den Ausgabeeinheiten
|
|
||||||
c (lunPHYSICA + 1) bis (lunPHYSICA + stat_Anzahl) zugeordnet.
|
|
||||||
|
|
||||||
|
|
||||||
c die id des Ausgabe-NTupels:
|
|
||||||
|
|
||||||
integer idNTP
|
|
||||||
parameter (idNTP = 5)
|
|
||||||
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c Zuteilung der GebietsNummern k (0 <= k <= Gebiete_Anzahl)
|
|
||||||
c zu den Gebieten
|
|
||||||
c
|
|
||||||
c (Zuteilung muss mit Definition bei 'MUTRACK' uebereinstimmen (ansonsten waere
|
|
||||||
c in MUTRACK eine Uebersetzung notwendig)
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
integer target,upToGrid1,upToGrid2,upToHeShield,upToLNShield
|
|
||||||
|
|
||||||
c GEBIET 'k'
|
|
||||||
parameter ( target = 0 ) ! <- zaehlt nicht fuer 'Gebiete_Anzahl'!
|
|
||||||
parameter ( upToGrid1 = 1 )
|
|
||||||
parameter ( upToGrid2 = 2 )
|
|
||||||
parameter ( upToHeShield= 3 )
|
|
||||||
parameter ( upToLNShield= 4 )
|
|
||||||
|
|
||||||
integer Gebiete_Anzahl
|
|
||||||
parameter ( Gebiete_Anzahl=4 ) ! <- Startpkt 'Target' zaehlt nicht !!
|
|
||||||
|
|
||||||
character Gebiet_Text(Gebiete_Anzahl)*40
|
|
||||||
COMMON Gebiet_Text
|
|
||||||
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c Zuteilungen der Schleifenparameter zu den Feldelemenkten k
|
|
||||||
c (1 <= k <= par_Anzahl) von par(i,k), n_par(k), parWert(k), par_text(k)
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
integer UTarget,UGuard, UGi1, BTD,BHelm, mass,charge,
|
|
||||||
+ ener,yPos,zPos,thetAng,phiAng
|
|
||||||
|
|
||||||
c PARAMETER 'k'
|
|
||||||
|
|
||||||
parameter ( UTarget = 1 )
|
|
||||||
parameter ( UGuard = 2 )
|
|
||||||
parameter ( UGi1 = 3 )
|
|
||||||
|
|
||||||
parameter ( BTD = 4 )
|
|
||||||
parameter ( BHelm = 5 )
|
|
||||||
|
|
||||||
parameter ( mass = 6 )
|
|
||||||
parameter ( charge = 7 )
|
|
||||||
|
|
||||||
parameter ( ener = 8 )
|
|
||||||
parameter ( yPos = 9 )
|
|
||||||
parameter ( zPos = 10 )
|
|
||||||
parameter ( thetAng = 11 )
|
|
||||||
parameter ( phiAng = 12 )
|
|
||||||
|
|
||||||
integer par_Anzahl
|
|
||||||
parameter ( par_Anzahl=12) ! <- 'Zufalls-Schleife' zu k=0 zaehlt nicht!
|
|
||||||
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c Code-Nummern fuer das Schicksal des Teilchens
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
integer code_vor_Mappe,code_neben_Mappe
|
|
||||||
integer code_hit_grid2,code_hit_grid1,code_hit_TgtHolder
|
|
||||||
integer code_ok
|
|
||||||
integer smallest_code_Nr
|
|
||||||
|
|
||||||
integer code_decay,code_reflektiert,
|
|
||||||
+ code_wand,code_lost,code_dtsmall
|
|
||||||
|
|
||||||
c SCHICKSAL 'code'
|
|
||||||
|
|
||||||
parameter ( smallest_code_Nr = -5 )
|
|
||||||
|
|
||||||
parameter ( code_vor_Mappe = -5 )
|
|
||||||
parameter ( code_neben_Mappe = -4 )
|
|
||||||
parameter ( code_hit_grid2 = -3 )
|
|
||||||
parameter ( code_hit_grid1 = -2 )
|
|
||||||
parameter ( code_hit_TgtHolder = -1 )
|
|
||||||
parameter ( code_ok = 0 )
|
|
||||||
|
|
||||||
parameter ( code_decay = 1 )
|
|
||||||
parameter ( code_reflektiert = 2 )
|
|
||||||
parameter ( code_wand = 3 )
|
|
||||||
parameter ( code_lost = 4 )
|
|
||||||
parameter ( code_dtsmall = 5 )
|
|
||||||
|
|
||||||
integer highest_code_Nr
|
|
||||||
parameter ( highest_code_Nr = 5 )
|
|
||||||
|
|
||||||
character code_Text(smallest_code_Nr:highest_code_Nr)*27
|
|
||||||
COMMON code_text
|
|
||||||
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c Zuteilung der Statistiken zu den Feldelementen k ( 1<= k <= stat_Anzahl)
|
|
||||||
c von statInMemory(k),createTabelle(k),statNeeded(k),statMem(i,k)
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
integer Nr_S1M2
|
|
||||||
|
|
||||||
c STATISTIK 'k'
|
|
||||||
parameter ( Nr_S1M2 = 1 )
|
|
||||||
|
|
||||||
integer Stat_Anzahl
|
|
||||||
parameter (Stat_Anzahl = 1)
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
c II. Variablen in Commonbloecken
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c die Gebietsnummer
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
integer Gebiet0 ! GebietsNummer beim Start
|
|
||||||
integer Gebiet ! aktuelle GebietsNummer
|
|
||||||
|
|
||||||
integer StartFlaeche
|
|
||||||
|
|
||||||
COMMON Gebiet0, StartFlaeche
|
|
||||||
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c zufallsverteilte Startparameter
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
c Energie:
|
|
||||||
|
|
||||||
logical random_E0 ! Zufallsverteilung fuer Startenergie?
|
|
||||||
integer random_energy ! welche Verteilung fuer Startenergie?
|
|
||||||
logical random_E0_equal ! gleichverteilte Startenergie
|
|
||||||
real lowerE0,upperE0 ! Grenzen fuer Zufallsverteilung
|
|
||||||
logical random_E0_gauss ! gaussverteilte Startenergie
|
|
||||||
real sigmaE0 ! Breite der Gaussverteilung
|
|
||||||
logical adjustSigmaE0 /.false./
|
|
||||||
|
|
||||||
logical e0InterFromFile /.FALSE./
|
|
||||||
real E0Low(101)
|
|
||||||
integer nE0Inter
|
|
||||||
|
|
||||||
c Position:
|
|
||||||
|
|
||||||
logical random_pos ! Zufallsverteilung fuer Startposition?
|
|
||||||
integer random_position ! welche Verteilung fuer Startposition?
|
|
||||||
logical random_y0z0_equal ! gleichverteilt auf Viereckflaeche
|
|
||||||
logical random_r0_equal ! gleichverteilt auf Kreisflaeche
|
|
||||||
logical random_y0z0_Gauss ! Gauss-verteilt auf Viereckflaeche
|
|
||||||
logical random_r0_Gauss ! Gauss-verteilt auf Kreisflaeche
|
|
||||||
real StartBreite,StartHoehe,StartRadius, sigmaPosition
|
|
||||||
|
|
||||||
c Winkel:
|
|
||||||
|
|
||||||
logical random_angle ! Zufallsverteilung fuer Startwinkel?
|
|
||||||
integer random_winkel ! welche Verteilung fuer Startwinkel?
|
|
||||||
logical random_lambert ! Lambert-Verteilung
|
|
||||||
logical random_gauss ! Gauss-Verteilung
|
|
||||||
real StartLambertOrd
|
|
||||||
real SigmaWinkel ! Breite der Gaussverteilung
|
|
||||||
|
|
||||||
logical ener_offset,pos_offset,angle_offset ! Falls Zufallsverteilung
|
|
||||||
! mit durch Startparameter vorgegebenen
|
|
||||||
! Offsets
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
COMMON random_E0,random_energy,random_E0_equal,lowerE0,upperE0
|
|
||||||
COMMON random_E0_gauss,sigmaE0,adjustSigmaE0
|
|
||||||
COMMON random_pos,random_position,random_y0z0_equal,
|
|
||||||
+ random_r0_equal,random_y0z0_Gauss,random_r0_Gauss,
|
|
||||||
+ StartBreite,StartHoehe,StartRadius,sigmaPosition
|
|
||||||
COMMON e0InterFromFile,nE0Inter,E0Low
|
|
||||||
|
|
||||||
COMMON random_angle,random_winkel,random_lambert,random_gauss
|
|
||||||
COMMON StartLambertOrd,sigmaWinkel
|
|
||||||
|
|
||||||
COMMON ener_offset,pos_offset,angle_offset
|
|
||||||
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c Schleifen-Parameter
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c (par(n,0) wird fuer die 'Zufallsschleife' verwendet)
|
|
||||||
|
|
||||||
real par(3,0:par_Anzahl) ! min, max und step der ParameterSchleifen
|
|
||||||
integer n_par(0:par_Anzahl) ! die Anzahl unterschiedl. Werte je Schleife
|
|
||||||
real parWert(par_Anzahl) ! der aktuelle Wert der Schleifenvariablen
|
|
||||||
character par_text(par_Anzahl)*22 ! Beschreibung jeder Variablen fuer Ausgabezwecke
|
|
||||||
|
|
||||||
integer reihenFolge(par_Anzahl) ! Enthaelt die Reihenfolge der
|
|
||||||
! Abarbeitung der Schleifenparameter
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
COMMON par, parWert, n_par, par_text, reihenfolge
|
|
||||||
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c die Teilchenarten (artList)
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
integer Arten_Zahl ! Anzahl der bekannten Arten
|
|
||||||
parameter (Arten_Zahl = 36)
|
|
||||||
|
|
||||||
character*4 art_Name(Arten_Zahl) ! Bezeichnungen der bekannten Arten
|
|
||||||
real art_Masse(Arten_Zahl) ! Massen der bekannten Arten
|
|
||||||
real art_Ladung(Arten_Zahl) ! Ladungen der bekannten Arten
|
|
||||||
|
|
||||||
character artList*50 ! Liste zu startender Teilchen
|
|
||||||
logical artList_defined ! wurde 'artList' gesetzt?
|
|
||||||
logical mu_flag ! signalisiert, ob Myon-Teilchen erkannt wurde
|
|
||||||
|
|
||||||
integer artenMax ! Maximalzahl in 'artList'
|
|
||||||
parameter (artenMax = 9) ! akzeptierter Arten
|
|
||||||
integer art_Nr(artenMax) ! die in artList enthaltenen Arten
|
|
||||||
integer artNr ! die Nummer der aktuellen Art
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
COMMON art_Name,art_Masse,art_Ladung
|
|
||||||
COMMON artList,artList_defined,mu_flag
|
|
||||||
COMMON art_Nr,artNr
|
|
||||||
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c Programmsteuerung
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
real scaleFactor ! Skalierungsfaktor fuer die Beschleuniger-
|
|
||||||
! geometrie
|
|
||||||
|
|
||||||
logical UseDecay ! MYONEN-Zerfall beruecksichtigen?
|
|
||||||
logical UseDecay_ ! MYONEN-Zerfall beruecksichtigen und Art ist myon?
|
|
||||||
|
|
||||||
logical DEBUG ! DEBUG-Ausgabe?
|
|
||||||
integer DEBUG_Anzahl ! fuer wieviele Starts je Schleife sollen
|
|
||||||
! (so ueberhaupt) DEBUG-Informationen ausgegeben
|
|
||||||
! werden? (in COMMON /output/)
|
|
||||||
logical DEBUG_ ! DEBUG .AND. startNr.LE.DEBUG_Anzahl
|
|
||||||
|
|
||||||
logical notLastLoop ! aktuelle Schleife ist nicht letzte Schleife
|
|
||||||
|
|
||||||
logical BATCH_MODE ! -> keine Graphikausgabe auf Schirm; keine
|
|
||||||
! Ausgabe der Prozentzahl schon gerechneter
|
|
||||||
! Trajektorien
|
|
||||||
logical INPUT_LIST ! spezielle Version eines Batch-Runs
|
|
||||||
integer ListLength !
|
|
||||||
logical gotFileNr !
|
|
||||||
character inputListName*20
|
|
||||||
logical HVs_from_map ! sollen die Mappen-intrinsischen HVs verwendet werden?
|
|
||||||
! (bei Mappen, die fuer feste HVs gerechnet wurden)
|
|
||||||
logical TestRun ! 'true' -> RunNummern zwischen 9900 und 9999
|
|
||||||
logical log_confine ! Begrenze Schrittweite in Integrationsgebieten
|
|
||||||
! -> 'dl_max_...'
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
COMMON /scaleFactor/ scaleFactor
|
|
||||||
COMMON UseDecay,UseDecay_
|
|
||||||
COMMON DEBUG,DEBUG_
|
|
||||||
COMMON notLastLoop
|
|
||||||
COMMON BATCH_MODE,INPUT_LIST,ListLength,gotFileNr,inputListName
|
|
||||||
COMMON HVs_from_map,TestRun,log_confine
|
|
||||||
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c Graphikausgabe
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
logical graphics ! graphische Ausgabe?
|
|
||||||
integer graphics_Anzahl ! fuer wieviele Starts je Schleife?
|
|
||||||
logical graphics_ ! GRAPHICS .AND. startNr.LE.GRAPHICS_Anzahl
|
|
||||||
|
|
||||||
integer n_postSkript ! PostSkript-files erstellen?
|
|
||||||
|
|
||||||
integer iMonitor ! Abtastfrequenz fuer Graphik und Debug (jeder
|
|
||||||
! wievielte Schritt wird ausgegeben)
|
|
||||||
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
COMMON graphics,graphics_Anzahl,graphics_
|
|
||||||
COMMON n_postSkript, iMonitor
|
|
||||||
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c FileName
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
character filename*20 ! Name der Ausgabe-Dateien
|
|
||||||
character mappenName*25 ! Namenskern der Potentialmappen
|
|
||||||
integer nameLength ! reale Laenge von 'mappenName'
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
COMMON filename
|
|
||||||
COMMON /mappenName/ mappenName, NameLength
|
|
||||||
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c Vorgaben fuer das Summary (.LOG-file)
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
integer n_outWhere ! LogFile auf welche Ausgabekanaele geben?
|
|
||||||
|
|
||||||
logical LogFile ! Logfile erstellen?
|
|
||||||
logical smallLogFile ! minimalversion des Logfiles erstellen?
|
|
||||||
|
|
||||||
logical statsInSummary ! Statistiken in das Summary?
|
|
||||||
logical statInSummary(Stat_Anzahl) ! welche Statistiken in das Summary?
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
COMMON n_outWhere
|
|
||||||
COMMON LogFile,smallLogFile
|
|
||||||
COMMON statsInSummary,statInSummary
|
|
||||||
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c WELCHE FILES sollen erzeugt werden?
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
logical createPhysTab ! PAW-Gesamt-Tabelle (.PAW) erzeugen?
|
|
||||||
logical NTP_Misc ! SchleifenNr,StartNr,Mappe,Steps ins NTupel?
|
|
||||||
logical NTP_start ! Die Startgroessen ...?
|
|
||||||
logical NTP_stop ! Die Stopgroessen ...?
|
|
||||||
logical NTP_40mm ! Die auf x = 40 mm extrapolierte Ort ...?
|
|
||||||
|
|
||||||
logical createTabellen ! Tabellen-files erzeugen?
|
|
||||||
logical createTabelle(Stat_Anzahl) ! welche Tabellen-files erzeugen?
|
|
||||||
|
|
||||||
character statName(stat_Anzahl)*9 ! Tabellenfile-Ueberschriften
|
|
||||||
character TabExt(stat_Anzahl)*9 ! Extensions der Tabellenfiles
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
COMMON createPhysTab
|
|
||||||
COMMON NTP_Misc,NTP_start,NTP_stop,NTP_40mm
|
|
||||||
COMMON createTabellen,createTabelle,statName,TabExt
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c Fehlerkontrolle
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
real eps_x ! Fehlertoleranz bei Ortsberechnung
|
|
||||||
real eps_v ! Fehlertoleranz bei Geschw.Berechnung
|
|
||||||
logical log_relativ ! relative Fehlerbetrachtung?
|
|
||||||
|
|
||||||
integer maxStep ! maximale Anzahl an Integrationsschritten
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
COMMON eps_x,eps_v,log_relativ
|
|
||||||
COMMON maxStep
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c haeufig benutzte Faktoren
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
real Energie_Faktor ! Faktor bei Berechn. der Energie aus der Geschw.
|
|
||||||
real Beschl_Faktor ! Faktor bei Berechn. der Beschleunigung im EFeld
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
COMMON Energie_Faktor
|
|
||||||
COMMON /Beschl_Faktor/ Beschl_Faktor
|
|
||||||
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c Programmablauf
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
real x0(3),v0(3),E0 ! Startort, -geschwindigkeit und -energie
|
|
||||||
real lifetime ! individuelle Myon-Lebensdauer [ns]
|
|
||||||
real theta0 ! 3D-Startwinkel gegen x_Achse
|
|
||||||
real phi0 ! azimuthaler Startwinkel (y-Achse:0, z-Achse:90)
|
|
||||||
|
|
||||||
real x(3),t,v(3) ! Ort, Zeit, Geschwindigkeit
|
|
||||||
integer destiny ! die Codezahl fuer das Schicksal des Teilchens
|
|
||||||
integer lastMap ! die Nummer der letzten Potentialmappe fuer
|
|
||||||
! individuelle Teilchen
|
|
||||||
|
|
||||||
integer start_nr ! Startnummer des Teilchen (je Schleife)
|
|
||||||
integer GesamtZahl ! Gesamtzahl der Teilchen (ueber alle Schleifen)
|
|
||||||
integer SchleifenZahl ! Anzahl durchzufuehrender Schleifen
|
|
||||||
integer SchleifenNr ! Nummer der aktuellen Schleife
|
|
||||||
integer Steps ! Nummer des Integrationssteps (je Teilchen)
|
|
||||||
|
|
||||||
integer seed ! fuer Zufallsgenerator
|
|
||||||
|
|
||||||
real dtsmall ! kleinster Zeitschritt fuer Integrationen
|
|
||||||
integer maxBelowDtSmall ! max. tolerierte Anzahl an Unterschreitungen von
|
|
||||||
! dtsmall
|
|
||||||
integer n_dtSmall ! wie oft hat einzelnes Teilchen dtSmall unterschritten
|
|
||||||
integer n_dtsmall_Max ! groesste aufgetretene Anzahl an Unterschreitungen
|
|
||||||
! (ueber alle Schleifen)
|
|
||||||
integer dtsmall_counter ! wieviele Teilchen haben dtsmall unterschritten
|
|
||||||
integer Lost_counter ! wieviele Teilchen wurden wegen steps>maxSteps
|
|
||||||
! verlorengegebe
|
|
||||||
logical OneLoop ! genau eine Schleife
|
|
||||||
logical OneStartPerLoop ! Zufallsschleife macht genau einen Durchlauf
|
|
||||||
|
|
||||||
logical reachedEndOfMap, backOneMap
|
|
||||||
logical log_percent
|
|
||||||
|
|
||||||
logical freeGuard ! Spannung am Guardring separat?
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
c Die benannten Common-Bloecke sind teilweise fuer die NTupelausgabe noetig!
|
|
||||||
|
|
||||||
c COMMON /STARTPARAMETER/ x0,v0,E0,theta0,phi0
|
|
||||||
COMMON /x0/ x0
|
|
||||||
COMMON /v0/ v0
|
|
||||||
COMMON /E0/ E0
|
|
||||||
COMMON /angle0/ theta0,phi0
|
|
||||||
COMMON /lifeTime/ lifetime
|
|
||||||
COMMON /TRAJEKTORIE/ t,x,v
|
|
||||||
COMMON /basics/ SchleifenNr,start_Nr,lastMap,steps
|
|
||||||
COMMON /gebiet/ gebiet,destiny
|
|
||||||
COMMON GesamtZahl,SchleifenZahl
|
|
||||||
COMMON dtsmall, maxBelowDtSmall, n_dtsmall, n_dtsmall_Max, dtsmall_counter
|
|
||||||
COMMON Lost_counter
|
|
||||||
COMMON OneLoop, OneStartPerLoop
|
|
||||||
COMMON /seed/ seed ! COMMON /seed/ ist auch in manchen Subroutinen
|
|
||||||
! explizit gesetzt! -> wird benoetigt!
|
|
||||||
COMMON reachedEndOfMap,backOneMap
|
|
||||||
COMMON log_percent
|
|
||||||
COMMON freeGuard
|
|
||||||
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c Statistik
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
real Koord_NTP(8,0:Gebiete_Anzahl) ! Koordinatenspeicher fuer NTP-Ausgabe
|
|
||||||
|
|
||||||
integer statDestiny(smallest_code_Nr:Gebiete_Anzahl*highest_code_Nr)
|
|
||||||
! Statistik der Teilchenschicksale
|
|
||||||
|
|
||||||
real statMem(9,stat_Anzahl) ! Statistiken von Flugzeiten ext.
|
|
||||||
logical statNeeded(stat_Anzahl) ! welche Statistiken muessen fuer die
|
|
||||||
! geforderten Informationen gefuehrt werden?
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
COMMON /KOORD_NTP/ Koord_NTP
|
|
||||||
|
|
||||||
COMMON statDestiny
|
|
||||||
COMMON statMem,statNeeded
|
|
||||||
|
|
||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c Datenausgabe
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
integer lun(2), indx
|
|
||||||
integer indx1, indx2
|
|
||||||
|
|
||||||
COMMON /OUTPUT/ lun, indx1,indx2,indx, DEBUG_Anzahl
|
|
||||||
|
|
||||||
@ -1,9 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c COM_Bs.INC
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c the magnetic fields:
|
|
||||||
real B_TD, B_Helm
|
|
||||||
COMMON /BFields/ B_TD, B_Helm
|
|
||||||
|
|
||||||
@ -1,15 +0,0 @@
|
|||||||
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
c COM_DIRS.INC
|
|
||||||
c-------------------------------------------------------------------------------
|
|
||||||
|
|
||||||
c Die verwendeten Directories:
|
|
||||||
|
|
||||||
character*40 MappenDir,readDir,outDir,NrDir,TMPDir
|
|
||||||
|
|
||||||
parameter (MappenDir='accel$MAPPENDirectory' )
|
|
||||||
parameter (readDir ='accel$READdirectory' )
|
|
||||||
parameter (outDir ='accel$OUTdirectory' )
|
|
||||||
parameter (NrDir ='accel$NrDirectory' )
|
|
||||||
parameter (TMPDir ='SYS$SCRATCH' )
|
|
||||||
|
|
||||||
@ -1,86 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c COM_GEO.INC
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c the geometry:
|
|
||||||
|
|
||||||
c all Dy_... and Dz_... values are half of the total extension.
|
|
||||||
c When read in, all x-positions are relative to the moderator foil but they
|
|
||||||
c are immediately converted to be relative to the center of the cryostat.
|
|
||||||
|
|
||||||
c - moderator:
|
|
||||||
real xFoil
|
|
||||||
real Dy_Foil, Dz_Foil
|
|
||||||
real xEnd_TgtHolder
|
|
||||||
real outerDy_TgtHolder /-1.E10/, outerDz_TgtHolder /-1.E10/
|
|
||||||
real innerDy1_TgtHolder /-1.E10/, innerDy2_TgtHolder /-1.E10/
|
|
||||||
real innerDz1_TgtHolder /-1.E10/, innerDz2_TgtHolder /-1.E10/
|
|
||||||
|
|
||||||
c - guardring:
|
|
||||||
real xStart_Guardring, xEnd_Guardring
|
|
||||||
real innerDy_Guardring, outerDy_Guardring
|
|
||||||
real innerDz_Guardring, outerDz_Guardring
|
|
||||||
|
|
||||||
c - first grid:
|
|
||||||
real xPosition_Grid1, distance_wires1, y_Pos_firstWire1 /0./,y_Pos_lastWire1
|
|
||||||
real dWires1, rWires1, rQuadWires1
|
|
||||||
real xStart_Gridframe1, xEnd_Gridframe1
|
|
||||||
real innerDy_Gridframe1, outerDy_Gridframe1
|
|
||||||
real innerDz_Gridframe1, outerDz_Gridframe1
|
|
||||||
|
|
||||||
real xStart_Balken, xEnd_Balken
|
|
||||||
real Dy_Balken
|
|
||||||
real innerDz_Balken, outerDz_Balken
|
|
||||||
|
|
||||||
c - second grid:
|
|
||||||
real xPosition_Grid2, distance_wires2, y_Pos_firstWire2 /0./,y_Pos_lastWire2
|
|
||||||
real dWires2, rWires2, rQuadWires2
|
|
||||||
real xStart_Gridframe2, xEnd_Gridframe2
|
|
||||||
real innerDy_Gridframe2, outerDy_Gridframe2
|
|
||||||
real innerDz_Gridframe2, outerDz_Gridframe2
|
|
||||||
|
|
||||||
c - He-shield:
|
|
||||||
real xHeShield ! xHeShield = - xFoil (-> relative Positionen)
|
|
||||||
real rHeShield ! Radius
|
|
||||||
real dy_HeWindow
|
|
||||||
real dz_HeWindow
|
|
||||||
|
|
||||||
|
|
||||||
c x coordinates of beginnings and ends of the individual maps:
|
|
||||||
|
|
||||||
real xStartMap1,xStartMap2,xStartMap3,xStartMap4,xStartMap5,xStartMap6
|
|
||||||
real xEndMap1, xEndMap2, xEndMap3, xEndMap4, xEndMap5, xEndMap6
|
|
||||||
|
|
||||||
|
|
||||||
c the common blocks:
|
|
||||||
c (the common blocks /map_%/ are actually bigger. But only the first two
|
|
||||||
c variables are necessary here)
|
|
||||||
|
|
||||||
COMMON /map_1/ xStartMap1,xEndMap1
|
|
||||||
COMMON /map_2/ xStartMap2,xEndMap2
|
|
||||||
COMMON /map_3/ xStartMap3,xEndMap3
|
|
||||||
COMMON /map_4/ xStartMap4,xEndMap4
|
|
||||||
COMMON /map_5/ xStartMap5,xEndMap5
|
|
||||||
COMMON /map_6/ xStartMap6,xEndMap6
|
|
||||||
|
|
||||||
COMMON /xFoil/ xFoil
|
|
||||||
|
|
||||||
COMMON /MAP_AND_TGT/
|
|
||||||
+ Dy_Foil,Dz_Foil,
|
|
||||||
+ xEnd_TgtHolder,outerDy_TgtHolder,outerDz_TgtHolder,
|
|
||||||
+ innerDy1_TgtHolder,innerDy2_TgtHolder,innerDz1_TgtHolder,innerDz2_TgtHolder,
|
|
||||||
+ xStart_Guardring,xEnd_Guardring,innerDy_Guardring,outerDy_Guardring,
|
|
||||||
+ innerDz_Guardring,outerDz_Guardring,
|
|
||||||
+ xPosition_Grid1,distance_wires1,dWires1,rQuadWires1,rWires1,
|
|
||||||
+ y_Pos_firstWire1,y_Pos_lastWire1,
|
|
||||||
+ xStart_Balken,xEnd_Balken,Dy_Balken,
|
|
||||||
+ innerDz_Balken,outerDz_Balken,
|
|
||||||
+ xStart_Gridframe1,xEnd_Gridframe1,innerDy_Gridframe1,outerDy_Gridframe1,
|
|
||||||
+ innerDz_Gridframe1,outerDz_Gridframe1,
|
|
||||||
+ xPosition_Grid2,distance_wires2,dWires2,rQuadWires2,rWires2,
|
|
||||||
+ y_Pos_firstWire2,y_Pos_lastWire2,
|
|
||||||
+ xStart_Gridframe2,xEnd_Gridframe2,innerDy_Gridframe2,outerDy_Gridframe2,
|
|
||||||
+ innerDz_Gridframe2,outerDz_Gridframe2,
|
|
||||||
+ xHeShield,rHeShield,dy_HeWindow,dz_HeWindow
|
|
||||||
|
|
||||||
@ -1,10 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c COM_HVs.INC
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c the voltages:
|
|
||||||
real zero, UTgt, UGua, UGrid1, UG1, UG2
|
|
||||||
COMMON /voltages/ zero, UTgt, UGua, UGrid1, UG1, UG2
|
|
||||||
|
|
||||||
|
|
||||||
@ -1,276 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c INITIALIZE.INC
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
c die Spezifizierungen der Schleifen-Parameter (character*22):
|
|
||||||
|
|
||||||
par_text(UTarget) = 'U(Target) [kV] : '
|
|
||||||
par_text(UGuard ) = 'U(Guard) [kV] : '
|
|
||||||
par_text(UGi1 ) = 'U(Gitter1)[kV] : '
|
|
||||||
par_text(BTD ) = 'B(TD) [Gauss] : '
|
|
||||||
par_text(BHelm ) = 'B(Helmh.) [Gauss] : '
|
|
||||||
par_text(mass ) = 'Masse [keV/c**2]: '
|
|
||||||
par_text(charge ) = 'Ladung [e] : '
|
|
||||||
par_text(ener ) = 'Energie [keV] : '
|
|
||||||
par_text(yPos ) = 'y0 [mm] : '
|
|
||||||
par_text(zPos ) = 'z0 [mm] : '
|
|
||||||
par_text(thetAng) = 'theta0 [degree] : '
|
|
||||||
par_text(phiAng ) = 'phi0 [degree] : '
|
|
||||||
|
|
||||||
|
|
||||||
c die Gebiets-Bezeichnungen (character*40):
|
|
||||||
|
|
||||||
Gebiet_Text(upToGrid1) = 'in 1. Beschl.Stufe:'
|
|
||||||
Gebiet_Text(upToGrid2) = 'in 2. Beschl.Stufe:'
|
|
||||||
Gebiet_Text(upToHeShield) = 'bis He-Schild:'
|
|
||||||
Gebiet_Text(upToLNShield) = 'bis LN-Schild:'
|
|
||||||
|
|
||||||
|
|
||||||
c die Bezeichnungen fuer die moeglichen Teilchenschicksale (character*26):
|
|
||||||
|
|
||||||
code_text(code_vor_Mappe ) = 'Testort vor Potentialmappe: '
|
|
||||||
code_text(code_neben_Mappe ) = 'Potentialmappe verlassen: '
|
|
||||||
code_text(code_hit_grid2 ) = 'auf Gitter 2 aufgeschlagen: '
|
|
||||||
code_text(code_hit_grid1 ) = 'auf Gitter 1 aufgeschlagen: '
|
|
||||||
code_text(code_hit_TgtHolder ) = 'Targethalter getroffen: '
|
|
||||||
|
|
||||||
code_text(code_OK ) = 'bis jetzt alles ok: '
|
|
||||||
|
|
||||||
code_text(code_decay ) = 'zerfallen: '
|
|
||||||
code_text(code_reflektiert ) = 'reflektiert: '
|
|
||||||
code_text(code_wand ) = 'aufgeschlagen: '
|
|
||||||
code_text(code_lost ) = 'verloren (steps>maxsteps): '
|
|
||||||
code_text(code_dtsmall ) = 'zu oft dt < dtSmall: '
|
|
||||||
|
|
||||||
|
|
||||||
c die Ueberschriften der Tabellen-files (character*9):
|
|
||||||
|
|
||||||
statName(Nr_S1M2) = 'S1M2 '
|
|
||||||
|
|
||||||
|
|
||||||
c die Extensions der Tabellen-files (character*9):
|
|
||||||
|
|
||||||
TabExt(Nr_S1M2) = '._S1M2 '
|
|
||||||
|
|
||||||
|
|
||||||
c die Reihenfolge, in welcher die Schleifen der 'Schleifenparameter' par(i,k)
|
|
||||||
c im Hauptprogramm abgearbeitet werden:
|
|
||||||
|
|
||||||
DATA reihenfolge /
|
|
||||||
+ UTarget,UGuard,UGi1, BHelm,BTD, mass,charge,
|
|
||||||
+ ener,thetAng,phiAng,yPos,zPos /
|
|
||||||
|
|
||||||
|
|
||||||
c====== Initialisierungen fuer die benutzerdefinierbaren Parameter ============
|
|
||||||
|
|
||||||
c Das Startgebiet 'Gebiet0' wird indirekt im SUB 'READ_INPUTFILE' via eine der
|
|
||||||
c lokalen Variablen 'Startflaeche' oder 'x0_' initialisiert.
|
|
||||||
|
|
||||||
c - - - - - - - - - - zufallsverteilte Startparameter - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
c Energie:
|
|
||||||
|
|
||||||
DATA random_E0 /.false./
|
|
||||||
DATA random_energy / 0 /
|
|
||||||
|
|
||||||
DATA random_E0_equal /.false./
|
|
||||||
DATA lowerE0 / 0.000 /
|
|
||||||
DATA upperE0 / 0.010 /
|
|
||||||
|
|
||||||
DATA random_E0_gauss /.false./
|
|
||||||
DATA sigmaE0 / 0.010 /
|
|
||||||
|
|
||||||
|
|
||||||
c Position:
|
|
||||||
|
|
||||||
DATA random_pos /.false./
|
|
||||||
DATA random_position / 0 /
|
|
||||||
DATA sigmaPosition / 15. /
|
|
||||||
|
|
||||||
DATA random_y0z0_equal /.false./
|
|
||||||
DATA random_r0_equal /.false./
|
|
||||||
DATA random_y0z0_Gauss /.false./
|
|
||||||
DATA random_r0_Gauss /.false./
|
|
||||||
DATA StartBreite / -1. /
|
|
||||||
DATA StartHoehe / -1. /
|
|
||||||
DATA StartRadius / -1. /
|
|
||||||
|
|
||||||
|
|
||||||
c Winkel:
|
|
||||||
|
|
||||||
DATA random_angle /.false./
|
|
||||||
DATA random_winkel / 0 /
|
|
||||||
|
|
||||||
DATA random_lambert /.false./
|
|
||||||
DATA random_gauss /.false./
|
|
||||||
DATA StartLambertOrd / 1. /
|
|
||||||
DATA sigmaWinkel / 1. /
|
|
||||||
|
|
||||||
DATA ener_offset / .true. /
|
|
||||||
DATA pos_offset / .true. /
|
|
||||||
DATA angle_offset / .true. /
|
|
||||||
|
|
||||||
c - - - - - - - - - - Schleifen-Parameter - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
! Das Schleifenparameterfeld 'par(i,k)' (1 <= k <= par_Anzahl)
|
|
||||||
! wird indirekt im SUB 'read_inputFile' ueber die dortigen lokalen
|
|
||||||
! Variablen '_parameter' initialisiert. (siehe dort).
|
|
||||||
! Hier wird nur die 'Zufallsschleife' par(i,0) initialisiert.
|
|
||||||
|
|
||||||
DATA par(1,0) / 1. /
|
|
||||||
DATA par(2,0) / 1. /
|
|
||||||
DATA par(3,0) / 1. /
|
|
||||||
|
|
||||||
|
|
||||||
c - - - - - - - - - - Projektile- - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
DATA art_Name / 'm+ ', 'm- ', ! character*4
|
|
||||||
+ 'Mu ', 'Mu- ',
|
|
||||||
+ 'e+ ', 'e- ',
|
|
||||||
+ 'H+ ', 'H ', 'H- ',
|
|
||||||
+ 'H2+ ', 'H2 ', 'H2- ',
|
|
||||||
+ 'alfa',
|
|
||||||
|
|
||||||
+ 'A11+', 'A12+', 'A21+', 'A31+', 'A32+',
|
|
||||||
+ 'N11+', 'N21+',
|
|
||||||
+ 'K11+', 'K12+',
|
|
||||||
|
|
||||||
+ 'H2O1', 'H2O2', 'H2O3', 'H2O4', 'H2O5',
|
|
||||||
|
|
||||||
+ 'Hyd1', 'Hyd2', 'Hyd3', 'Hyd4', 'Hyd5',
|
|
||||||
+ 'Hyd6', 'Hyd7', 'Hyd8', 'Hyd9'
|
|
||||||
+ /
|
|
||||||
|
|
||||||
c folgende Werte wurden aus bzw. mittels 'HANDBOOK OF CHEMESTRY AND PHYSICS,
|
|
||||||
c 74th edition' und 'PHYSICAL REVIEW D, 50, S.1173-1826 (August 1994)' bestimmt:
|
|
||||||
|
|
||||||
DATA art_Masse / 105658., 105658.,
|
|
||||||
+ 106169., 106680.,
|
|
||||||
+ 510.9991, 510.9991,
|
|
||||||
+ 938272.3, 938783.3, 939294.3,
|
|
||||||
+ 1877055.6, 1877566.6, 1878077.6,
|
|
||||||
+ 3727380.2,
|
|
||||||
|
|
||||||
+ 37.96238E6,37.22371E6,74.44896E6,111.673689E6,111.673178E6,
|
|
||||||
+ 13.043273 ,26.087057,
|
|
||||||
+ 78.16258E6,78.162070E6,
|
|
||||||
|
|
||||||
+ 16.77623E6,33.55297E6,50.32971E6,67.10644E6,83.88318E6,
|
|
||||||
|
|
||||||
+ 17.71501E6,34.49175E6,51.26849E6,68.04523E6,84.82197E6,
|
|
||||||
+ 101.59870E6,118.37544E6,135.15218E6,151.92892E6
|
|
||||||
|
|
||||||
+ /
|
|
||||||
|
|
||||||
DATA art_Ladung / +1., -1.,
|
|
||||||
+ 0., -1.,
|
|
||||||
+ +1., -1.,
|
|
||||||
+ +1., 0., -1.,
|
|
||||||
+ +1., 0., -1.,
|
|
||||||
+ +2.,
|
|
||||||
|
|
||||||
+ +1., +2., +1., +1., +2.,
|
|
||||||
+ +1., +1.,
|
|
||||||
+ +1., +2.,
|
|
||||||
|
|
||||||
+ +1., +1., +1., +1., +1.,
|
|
||||||
|
|
||||||
+ +1., +1., +1., +1., +1.,
|
|
||||||
+ +1., +1., +1., +1.
|
|
||||||
+ /
|
|
||||||
|
|
||||||
DATA artList / ' ' /
|
|
||||||
DATA artList_defined /.false./
|
|
||||||
|
|
||||||
c - - - - - - - - - - Programmsteuerung - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
DATA scaleFactor / 1. /
|
|
||||||
|
|
||||||
DATA UseDecay / .false. /
|
|
||||||
|
|
||||||
DATA DEBUG / .false. /
|
|
||||||
|
|
||||||
DATA HVs_from_map / .false. /
|
|
||||||
DATA TestRun / .false. /
|
|
||||||
DATA log_confine / .false. /
|
|
||||||
DATA maxBelowDtSmall / 50 /
|
|
||||||
|
|
||||||
c - - - - - - - - - - Graphikausgabe- - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
DATA GRAPHICS / .false. /
|
|
||||||
DATA GRAPHICS_Anzahl / 25 /
|
|
||||||
|
|
||||||
DATA n_postSkript / 1 /
|
|
||||||
|
|
||||||
DATA imonitor / 2 /
|
|
||||||
|
|
||||||
c - - - - - - - - - - FileName- - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
DATA filename / 'AC_' /
|
|
||||||
|
|
||||||
c - - - - - - - - - - Vorgaben fuer das Summary - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
DATA n_outWhere / 2 /
|
|
||||||
|
|
||||||
DATA LogFile / .false. /
|
|
||||||
DATA smallLogFile / .false. /
|
|
||||||
|
|
||||||
DATA statsInSummary / .false. /
|
|
||||||
|
|
||||||
! 'statInSummary' wird indirekt im SUB 'read_inputFile' ueber die
|
|
||||||
! lokalen Variablen 'SUM_*' initialisiert (alle auf .false.)
|
|
||||||
|
|
||||||
c - - - - - - - - WELCHE FILES sollen erzeugt werden? (ausser .SUM)- - - - - -
|
|
||||||
|
|
||||||
DATA createTabellen / .false. /
|
|
||||||
|
|
||||||
! 'createTabelle' wird indirekt im SUB 'read_inputFile' ueber die
|
|
||||||
! lokalen Variablen 'TAB_*' initialisiert (alle auf .false.)
|
|
||||||
|
|
||||||
DATA createPhysTab / .false. /
|
|
||||||
|
|
||||||
DATA NTP_Misc / .false. /
|
|
||||||
DATA NTP_start / .false. /
|
|
||||||
DATA NTP_stop / .false. /
|
|
||||||
DATA NTP_40mm / .false. /
|
|
||||||
|
|
||||||
c - - - - - - - - - - Fehlerkontrolle - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
DATA eps_x / 1.e-5 /
|
|
||||||
DATA eps_v / 1.e-5 /
|
|
||||||
DATA log_relativ / .false. /
|
|
||||||
|
|
||||||
DATA maxStep / 6000 /
|
|
||||||
|
|
||||||
DATA dtsmall / .001 /
|
|
||||||
|
|
||||||
c - - - - - - - - - - Programmablauf- - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
DATA n_dtsmall / 0 /
|
|
||||||
DATA n_dtsmall_Max / 0 /
|
|
||||||
DATA dtsmall_counter / 0 /
|
|
||||||
DATA Lost_counter / 0 /
|
|
||||||
|
|
||||||
DATA Startflaeche / 0 /
|
|
||||||
DATA SchleifenNr / 0 /
|
|
||||||
|
|
||||||
c Ausgabekanaele (fuer die 'do indx = indx1, indx2 ....' Anweisungen):
|
|
||||||
|
|
||||||
DATA lun / lunLOG, lunScreen /
|
|
||||||
|
|
||||||
DATA OneLoop / .false. /
|
|
||||||
DATA OneStartPerLoop / .false. /
|
|
||||||
|
|
||||||
|
|
||||||
c fuer Random-Generator: 'seed' soll gross und ungerade sein. ->
|
|
||||||
c nimm den Sinus von secnds, und mache daraus durch Multiplikation mit ent-
|
|
||||||
c sprechender 10er-Potenz eine 8stellige Integer-Zahl. Sollte seed dann
|
|
||||||
c gerade sein, mache es ungerade:
|
|
||||||
|
|
||||||
help1= abs(sin(secnds(0.))) ! abs(), da sonst log10(sec) zu Fehler fuehrt
|
|
||||||
seed = int(help1* 10.**(8-int(log10(help1)) ) )
|
|
||||||
if ((seed/2)*2.EQ.seed) seed=seed-1 ! z.B. seed=3 -> seed/2=1, wegen Integer
|
|
||||||
|
|
||||||
|
|
||||||
@ -1,14 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c MAPMAP.INC
|
|
||||||
c===============================================================================
|
|
||||||
c Dieser Includefile stellt den Speicherplatz fuer die Potentialmappen bereit.
|
|
||||||
c Die einzelnen Mappen werden nacheinander fuer die jeweiligen Integrations-
|
|
||||||
c abschnitte eingelesen.
|
|
||||||
|
|
||||||
integer maxmaxmem
|
|
||||||
parameter (maxmaxmem = 4e6)
|
|
||||||
|
|
||||||
real map(0:maxmaxmem)
|
|
||||||
COMMON /map/ map
|
|
||||||
|
|
||||||
@ -1,43 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c MAP_DEF_1.INC
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c in diesem File sind die Dimensionen des Potentialmappen-Speichers fuer Mappe 1
|
|
||||||
c des Programms 'ACCEL' niedergelegt:
|
|
||||||
|
|
||||||
c Position der Folie relativ zur Kryoachse:
|
|
||||||
|
|
||||||
real xFoil
|
|
||||||
common /xFoil/ xFoil
|
|
||||||
|
|
||||||
|
|
||||||
c the grid characteristics:
|
|
||||||
|
|
||||||
real Dx_,Dy_,Dz_
|
|
||||||
c integer imax_,jmax_,kmax_
|
|
||||||
|
|
||||||
parameter ( Dx_ = .125, Dy_ = .125, Dz_ = .500)
|
|
||||||
c parameter ( imax_= 68, jmax_= 136, kmax_= 34)
|
|
||||||
|
|
||||||
real xmin,xmax
|
|
||||||
integer imax,jmax,kmax
|
|
||||||
common /map_1/ xmin,xmax, imax,jmax,kmax
|
|
||||||
|
|
||||||
|
|
||||||
c der Beginn des Uebergabebereichs zur naechsten Mappe:
|
|
||||||
|
|
||||||
real xStartUeberUpp
|
|
||||||
common /map_1/ xStartUeberUpp
|
|
||||||
|
|
||||||
|
|
||||||
c die naeherungsweise Obergrenze fuer die einzelnen Schrittlaengen:
|
|
||||||
|
|
||||||
real dl_max
|
|
||||||
parameter (dl_max = .1)
|
|
||||||
|
|
||||||
|
|
||||||
c the map:
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAPMAP.INC'
|
|
||||||
|
|
||||||
@ -1,43 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c MAP_DEF_2.INC
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c in diesem File sind die Dimensionen des Potentialmappen-Speichers fuer Mappe 2
|
|
||||||
c des Programms 'ACCEL' niedergelegt:
|
|
||||||
|
|
||||||
c Position der Folie relativ zur Kryoachse:
|
|
||||||
|
|
||||||
real xFoil
|
|
||||||
common /xFoil/ xFoil
|
|
||||||
|
|
||||||
|
|
||||||
c the grid characteristics:
|
|
||||||
|
|
||||||
real Dx_,Dy_,Dz_
|
|
||||||
c integer imax_,jmax_,kmax_
|
|
||||||
|
|
||||||
parameter ( Dx_ = .025, Dy_ = .025, Dz_ = .500)
|
|
||||||
c parameter ( imax_= 80, jmax_= 680, kmax_= 34)
|
|
||||||
|
|
||||||
real xmin,xmax
|
|
||||||
integer imax,jmax,kmax
|
|
||||||
common /map_2/ xmin,xmax, imax,jmax,kmax
|
|
||||||
|
|
||||||
|
|
||||||
c der Beginn des Uebergabebereichs zur naechsten Mappe:
|
|
||||||
|
|
||||||
real xStartUeberUpp,xStartUeberLow
|
|
||||||
common /map_2/ xStartUeberUpp,xStartUeberLow
|
|
||||||
|
|
||||||
|
|
||||||
c die naeherungsweise Obergrenze fuer die einzelnen Schrittlaengen:
|
|
||||||
|
|
||||||
real dl_max
|
|
||||||
parameter (dl_max = .05)
|
|
||||||
|
|
||||||
|
|
||||||
c the map:
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAPMAP.INC'
|
|
||||||
|
|
||||||
@ -1,43 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c MAP_DEF_3.INC
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c in diesem File sind die Dimensionen des Potentialmappen-Speichers fuer Mappe 3
|
|
||||||
c des Programms 'ACCEL' niedergelegt:
|
|
||||||
|
|
||||||
c Position der Folie relativ zur Kryoachse:
|
|
||||||
|
|
||||||
real xFoil
|
|
||||||
common /xFoil/ xFoil
|
|
||||||
|
|
||||||
|
|
||||||
c the grid characteristics:
|
|
||||||
|
|
||||||
real Dx_,Dy_,Dz_
|
|
||||||
c integer imax_,jmax_,kmax_
|
|
||||||
|
|
||||||
parameter ( Dx_ = .125, Dy_ = .125, Dz_ = .500)
|
|
||||||
c parameter ( imax_= 60, jmax_= 160, kmax_= 40)
|
|
||||||
|
|
||||||
real xmin,xmax
|
|
||||||
integer imax,jmax,kmax
|
|
||||||
common /map_3/ xmin,xmax, imax,jmax,kmax
|
|
||||||
|
|
||||||
|
|
||||||
c der Beginn des Uebergabebereichs zur naechsten Mappe:
|
|
||||||
|
|
||||||
real xStartUeberUpp,xStartUeberLow
|
|
||||||
common /map_3/ xStartUeberUpp,xStartUeberLow
|
|
||||||
|
|
||||||
|
|
||||||
c die naeherungsweise Obergrenze fuer die einzelnen Schrittlaengen:
|
|
||||||
|
|
||||||
real dl_max
|
|
||||||
parameter (dl_max = .2)
|
|
||||||
|
|
||||||
|
|
||||||
c the map:
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAPMAP.INC'
|
|
||||||
|
|
||||||
@ -1,43 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c MAP_DEF_4.INC
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c in diesem File sind die Dimensionen des Potentialmappen-Speichers fuer Mappe 4
|
|
||||||
c des Programms 'ACCEL' niedergelegt:
|
|
||||||
|
|
||||||
c Position der Folie relativ zur Kryoachse:
|
|
||||||
|
|
||||||
real xFoil
|
|
||||||
common /xFoil/ xFoil
|
|
||||||
|
|
||||||
|
|
||||||
c the grid characteristics:
|
|
||||||
|
|
||||||
real Dx_,Dy_,Dz_
|
|
||||||
c integer imax_,jmax_,kmax_
|
|
||||||
|
|
||||||
parameter ( Dx_ = .050, Dy_ = .050, Dz_ = .500)
|
|
||||||
c parameter ( imax_= 80, jmax_= 440, kmax_= 44)
|
|
||||||
|
|
||||||
real xmin,xmax
|
|
||||||
integer imax,jmax,kmax
|
|
||||||
common /map_4/ xmin,xmax, imax,jmax,kmax
|
|
||||||
|
|
||||||
|
|
||||||
c der Beginn des Uebergabebereichs zur naechsten Mappe:
|
|
||||||
|
|
||||||
real xStartUeberUpp,xStartUeberLow
|
|
||||||
common /map_4/ xStartUeberUpp,xStartUeberLow
|
|
||||||
|
|
||||||
|
|
||||||
c die naeherungsweise Obergrenze fuer die einzelnen Schrittlaengen:
|
|
||||||
|
|
||||||
real dl_max
|
|
||||||
parameter (dl_max = .1)
|
|
||||||
|
|
||||||
|
|
||||||
c the map:
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAPMAP.INC'
|
|
||||||
|
|
||||||
@ -1,43 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c MAP_DEF_5.INC
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c in diesem File sind die Dimensionen des Potentialmappen-Speichers fuer Mappe 5
|
|
||||||
c des Programms 'ACCEL' niedergelegt:
|
|
||||||
|
|
||||||
c Position der Folie relativ zur Kryoachse:
|
|
||||||
|
|
||||||
real xFoil
|
|
||||||
common /xFoil/ xFoil
|
|
||||||
|
|
||||||
|
|
||||||
c the grid characteristics:
|
|
||||||
|
|
||||||
real Dx_,Dy_,Dz_
|
|
||||||
c integer imax_,jmax_,kmax_
|
|
||||||
|
|
||||||
parameter ( Dx_ = .125, Dy_ = .125, Dz_ = .500)
|
|
||||||
c parameter ( imax_= 24, jmax_= 184, kmax_= 46)
|
|
||||||
|
|
||||||
real xmin,xmax
|
|
||||||
integer imax,jmax,kmax
|
|
||||||
common /map_5/ xmin,xmax, imax,jmax,kmax
|
|
||||||
|
|
||||||
|
|
||||||
c der Beginn des Uebergabebereichs zur naechsten Mappe:
|
|
||||||
|
|
||||||
real xStartUeberUpp,xStartUeberLow
|
|
||||||
common /map_5/ xStartUeberUpp,xStartUeberLow
|
|
||||||
|
|
||||||
|
|
||||||
c die naeherungsweise Obergrenze fuer die einzelnen Schrittlaengen:
|
|
||||||
|
|
||||||
real dl_max
|
|
||||||
parameter (dl_max = .2)
|
|
||||||
|
|
||||||
|
|
||||||
c the map:
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAPMAP.INC'
|
|
||||||
|
|
||||||
@ -1,31 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c MAP_DEF_6.INC
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c in diesem File sind die Dimensionen des Potentialmappen-Speichers fuer Mappe 6
|
|
||||||
c des Programms 'ACCEL' niedergelegt:
|
|
||||||
|
|
||||||
c the grid characteristics:
|
|
||||||
|
|
||||||
real Dx_,Dy_,Dz_
|
|
||||||
c integer jmax_,kmax_
|
|
||||||
|
|
||||||
parameter ( Dx_ = .250, Dy_ = .250, Dz_ = 1.00)
|
|
||||||
c parameter ( jmax_= 100, kmax_= 25)
|
|
||||||
|
|
||||||
real xmin,xmax
|
|
||||||
integer imax,jmax,kmax
|
|
||||||
common /map_6_/ xmin,xmax, imax,jmax,kmax
|
|
||||||
|
|
||||||
|
|
||||||
c die naeherungsweise Obergrenze fuer die einzelnen Schrittlaengen:
|
|
||||||
|
|
||||||
real dl_max
|
|
||||||
parameter (dl_max = .5)
|
|
||||||
|
|
||||||
|
|
||||||
c the map:
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAPMAP.INC'
|
|
||||||
|
|
||||||
@ -1,113 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c READ_INFO.INC
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c Dieser Includefile erledigt fuer die Subroutinen 'READ_INFO_x' das Einlesen
|
|
||||||
c und Ueberpruefen der Mappencharakteristika und der Uebergangsbereiche. Da
|
|
||||||
c die Mappen 1 und 6 leichte Spezialbehandlung erfordern steht in den
|
|
||||||
c zugehoerigen Dateien der entsprechende Code direkt, anstatt ueber diesen
|
|
||||||
c Includefile eingebunden zu werden. Aenderungen an diesem Code muessen
|
|
||||||
c daher im Regelfall auch in den Dateien 'SUB_integr_1.FOR' und
|
|
||||||
c 'SUB_integr_6.FOR' explizit durchgefuehrt werden!
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_DIRS.INC'
|
|
||||||
integer ihelp
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
logical map_error
|
|
||||||
COMMON /map_error/ map_error
|
|
||||||
|
|
||||||
c the grid characteristics (as read from the INFO-file):
|
|
||||||
|
|
||||||
real Dx,Dy,Dz
|
|
||||||
real x_iEQ1, ymax,zmax ! xmax wird in MAP_DEF_n.INC deklariert
|
|
||||||
|
|
||||||
namelist /grid_info/
|
|
||||||
+ Dx,Dy,Dz, imax,jmax,kmax, x_iEQ1, xmin,xmax,ymax,zmax
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
c Einlesen der Mappen-Informationen:
|
|
||||||
|
|
||||||
open (lunREAD,file=mappenName//'_'//Nr,defaultfile=mappenDir//':.INFO',
|
|
||||||
+ readonly,status='old')
|
|
||||||
read(lunREAD,nml=grid_info)
|
|
||||||
close (lunREAD)
|
|
||||||
|
|
||||||
|
|
||||||
c eingelesene imax, jmax und kmax um 1 reduzieren, da in 'ACCEL' die Feldindizes
|
|
||||||
c ab 0 laufen, bei 'RELAX3D' jedoch ab 1:
|
|
||||||
|
|
||||||
imax = imax-1
|
|
||||||
jmax = jmax-1
|
|
||||||
kmax = kmax-1
|
|
||||||
|
|
||||||
|
|
||||||
c Umrechnen der Koordinaten, wie sie von 'BESCHL-INIT' ('RELAX3D') verwendet
|
|
||||||
c werden (Ursprung in Targetfolienmitte) in System mit Ursprung auf der Kryo-Achse:
|
|
||||||
|
|
||||||
xmin = xmin + xFoil
|
|
||||||
xmax = xmax + xFoil
|
|
||||||
|
|
||||||
|
|
||||||
C DER FOLGENDE ABSCHNITT WURDE HERAUSKOMMENTIERT, DA ES MITTLERWEILE VERSCHIEDEN
|
|
||||||
C GROSSE POTENTIALMAPPEN GIBT UND DIE MAPPENDIMENSIONEN DAHER SOWIESO VARIABEL
|
|
||||||
C GEHALTEN WERDEN MUESSEN. DIE VERWENDUNG VON PARAMETERN IST LEIDER NICHT
|
|
||||||
C MEHR MOEGLICH. ('LEIDER' WEGEN DER ERHOEHTEN RECHENZEIT):
|
|
||||||
C
|
|
||||||
Cc checken, ob die Charakteristika der einzulesenden Mappe mit den Vorgaben der
|
|
||||||
Cc Integrationsroutinen uebereinstimmen:
|
|
||||||
C
|
|
||||||
C if (
|
|
||||||
C + imax.NE.imax_ .OR.
|
|
||||||
C + jmax.NE.jmax_ .OR. kmax.NE.kmax_ .OR.
|
|
||||||
C + Dx.NE.Dx_ .OR. Dy.NE.Dy_ .OR. Dz.NE.Dz_
|
|
||||||
Cc + .OR. xmin.NE.xmin_
|
|
||||||
C + ) then
|
|
||||||
C write(*,*) '-----------------------------------------------------------'
|
|
||||||
C if (.NOT.map_error) then
|
|
||||||
C write(*,*) ' Feldgroessen der eingelesenen Mappe und des reservierten'
|
|
||||||
C write(*,*) ' Speichers stimmen nicht ueberein:'
|
|
||||||
C write(*,*)
|
|
||||||
C endif
|
|
||||||
C write(*,*) ' MAPPE '//Nr//': '//mappenName(1:nameLength)//'_'//Nr//'.MAPPE'
|
|
||||||
C write(*,*) ' Mappe: imax ,jmax ,kmax = ',imax ,jmax ,kmax
|
|
||||||
C write(*,*) ' Dx ,Dy ,Dz = ',Dx ,Dy ,Dz
|
|
||||||
C write(*,*) ' Speicher: imax_,jmax_,kmax_ = ',imax_,jmax_,kmax_
|
|
||||||
C write(*,*) ' Dx_ ,Dy_ ,Dz_ = ',Dx_ ,Dy_ ,Dz_
|
|
||||||
C write(*,*)
|
|
||||||
C map_error = .true.
|
|
||||||
C endif
|
|
||||||
C
|
|
||||||
C if (map_error) RETURN ! kann auch in anderem 'READ_MAP_x' gesetzt worden sein
|
|
||||||
|
|
||||||
|
|
||||||
c checken, ob der reservierte Speicherplatz ausreicht:
|
|
||||||
|
|
||||||
iHelp = maxmaxmem+1
|
|
||||||
if ((imax+1)*(jmax+1)*(kmax+1).GT.iHelp) then
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) 'reservierter Speicher ist nicht ausreichend fuer Mappe',Nr
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) '(imax+1)*(jmax+1)*(kmax+1) = ',(imax+1)*(jmax+1)*(kmax+1)
|
|
||||||
write(*,*) 'maxmaxmem + 1 = ',maxmaxmem + 1
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) '=> ''maxmaxmem'' in accel$sourcedirectory:MAPMAP.INC angleichen'
|
|
||||||
write(*,*) ' und Programm mit ''LINKACV'' am DCL-Prompt neu kompilieren'
|
|
||||||
write(*,*) ' und linken.'
|
|
||||||
write(*,*)
|
|
||||||
call exit
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
c xStartUeber definieren:
|
|
||||||
|
|
||||||
xStartUeberUpp = xmax - .5*dx
|
|
||||||
xStartUeberLow = xmin + .5*dx
|
|
||||||
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
@ -1,58 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c READ_MAP.INC
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c Dieser Includefile erledigt fuer die Subroutinen 'READ_MAP_x' das Einlesen
|
|
||||||
c der Potentialmappe und falls notwendig die Fehlerausgabe.
|
|
||||||
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_DIRS.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
|
|
||||||
|
|
||||||
integer i,j,k, ihelp, iostat
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
c Einlesen der Potentialmappe:
|
|
||||||
|
|
||||||
|
|
||||||
open (lunRead,file=mappenName//'_'//Nr,
|
|
||||||
+ defaultfile=mappenDir//':.MAPPE',status='old',
|
|
||||||
+ form='unformatted',recl=imax+1,readonly)
|
|
||||||
c + form='unformatted',recl=imax,readonly)
|
|
||||||
write(*,*) 'reading '//mappenName(1:nameLength)//'_'//Nr//'.MAPPE ...'
|
|
||||||
do k = 0, kmax
|
|
||||||
do j = 0, jmax
|
|
||||||
c read(lunREAD,iostat=iostat) (map(i,j,k),i=0,imax)
|
|
||||||
ihelp = (k*(jmax+1)+j)*(imax+1)
|
|
||||||
read(lunREAD,iostat=iostat) (map(ihelp+i),i=0,imax)
|
|
||||||
if (iostat.NE.0) then
|
|
||||||
write(*,*)
|
|
||||||
write(*,999) i,j,k,iostat
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
close(lunREAD)
|
|
||||||
999 format(x/'error reading grid point (i,j,k) = ('i4','i4','
|
|
||||||
+ i4')'/'iostat = 'i4/)
|
|
||||||
|
|
||||||
|
|
||||||
c da die Anodenbereiche bei RELAX3D negativ kodiert sind, nimm die
|
|
||||||
c Absolutbetraege:
|
|
||||||
|
|
||||||
ihelp = 0
|
|
||||||
do k=0, kmax
|
|
||||||
do j=0, jmax
|
|
||||||
do i=0, imax
|
|
||||||
c map(i,j,k) = abs(map(i,j,k))
|
|
||||||
map(ihelp) = abs(map(ihelp))
|
|
||||||
ihelp = ihelp + 1
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
@ -1,192 +0,0 @@
|
|||||||
|
|
||||||
c===============================================================================
|
|
||||||
c RUNGE_KUTTA.INC
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
c Dieses Includefile erledigt fuer die Subroutinen 'INTEGRATIONSSTEP_RUNGE_KUTTA'
|
|
||||||
c die Fehlerbetrachtung, das Ertasten des Uebergabebereiches zur naechsten Mappe,
|
|
||||||
c die damit verbundenen Variationen des Zeitschrittes dt sowie die letztendliche
|
|
||||||
c Festlegung des neuen Ortes, der neuen Geschwindigkeit und der neuen Zeit.
|
|
||||||
|
|
||||||
|
|
||||||
c Zaehle die Schritte:
|
|
||||||
|
|
||||||
steps = steps + 1
|
|
||||||
|
|
||||||
|
|
||||||
c Fehlerbetrachtung:
|
|
||||||
|
|
||||||
c Fehlerbetrachtung:
|
|
||||||
c der groesste (absolute bzw. relative) Fehler im Ort soll kleiner als eps_x
|
|
||||||
c sein, der groesste Fehler in der Geschwindigkeit kleiner als eps_v:
|
|
||||||
c -> Bestimme den jeweils groessten Fehler der drei Komponenten des Ortes und
|
|
||||||
c der Geschwindigkeit (dh. die groesste Differenz der Aederungen):
|
|
||||||
|
|
||||||
maxErr_x = 0.
|
|
||||||
maxErr_v = 0.
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xDifferenz(i) = Dx1(i)-Dx2(i)
|
|
||||||
vDifferenz(i) = Dv1(i)-Dv2(i)
|
|
||||||
if (log_relativ) then
|
|
||||||
if (Dx1(i).NE.0.) maxErr_x = Max(maxErr_x,Abs(xDifferenz(i)/Dx1(i)))
|
|
||||||
if (Dv1(i).NE.0.) maxErr_v = Max(maxErr_v,Abs(vDifferenz(i)/Dv1(i)))
|
|
||||||
else
|
|
||||||
maxErr_x = Max( maxErr_x, Abs( xDifferenz(i) ) )
|
|
||||||
maxErr_v = Max( maxErr_v, Abs( vDifferenz(i) ) )
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
|
|
||||||
c - Skaliere den jeweils groessten relativen Fehler auf das jeweilige Epsilon:
|
|
||||||
|
|
||||||
maxErr_x = maxErr_x / eps_x
|
|
||||||
maxErr_v = maxErr_v / eps_v
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
c der groessere der beiden reskalierten Fehler bestimmt, ob der Integrations-
|
|
||||||
c schritt mit kleinerem Zeitintervall wiederholt werden muss, bzw. um welchen
|
|
||||||
c Faktor das Zeitintervall fuer den naechsten Schritt vergroessert werden kann:
|
|
||||||
|
|
||||||
c Liegt der Fehler ausserhalb des Toleranzbereiches und ist dt bereits jetzt
|
|
||||||
c kleiner als dtsmall, so mache keinen neuen Versuch sondern akzeptiere als Not-
|
|
||||||
c loesung den bestehenden Naeherungswert. Setze dt in diesem Fall als Default
|
|
||||||
c fuer den kommenden Integrationsschritt auf dtsmall. Setze aber auch das flag
|
|
||||||
c 'flag_dtsmall', damit gezaehlt werden kann, wie oft dieses Prozedur fuer ein
|
|
||||||
c bestimmtes Teilchen angewendet werden muss. Ist dies zu oft der Fall, so brich
|
|
||||||
c diese Trajektorienberechnung ganz ab (-> destiny = code_dtsmall).
|
|
||||||
c (2. Teil erfolgt weiter unten)
|
|
||||||
c
|
|
||||||
c Es kam vor, dass ohne Ueberschreitung der Fehlertoleranz ein 'dtupper'
|
|
||||||
c und ein 'dtlower' gefunden wurde, beim Ertasten des Uebergabebereiches
|
|
||||||
c die Fehlergrenze bei mittleren dt-Werten dann aber ueberschritten wurde,
|
|
||||||
c wodurch dt immer wieder verkuerzt wurde, ohne dass der Uebergabebereich
|
|
||||||
c erreicht werden konnte. Letztlich bildete das ganze eine unendliche Schleife.
|
|
||||||
c Daher werden jetzt jedesmal, wenn die Fehlergrenze ueberschritten wird
|
|
||||||
c 'found_upper' und 'found_lower' resettet.
|
|
||||||
|
|
||||||
|
|
||||||
maxErr = Max(maxErr_x,maxErr_v)
|
|
||||||
|
|
||||||
if (maxErr.GT.1.) then
|
|
||||||
found_upper_upp = .false.
|
|
||||||
found_lower_upp = .false.
|
|
||||||
found_upper_low = .false.
|
|
||||||
found_lower_low = .false.
|
|
||||||
if (dt.LT.dtsmall) then ! Fehler immer noch zu gross, obwohl
|
|
||||||
flag_dtsmall = .true. ! dtsmall schon unterschritten ist
|
|
||||||
else
|
|
||||||
!c Bestimme kuerzeren Zeitschritt fuer neuen Versuch (vgl. Referenz):
|
|
||||||
dt = safety * dt * (maxErr**pShrink)
|
|
||||||
goto 10
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
x_1 = x(1) + Dx1(1) + xDifferenz(1) / 15.
|
|
||||||
|
|
||||||
|
|
||||||
c Falls x(1) (== x_1) jetzt jenseits des Mappenendes liegen sollte, behalte
|
|
||||||
c dieses Faktum im Gedaechtnis und verkuerze den aktuell verwendeten Zeitschritt
|
|
||||||
c so lange um Faktor 0.5, bis x(1) innerhalb oder vor dem Uebergabebereich liegt.
|
|
||||||
c Liegt es dann davor, suche einen mittleren Zeitschritt, bei dem es innerhalb
|
|
||||||
c liegt.
|
|
||||||
c Hat das Teilchen danach (oder nachdem es direkt in den Uebergabebereich traf)
|
|
||||||
c positives v(1), so setze das Logical 'reachedEndOfMap' fuer die Berechnung
|
|
||||||
c des Schnittpunkts der Trajektorie mit dem Mappenende.
|
|
||||||
c (v(1)<0. ist entweder moeglich falls es bereits vor dem Mappenende reflektiert
|
|
||||||
c wurde oder gerade aus Mappe mit hoeherer Nummer kam).
|
|
||||||
|
|
||||||
if (x_1.GT.xStartUeberUpp) then
|
|
||||||
if (.NOT.found_upper_upp) dt_save = dt
|
|
||||||
if (x_1.LE.xMax .AND. v(1).GT.0.) then
|
|
||||||
reachedEndOfMap = .true.
|
|
||||||
elseif (x_1.GT.xMax) then
|
|
||||||
dtupper = dt
|
|
||||||
found_upper_upp = .true.
|
|
||||||
if (.NOT.found_lower_upp) then
|
|
||||||
dt = min(0.5*dt,(xStartUeberUpp-x(1))/(x_1-x(1))*dt)
|
|
||||||
else
|
|
||||||
dt = (dtlower+dtupper)/2.
|
|
||||||
endif
|
|
||||||
goto 10 ! neue Berechnung
|
|
||||||
endif
|
|
||||||
elseif (found_upper_upp) then
|
|
||||||
found_lower_upp = .true.
|
|
||||||
dtlower = dt
|
|
||||||
dt = (dtlower+dtupper)/2.
|
|
||||||
goto 10 ! neue Berechnung
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
c entsprechende Behandlung wie oben fuer den Fall, dass x(1) (== x_1) jetzt im
|
|
||||||
c Bereich des Mappenanfangs liegt:
|
|
||||||
|
|
||||||
if (x_1.LT.xStartUeberLow) then
|
|
||||||
if (.NOT.found_upper_low) dt_save = dt
|
|
||||||
if (x_1.GE.xMin .AND. v(1).LT.0) then
|
|
||||||
backOneMap = .true.
|
|
||||||
elseif (x_1.LT.xmin) then
|
|
||||||
found_upper_low = .true.
|
|
||||||
dtupper = dt
|
|
||||||
if (.NOT.found_lower_low) then
|
|
||||||
dt = min(0.5*dt,(xStartUeberLow-x(1))/(x_1-x(1))*dt)
|
|
||||||
else
|
|
||||||
dt = (dtlower+dtupper)/2.
|
|
||||||
endif
|
|
||||||
goto 10 ! neue Berechnung
|
|
||||||
endif
|
|
||||||
elseif (found_upper_low) then
|
|
||||||
found_lower_low = .true.
|
|
||||||
dtlower = dt
|
|
||||||
dt = (dtlower+dtupper)/2.
|
|
||||||
goto 10 ! neue Berechnung
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
c Nimm die Ergebnisse aus dem dt-Schritt und den beiden dt/2-Schritten und
|
|
||||||
c berechne damit den neuen Ort und die neue Geschwindigkeit mit Genauigkeit
|
|
||||||
c fuenfter Ordnung in dt:
|
|
||||||
|
|
||||||
x(1) = x_1
|
|
||||||
x(2) = x(2) + Dx1(2) + xDifferenz(2) / 15.
|
|
||||||
x(3) = x(3) + Dx1(3) + xDifferenz(3) / 15.
|
|
||||||
|
|
||||||
v(1) = v(1) + Dv1(1) + vDifferenz(1) / 15.
|
|
||||||
v(2) = v(2) + Dv1(2) + vDifferenz(2) / 15.
|
|
||||||
v(3) = v(3) + Dv1(3) + vDifferenz(3) / 15.
|
|
||||||
|
|
||||||
|
|
||||||
c alten Zeitschritt addieren:
|
|
||||||
|
|
||||||
t = t + dt
|
|
||||||
|
|
||||||
|
|
||||||
c Falls ein Uebergabebereich erreicht wurde, berechne Schnittpunkt der
|
|
||||||
c Trajektorie mit x=xmax (Mappenende) bzw. mit x=xmin (Mappenanfang):
|
|
||||||
|
|
||||||
if (reachedEndOfMap) goto 7766
|
|
||||||
if (backOneMap) goto 7767
|
|
||||||
|
|
||||||
|
|
||||||
c neuen Zeitschritt so gross wie sinnvoller weise moeglich machen:
|
|
||||||
|
|
||||||
3454 if (flag_dtSmall) then
|
|
||||||
if (n_dtsmall.LT.maxBelowDtSmall) then
|
|
||||||
dt = dtSmall ! fuer naechsten RK-Schritt
|
|
||||||
n_dtsmall = n_dtsmall + 1
|
|
||||||
else
|
|
||||||
destiny = code_dtsmall ! gib Teilchen verloren
|
|
||||||
RETURN
|
|
||||||
endif
|
|
||||||
else
|
|
||||||
if (maxErr.GT.errCon) then
|
|
||||||
dt = safety * dt * (maxErr**pGrow) ! vgl. Referenz
|
|
||||||
else
|
|
||||||
dt = 4. * dt ! <- Vergroesserung des Zeitschritts max. um
|
|
||||||
endif ! Faktor 4!
|
|
||||||
! pruefen, ob Maximallaenge fuer ersten Testschritt nicht ueberschritten ist:
|
|
||||||
if (log_confine) dt = min(dt,dl_max/sqrt(v(1)*v(1)+v(2)*v(2)+v(3)*v(3)))
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
@ -1,191 +0,0 @@
|
|||||||
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
|
|
||||||
c
|
|
||||||
c Die Routinen dieser Datei werden in das Programm 'ACCEL' eingebunden und
|
|
||||||
c dort von der Routine 'READ_INPUTFILE' aufgerufen.
|
|
||||||
c
|
|
||||||
c Aufgabe dieser Routinen ist es, aus der Variablen 'ArtList' (so ihr in der
|
|
||||||
c INPUT-Datei ein Wert zugewiesen wurde) die zu verwendenden Projektilarten zu
|
|
||||||
c extrahieren und die zugehoerigen Code-Nummern in das Feld 'art_Nr'
|
|
||||||
c einzutragen. Dieses wird dann im Hauptprogramm dazu benutzt, den Massen-
|
|
||||||
c und den Ladungsspeicher entsprechend den zu den Teilchen gehoerigen Werten
|
|
||||||
c zu belegen. Wurden in 'artList' keine Teilchenarten spezifiziert, so werden
|
|
||||||
c fuer die Einstellungen der Massen- und der Ladungsschleife im Hauptprogramm
|
|
||||||
c die Vorgaben fuer '_Masse' bzw. '_Ladung' aus dem INPUT-file verwendet.
|
|
||||||
c
|
|
||||||
c Die Subroutine EXAMINE_ARTLIST kopiert zunaechst buchstabenweise die Variable
|
|
||||||
c 'ArtList' in die Variable 'helpTxt', wobei saemtliche blanks entfernt werden.
|
|
||||||
c Anschliessend wird 'artList' geloescht. (Die Artenbezeichnungen werden spaeter
|
|
||||||
c formatiert wieder in 'artList' zurueckgeschrieben).
|
|
||||||
|
|
||||||
c Als naechstes werden aus 'HelpTxt' die Artenbezeichnungen einzeln in den
|
|
||||||
c Speicher 'testName' uebernommen und geprueft, ob die jeweilige Art erkannt
|
|
||||||
c wird. Ist die Artenbezeichnung laenger als vier Buchstaben, so erfolgt
|
|
||||||
c Programmabbruch mit Fehlermeldung (Routine ART_FEHLER). Das selbe passiert
|
|
||||||
c falls die Artenbezeichnung nicht erkannt wird.
|
|
||||||
c
|
|
||||||
c Wurde die Art erkannt, und befindet sie sich nicht schon in der Liste, so
|
|
||||||
c wird ihre Codezahl in das Feld 'art_Nr' uebernommen und wieder in die
|
|
||||||
c Variable 'ArtList' zurueckgeschrieben, wobei die Arten durch Komma und
|
|
||||||
c darauffolgendes blank getrennt werden.
|
|
||||||
c
|
|
||||||
c Wurden in 'artList' letztlich gueltige Artenbezeichnungen gefunden, so wird
|
|
||||||
c das logical 'artList_defined' auf .true. gesetzt und die Parameter fuer die
|
|
||||||
c Massen- und die Ladungs-Schleifen so eingestellt, dass erstere genau einen
|
|
||||||
c (Leer-) Durchlauf macht, letztere dagegen fuer jede gefundene Projektilart
|
|
||||||
c einen Durchgang vollfuehrt, in dem dann jeweils die zugehoerigen Ladungs- UND
|
|
||||||
c Massenwerte entsprechend den Inhalten der Speicher art_Ladung(artNr) und
|
|
||||||
c art_Masse(artNr) eingestellt werden.
|
|
||||||
c
|
|
||||||
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE EXAMINE_ARTLIST
|
|
||||||
c ==========================
|
|
||||||
|
|
||||||
|
|
||||||
implicit none
|
|
||||||
integer k,k1 ! Zaehlvariablen
|
|
||||||
|
|
||||||
integer length ! Laenge von helpTxt
|
|
||||||
integer pos ! Position in helpTxt
|
|
||||||
integer komma ! Position eines Kommas in helpTxt
|
|
||||||
integer nummer ! Nummer der naechsten erkannten Art
|
|
||||||
integer posL ! Position in ArtList
|
|
||||||
|
|
||||||
character helpChar*1, helpTxt*60, testName*4
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
c Es wurden noch keine Teilchen mit Myonen gefunden:
|
|
||||||
|
|
||||||
mu_flag = .false.
|
|
||||||
|
|
||||||
|
|
||||||
c 'artList' in 'helpText' uebernehmen, dabei alle Blanks entfernen. Taucht ein
|
|
||||||
c '!' auf, so ignoriere den Rest.
|
|
||||||
|
|
||||||
helpTxt = ' '
|
|
||||||
length = 0
|
|
||||||
do pos = 1, len(artList)
|
|
||||||
helpChar = artlist(pos:pos)
|
|
||||||
if (helpChar.EQ.'!') goto 1
|
|
||||||
if (helpChar.NE.' ') then
|
|
||||||
length = length+1
|
|
||||||
helpTxt(length:length) = helpChar
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
|
|
||||||
c write(*,*) 'artList = ',artList
|
|
||||||
c write(*,*) 'helpTxt = ',helpTxt
|
|
||||||
1 artList = ' '
|
|
||||||
|
|
||||||
|
|
||||||
c die Arten nacheinander in testName uebernehmen, und pruefen, ob sie erkannt
|
|
||||||
c werden:
|
|
||||||
|
|
||||||
nummer = 1
|
|
||||||
pos = 1
|
|
||||||
posL = 1
|
|
||||||
komma = 0
|
|
||||||
|
|
||||||
do while (komma.LT.length+1)
|
|
||||||
|
|
||||||
komma = INDEX(helpTxt,',') ! Position des ersten Kommas
|
|
||||||
if (komma.EQ.0) komma = length+1 ! falls kein ',' mehr, nimm Rest
|
|
||||||
c write(*,*) 'pos = ',pos
|
|
||||||
c write(*,*) 'komma = ',komma
|
|
||||||
|
|
||||||
if (komma-pos.GT.4) then ! ArtName hat max. 4 Lettern
|
|
||||||
call art_Fehler (helpTxt(pos:komma-1))
|
|
||||||
STOP
|
|
||||||
|
|
||||||
elseif (komma.NE.pos) then ! sonst: 2 Kommas hintereinander
|
|
||||||
testName = helpTxt(pos:komma-1)
|
|
||||||
c write(*,*) 'testName= ',testName
|
|
||||||
!c Pruefen, ob die Art bekannt ist. Wenn ja, pruefe, ob die Art
|
|
||||||
!c nicht schon in der Liste ist. Falls Nein, gib die Nummer der
|
|
||||||
!c entsprechenden Art in Art_Nr(nummer) und haenge den ArtNamen
|
|
||||||
!c gefolgt von Komma und Leerzeichen an artList an:
|
|
||||||
|
|
||||||
do k = 1, arten_zahl ! arten_Zahl = Anzahl bekannter Teilchenarten
|
|
||||||
if (testName.EQ.art_Name(k)) then ! Teilchenart erkannt
|
|
||||||
if (nummer.GT.1) then
|
|
||||||
do k1 = 1, nummer-1 ! Test, ob Art schon in Liste
|
|
||||||
if (Art_Nr(k1).EQ.k) goto 2 ! ueberspringen,
|
|
||||||
enddo ! => next, please!
|
|
||||||
endif
|
|
||||||
art_Nr(nummer) = k
|
|
||||||
if (k.LE.4) mu_flag = .true.
|
|
||||||
artList(posL:posL+komma-pos+1) =
|
|
||||||
+ helpTxt(pos:komma-1)//', '
|
|
||||||
posL = posL + komma-pos+2 ! Position fuer naechste Art
|
|
||||||
nummer = nummer + 1 ! definieren
|
|
||||||
if (nummer.GT.artenMax) goto 3 ! nicht mehr als artenMax Arten
|
|
||||||
goto 2 ! next, please
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
|
|
||||||
!c Art wurde nicht erkannt -> Fehlermeldung und Abbruch:
|
|
||||||
call art_Fehler(testName)
|
|
||||||
STOP
|
|
||||||
|
|
||||||
endif
|
|
||||||
|
|
||||||
2 if (komma.LT.length+1) helpTxt(komma:komma) = '#' ! , durch # ersetzen
|
|
||||||
pos = komma+1 ! und dann von vorne
|
|
||||||
|
|
||||||
enddo
|
|
||||||
|
|
||||||
3 artList(posL-2:posL-2)=' ' ! letztes Komma entfernen
|
|
||||||
|
|
||||||
c Wenn wir hier landen, wurden Teilchen in 'artList' gefunden und erkannt!
|
|
||||||
|
|
||||||
artList_defined = .true.
|
|
||||||
|
|
||||||
|
|
||||||
c Falls 'artList' kein Myonen-Teilchen enthaelt, braucht auch der Myonzerfall
|
|
||||||
c nicht beruecksichtigt zu werden:
|
|
||||||
|
|
||||||
if (.NOT.mu_flag) UseDecay = .false.
|
|
||||||
|
|
||||||
|
|
||||||
c Die Massen- und die Ladungsschleife einstellen:
|
|
||||||
|
|
||||||
par(1,mass) = 1. ! Masse-Schleife macht genau einen Durchgang
|
|
||||||
par(2,mass) = 1.
|
|
||||||
par(3,mass) = 1.
|
|
||||||
|
|
||||||
par(1,charge) = 1. ! Ladungsschleife macht fuer jede
|
|
||||||
par(2,charge) = nummer-1 ! Projektilart einen Durchgang
|
|
||||||
par(3,charge) = 1.
|
|
||||||
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
C===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
SUBROUTINE ART_FEHLER(artText)
|
|
||||||
c ==============================
|
|
||||||
|
|
||||||
|
|
||||||
character artText*(*)
|
|
||||||
|
|
||||||
write (*,*)
|
|
||||||
write (*,1) ' >>>>> Art ''',artText,''' ist unbekannt'
|
|
||||||
write (*,1) ' >>>>> Gueltig Artenbezeichnungen sind:'
|
|
||||||
write (*,1) ' >>>>> e+, e-, m+, m-, Mu, Mu-, H+, H, H-, '//
|
|
||||||
+ 'H2+, H2, H2-, alfa'
|
|
||||||
write (*,1) ' >>>>> (das Einlesen erfolgt CASE SENSITIVE!)'
|
|
||||||
write (*,*)
|
|
||||||
|
|
||||||
1 format(T10,A)
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
File diff suppressed because it is too large
Load Diff
@ -1,743 +0,0 @@
|
|||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE READ_INFO_1
|
|
||||||
c ======================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='1')
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_DIRS.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_1.INC'
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
logical map_error
|
|
||||||
COMMON /map_error/ map_error
|
|
||||||
|
|
||||||
c the grid characteristics (as read from the INFO-file):
|
|
||||||
|
|
||||||
real Dx,Dy,Dz
|
|
||||||
real x_iEQ1, ymax,zmax ! xmin wird in MAP_DEF_1 definiert
|
|
||||||
|
|
||||||
namelist /grid_info/
|
|
||||||
+ Dx,Dy,Dz, imax,jmax,kmax, x_iEQ1, xmin,xmax,ymax,zmax
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
c Einlesen der Mappen-Informationen:
|
|
||||||
|
|
||||||
open (lunREAD,file=mappenName//'_'//Nr,defaultfile=mappenDir//':.INFO',
|
|
||||||
+ readonly,status='old')
|
|
||||||
read(lunREAD,nml=grid_info)
|
|
||||||
close (lunREAD)
|
|
||||||
|
|
||||||
|
|
||||||
c eingelesene imax, jmax und kmax um 1 reduzieren, da in 'ACCEL' die Feldindizes
|
|
||||||
c ab 0 laufen, bei 'RELAX3D' jedoch ab 1:
|
|
||||||
|
|
||||||
imax = imax-1
|
|
||||||
jmax = jmax-1
|
|
||||||
kmax = kmax-1
|
|
||||||
|
|
||||||
|
|
||||||
c Umrechnen der Koordinaten, wie sie von 'BESCHL-INIT' ('RELAX3D') verwendet
|
|
||||||
c werden (Ursprung in Targetfolienmitte) in System mit Ursprung auf der Kryo-Achse:
|
|
||||||
|
|
||||||
xmin = xmin + xFoil
|
|
||||||
xmax = xmax + xFoil
|
|
||||||
|
|
||||||
|
|
||||||
c xStartUeber definieren:
|
|
||||||
|
|
||||||
xStartUeberUpp = xmax - .5*dx
|
|
||||||
|
|
||||||
|
|
||||||
C DER FOLGENDE ABSCHNITT WURDE HERAUSKOMMENTIERT, DA ES MITTLERWEILE VERSCHIEDEN
|
|
||||||
C GROSSE POTENTIALMAPPEN GIBT UND DIE MAPPENDIMENSIONEN DAHER SOWIESO VARIABEL
|
|
||||||
C GEHALTEN WERDEN MUESSEN. DIE VERWENDUNG VON PARAMETERN IST LEIDER NICHT
|
|
||||||
C MEHR MOEGLICH. ('LEIDER' WEGEN DER ERHOEHTEN RECHENZEIT):
|
|
||||||
C
|
|
||||||
Cc checken, ob die Characteristica der einzulesenden Mappe mit den Vorgaben des
|
|
||||||
Cc reservierten Speichers uebereinstimmen:
|
|
||||||
C
|
|
||||||
C if (
|
|
||||||
C + imax.NE.imax_ .OR.
|
|
||||||
C + jmax.NE.jmax_ .OR. kmax.NE.kmax_ .OR.
|
|
||||||
C + Dx.NE.Dx_ .OR. Dy.NE.Dy_ .OR. Dz.NE.Dz_
|
|
||||||
Cc + .OR. xmin.NE.xmin_
|
|
||||||
C + ) then
|
|
||||||
C write(*,*) '-----------------------------------------------------------'
|
|
||||||
C if (.NOT.map_error) then
|
|
||||||
C write(*,*) ' Feldgroessen der eingelesenen Mappe und des reservierten'
|
|
||||||
C write(*,*) ' Speichers stimmen nicht ueberein:'
|
|
||||||
C write(*,*)
|
|
||||||
C endif
|
|
||||||
C write(*,*) ' MAPPE '//Nr//': '//mappenName(1:nameLength)//'_'//Nr//'.MAPPE'
|
|
||||||
C write(*,*) ' Mappe: imax ,jmax ,kmax = ',imax ,jmax ,kmax
|
|
||||||
C write(*,*) ' Dx ,Dy ,Dz = ',Dx ,Dy ,Dz
|
|
||||||
C write(*,*) ' Speicher: imax_,jmax_,kmax_ = ',imax_,jmax_,kmax_
|
|
||||||
C write(*,*) ' Dx_ ,Dy_ ,Dz_ = ',Dx_ ,Dy_ ,Dz_
|
|
||||||
C write(*,*)
|
|
||||||
C map_error = .true.
|
|
||||||
C endif
|
|
||||||
C
|
|
||||||
C if (map_error) RETURN ! kann auch in anderem 'READ_MAP_x' gesetzt worden sein
|
|
||||||
|
|
||||||
|
|
||||||
c checken, ob der reservierte Speicherplatz ausreicht:
|
|
||||||
|
|
||||||
if ((imax+1)*(jmax+1)*(kmax+1).GT.maxmaxmem+1) then
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) 'reservierter Speicher ist nicht ausreichend fuer Mappe',Nr
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) '(imax+1)*(jmax+1)*(kmax+1) = ',(imax+1)*(jmax+1)*(kmax+1)
|
|
||||||
write(*,*) 'maxmaxmem + 1 = ',maxmaxmem + 1
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) '=> ''maxmaxmem'' in accel$sourcedirectory:MAPMAP.INC angleichen'
|
|
||||||
write(*,*) ' und Programm mit ''LINKACV'' am DCL-Prompt neu kompilieren'
|
|
||||||
write(*,*) ' und linken.'
|
|
||||||
write(*,*)
|
|
||||||
call exit
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE READ_MAP_1
|
|
||||||
c =====================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='1')
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_1.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:READ_MAP.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE ADD_MAP_1
|
|
||||||
c ====================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='1')
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_1.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:ADD_MAP.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_1(dt)
|
|
||||||
c =============================================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
SAVE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='1')
|
|
||||||
|
|
||||||
c Diese Subroutine berechnet zu einem vorgegebenen Zeitschritt dt den
|
|
||||||
c Integrationsschritt zweimal: einmal direkt mit dt und einmal ueber zwei
|
|
||||||
c aufeinanderfolgende Schritte mit dt/2. (die beiden dt/2-Schritte werden
|
|
||||||
c zuerst ausgefuehrt).
|
|
||||||
c
|
|
||||||
c Aus der Differenz der beiden Resultate wird eine Abschaetzung fuer den Fehler
|
|
||||||
c des dt-Schrittes gewonnen, die dazu verwendet wird zu entscheiden, ob der
|
|
||||||
c Integrationsschritt mit einem verkuerzten Zeitintervall wiederholt werden
|
|
||||||
c muss, oder ob das Zeitintervall fuer den folgenden ausgedehnt werden kann.
|
|
||||||
c
|
|
||||||
c Die beiden Einzelergebnisse aus dem dt- und den beiden dt/2-Schritten, die
|
|
||||||
c jeweils ueber Runge-Kutta-Rechnung vierter Ordnung erhalten werden, werden
|
|
||||||
c zum Schluss noch zusammengenommen, um ein Resultat mit Genauigkeit fuenfter
|
|
||||||
c Ordnung in dt zu erhalten.
|
|
||||||
c
|
|
||||||
c Der ganze Ablauf entspricht den Ausfuehrungen in Kapitel 15.2 der NUMERICAL
|
|
||||||
c RECIPIES: 'Adaptive Stepsize Control for Runge-Kutta' (vgl. Referenz im
|
|
||||||
c fileheader von 'ACCEL.FOR')
|
|
||||||
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_1.INC'
|
|
||||||
|
|
||||||
c fuer Fehlermeldungen:
|
|
||||||
d integer last_start_nr /0/, zaehler
|
|
||||||
|
|
||||||
real help
|
|
||||||
real dt_save
|
|
||||||
|
|
||||||
integer i ! Zaehlvariable
|
|
||||||
|
|
||||||
real dt,dt_half ! zeitl. Aenderung, halbe zeitl. Aenderung
|
|
||||||
real EFeld0(3), EFeld1(3) ! elektr. Felder
|
|
||||||
real x1(3),Dx1(3),Dx2(3) ! fuer Ortsintegration
|
|
||||||
real v1(3),Dv1(3),Dv2(3) ! fuer Geschw.Integration
|
|
||||||
real xDifferenz(3), vDifferenz(3)
|
|
||||||
real x_1 ! Hilfsvariable fuer testweises x(1)
|
|
||||||
real a ! Beschleunigung
|
|
||||||
|
|
||||||
real maxErr_x,maxErr_v,maxErr ! fuer Fehlerbetrachtung
|
|
||||||
|
|
||||||
real errCon, safety ! fuer Schrittweitenkontrolle
|
|
||||||
real pShrink, pGrow ! fuer Schrittweitenkontrolle
|
|
||||||
|
|
||||||
PARAMETER (errCon = 6.e-4, safety = .9) ! vgl. Referenz
|
|
||||||
PARAMETER (pShrink = -.25, pGrow = -.2)
|
|
||||||
! errCon = (4./safety)**(1/pGrow)
|
|
||||||
|
|
||||||
logical flag_dtSmall ! wenn dt kleiner als dtsmall ist und
|
|
||||||
! der Fehler immer noch zu gross ist.
|
|
||||||
|
|
||||||
logical found_lower_upp ! obere und untere Grenze fuer dt um
|
|
||||||
logical found_upper_upp ! Uebergabebereich zu treffen
|
|
||||||
real dtlower,dtupper
|
|
||||||
|
|
||||||
integer returnCode_EFeld
|
|
||||||
COMMON /returnCode_EFeld/ returnCode_EFeld
|
|
||||||
! 1: Testort hinter der Mappe
|
|
||||||
! 2: Testort neben der Mappe
|
|
||||||
! 3: Testort vor der Mappe
|
|
||||||
|
|
||||||
logical reducedAccur ! reduzierte Genauigkeit im Bereich
|
|
||||||
COMMON /reducedAccur/ reducedAccur ! des Folienrandes
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
flag_dtSmall = .false. ! flag resetten
|
|
||||||
found_lower_upp = .false.
|
|
||||||
found_upper_upp = .false.
|
|
||||||
if (dt.lt.dtsmall) dt = dtsmall
|
|
||||||
|
|
||||||
c berechne EFeld am aktuellen Ort. Speichere in EFeld0, damit sie wiederverwendet
|
|
||||||
c werden kann, falls mit kuerzerem Zeitschritt wiederholt werden muss:
|
|
||||||
|
|
||||||
call EFeld_1(x,EFeld0,*998)
|
|
||||||
|
|
||||||
c...............................................................................
|
|
||||||
10 continue ! hier gehts wieder von vorne los, falls Zeitschritt dt
|
|
||||||
! abgeaendert werden muss.
|
|
||||||
|
|
||||||
d if (once_more) then
|
|
||||||
d write (lunLOG,*)' selber Integrationsschritt, neues dt: ',dt
|
|
||||||
d else
|
|
||||||
d write (lunLOG,*)' >>>>>>>> dt = ',dt
|
|
||||||
d once_more = .true.
|
|
||||||
d endif
|
|
||||||
|
|
||||||
|
|
||||||
dt_half = dt / 2.
|
|
||||||
|
|
||||||
|
|
||||||
c mache ersten dt/2 - Schritt:
|
|
||||||
|
|
||||||
call SINGLESTEP_RUNGE_KUTTA_1(dt_half,EFeld0,x,v, Dx1,Dv1 ,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c berechne EFeld bei x1:
|
|
||||||
|
|
||||||
x1(1) = x(1) + Dx1(1)
|
|
||||||
x1(2) = x(2) + Dx1(2)
|
|
||||||
x1(3) = x(3) + Dx1(3)
|
|
||||||
|
|
||||||
v1(1) = v(1) + Dv1(1)
|
|
||||||
v1(2) = v(2) + Dv1(2)
|
|
||||||
v1(3) = v(3) + Dv1(3)
|
|
||||||
|
|
||||||
call EFeld_1(x1,EFeld1,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c mache zweiten dt/2 - Schritt:
|
|
||||||
|
|
||||||
call SINGLESTEP_RUNGE_KUTTA_1(dt_half,EFeld1,x1,v1, Dx2,Dv2 ,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c Summiere Ergebnisse der beiden dt/2 -Schritte und speichere in Dx1, Dv1:
|
|
||||||
|
|
||||||
Dx1(1) = Dx1(1) + Dx2(1)
|
|
||||||
Dx1(2) = Dx1(2) + Dx2(2)
|
|
||||||
Dx1(3) = Dx1(3) + Dx2(3)
|
|
||||||
|
|
||||||
Dv1(1) = Dv1(1) + Dv2(1)
|
|
||||||
Dv1(2) = Dv1(2) + Dv2(2)
|
|
||||||
Dv1(3) = Dv1(3) + Dv2(3)
|
|
||||||
|
|
||||||
|
|
||||||
c mache dt - Schritt:
|
|
||||||
|
|
||||||
call SINGLESTEP_RUNGE_KUTTA_1(dt,EFeld0,x,v, Dx2,Dv2 ,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
c Fehlerbetrachtung und gegebenenfalls Berechnung von neuem Ort und neuer
|
|
||||||
c Geschwindigkeit (falls der Fehler ausserhalb der Toleranz liegt wird Zeit-
|
|
||||||
c schritt dt verkuerzt und bei Label 10 erneut begonnen):
|
|
||||||
|
|
||||||
c Zaehle die Schritte:
|
|
||||||
|
|
||||||
steps = Steps + 1
|
|
||||||
|
|
||||||
|
|
||||||
c Fehlerbetrachtung:
|
|
||||||
|
|
||||||
c der groesste (absolute bzw. relative) Fehler im Ort soll kleiner als eps_x
|
|
||||||
c sein, der groesste Fehler in der Geschwindigkeit kleiner als eps_v:
|
|
||||||
c -> Bestimme den jeweils groessten Fehler der drei Komponenten des Ortes und
|
|
||||||
c der Geschwindigkeit (dh. die groesste Differenz der Aederungen):
|
|
||||||
|
|
||||||
maxErr_x = 0.
|
|
||||||
maxErr_v = 0.
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xDifferenz(i) = Dx1(i)-Dx2(i)
|
|
||||||
vDifferenz(i) = Dv1(i)-Dv2(i)
|
|
||||||
if (log_relativ.AND..NOT.reducedAccur) then
|
|
||||||
if (Dx1(i).NE.0.) maxErr_x = Max(maxErr_x,Abs(xDifferenz(i)/Dx1(i)))
|
|
||||||
if (Dv1(i).NE.0.) maxErr_v = Max(maxErr_v,Abs(vDifferenz(i)/Dv1(i)))
|
|
||||||
else
|
|
||||||
maxErr_x = Max(maxErr_x,Abs(xDifferenz(i)))
|
|
||||||
maxErr_v = Max(maxErr_v,Abs(vDifferenz(i)))
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
|
|
||||||
c - Skaliere den jeweils groessten relativen Fehler auf das jeweilige Epsilon:
|
|
||||||
|
|
||||||
if (reducedAccur) then
|
|
||||||
maxErr_x = maxErr_x / 1e-6
|
|
||||||
maxErr_v = maxErr_v / 1e-6
|
|
||||||
else
|
|
||||||
maxErr_x = maxErr_x / eps_x
|
|
||||||
maxErr_v = maxErr_v / eps_v
|
|
||||||
endif
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
c der groessere der beiden reskalierten Fehler bestimmt, ob der Integrations-
|
|
||||||
c schritt mit kleinerem Zeitintervall wiederholt werden muss, bzw. um welchen
|
|
||||||
c Faktor das Zeitintervall fuer den naechsten Schritt vergroessert werden kann:
|
|
||||||
|
|
||||||
c Liegt der Fehler ausserhalb des Toleranzbereiches und ist dt bereits jetzt
|
|
||||||
c kleiner als dtsmall, so mache keinen neuen Versuch sondern akzeptiere als Not-
|
|
||||||
c loesung den bestehenden Naeherungswert. Setze dt in diesem Fall als Default
|
|
||||||
c fuer den kommenden Integrationsschritt auf dtsmall. Setze aber auch das flag
|
|
||||||
c 'flag_dtsmall', damit gezaehlt werden kann, wie oft dieses Prozedur fuer ein
|
|
||||||
c bestimmtes Teilchen angewendet werden muss. Ist dies zu oft der Fall, so brich
|
|
||||||
c diese Trajektorienberechnung ganz ab (-> destiny = code_dtsmall).
|
|
||||||
c (2. Teil erfolgt weiter unten)
|
|
||||||
c
|
|
||||||
c Es kam vor, dass ohne Ueberschreitung der Fehlertoleranz ein 'dtupper'
|
|
||||||
c und ein 'dtlower' gefunden wurde, beim Ertasten des Uebergabebereiches
|
|
||||||
c die Fehlergrenze bei mittleren dt-Werten dann aber ueberschritten wurde,
|
|
||||||
c wodurch dt immer wieder verkuerzt wurde, ohne dass der Uebergabebereich
|
|
||||||
c erreicht werden konnte. Letztlich bildete das ganze eine unendliche Schleife.
|
|
||||||
c Daher werden jetzt jedesmal, wenn die Fehlergrenze ueberschritten wird
|
|
||||||
c 'found_upper' und 'found_lower' resettet.
|
|
||||||
|
|
||||||
maxErr = Max(maxErr_x,maxErr_v)
|
|
||||||
|
|
||||||
if (maxErr.GT.1.) then
|
|
||||||
found_upper_upp = .false.
|
|
||||||
found_lower_upp = .false.
|
|
||||||
if (dt.LT.dtsmall) then ! Fehler immer noch zu gross, obwohl
|
|
||||||
flag_dtsmall = .true. ! dtsmall schon unterschritten ist
|
|
||||||
else
|
|
||||||
!c Bestimme kuerzeren Zeitschritt fuer neuen Versuch (vgl. Referenz):
|
|
||||||
dt = safety * dt * (maxErr**pShrink)
|
|
||||||
goto 10
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
x_1 = x(1) + Dx1(1) + xDifferenz(1) / 15.
|
|
||||||
|
|
||||||
|
|
||||||
c Falls x(1) (== x_1) jetzt jenseits des Mappenendes liegen sollte, behalte
|
|
||||||
c dieses Faktum im Gedaechtnis und verkuerze den aktuell verwendeten Zeitschritt
|
|
||||||
c so lange um Faktor 0.5, bis x(1) innerhalb oder vor dem Uebergabebereich liegt.
|
|
||||||
c Liegt es dann davor, suche einen mittleren Zeitschritt, bei dem es innerhalb
|
|
||||||
c liegt.
|
|
||||||
c Hat das Teilchen danach (oder nachdem es direkt in den Uebergabebereich traf)
|
|
||||||
c positives v(1), so setze das Logical 'reachedEndOfMap' fuer die Berechnung
|
|
||||||
c des Schnittpunkts der Trajektorie mit dem Mappenende.
|
|
||||||
c (v(1)<0. ist entweder moeglich falls es bereits vor dem Mappenende reflektiert
|
|
||||||
c wurde oder gerade aus Mappe mit hoeherer Nummer kam).
|
|
||||||
|
|
||||||
if (x_1.GT.xStartUeberUpp) then
|
|
||||||
if (.NOT.found_upper_upp) dt_save = dt
|
|
||||||
if (x_1.LE.xMax .AND. v(1).GT.0.) then
|
|
||||||
reachedEndOfMap = .true.
|
|
||||||
elseif (x_1.GT.xMax) then
|
|
||||||
dtupper = dt
|
|
||||||
found_upper_upp = .true.
|
|
||||||
if (.NOT.found_lower_upp) then
|
|
||||||
dt = min(0.5*dt,(xStartUeberUpp-x(1))/(x_1-x(1))*dt)
|
|
||||||
else
|
|
||||||
dt = (dtlower+dtupper)/2.
|
|
||||||
endif
|
|
||||||
goto 10 ! neue Berechnung
|
|
||||||
endif
|
|
||||||
elseif (found_upper_upp) then
|
|
||||||
found_lower_upp = .true.
|
|
||||||
dtlower = dt
|
|
||||||
dt = (dtlower+dtupper)/2.
|
|
||||||
goto 10 ! neue Berechnung
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
c Nimm die Ergebnisse aus dem dt-Schritt und den beiden dt/2-Schritten und
|
|
||||||
c berechne damit den neuen Ort und die neue Geschwindigkeit mit Genauigkeit
|
|
||||||
c fuenfter Ordnung in dt:
|
|
||||||
|
|
||||||
x(1) = x_1
|
|
||||||
x(2) = x(2) + Dx1(2) + xDifferenz(2) / 15.
|
|
||||||
x(3) = x(3) + Dx1(3) + xDifferenz(3) / 15.
|
|
||||||
|
|
||||||
v(1) = v(1) + Dv1(1) + vDifferenz(1) / 15.
|
|
||||||
v(2) = v(2) + Dv1(2) + vDifferenz(2) / 15.
|
|
||||||
v(3) = v(3) + Dv1(3) + vDifferenz(3) / 15.
|
|
||||||
|
|
||||||
|
|
||||||
c alten Zeitschritt addieren:
|
|
||||||
|
|
||||||
t = t + dt
|
|
||||||
|
|
||||||
|
|
||||||
c Falls Uebergabebereich erreicht wurde, berechne Schnittpunkt der Trajektorie
|
|
||||||
c mit x=xmax (Mappenende):
|
|
||||||
|
|
||||||
if (reachedEndOfMap) goto 7766
|
|
||||||
|
|
||||||
|
|
||||||
c neuen Zeitschritt so gross wie sinnvoller weise moeglich machen:
|
|
||||||
|
|
||||||
3454 if (flag_dtSmall) then
|
|
||||||
if (n_dtsmall.LT.maxBelowDtSmall) then
|
|
||||||
dt = dtSmall ! fuer naechsten RK-Schritt
|
|
||||||
n_dtsmall = n_dtsmall + 1
|
|
||||||
else
|
|
||||||
destiny = code_dtsmall ! gib Teilchen verloren
|
|
||||||
RETURN
|
|
||||||
endif
|
|
||||||
else
|
|
||||||
if (maxErr.GT.errCon) then
|
|
||||||
dt = safety * dt * (maxErr**pGrow) ! vgl. Referenz
|
|
||||||
else
|
|
||||||
dt = 4. * dt ! <- Vergroesserung des Zeitschritts max. um
|
|
||||||
endif ! Faktor 4!
|
|
||||||
dt = min(dt,10000.)
|
|
||||||
! pruefen, ob Maximallaenge fuer ersten Testschritt nicht ueberschritten ist:
|
|
||||||
if (log_confine) dt = min(dt,dl_max/sqrt(v(1)*v(1)+v(2)*v(2)+v(3)*v(3)))
|
|
||||||
endif
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
|
|
||||||
c Stuetzstelle vor dem Mappenende liegt und die momentane Geschwindigkeit
|
|
||||||
c in positiver x-Richtung geht.
|
|
||||||
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
|
|
||||||
c ende (x=xmax) unter der Annahme eines konstanten mittleren EFeldes.
|
|
||||||
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
|
|
||||||
c Mappenende reflektiert werden koennte:
|
|
||||||
|
|
||||||
7766 continue
|
|
||||||
|
|
||||||
call EFeld_1(x,EFeld0,*997) ! Efeld am aktuellen Ort
|
|
||||||
|
|
||||||
! a == Beschleunigung bei x in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmax-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenende reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenende
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmax-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 1: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x1(1).NE.xmax) then
|
|
||||||
d write(*,*)' x1(1),x1(1)-xmax = ',x1(1),x1(1)-xmax
|
|
||||||
x1(1) = xmax
|
|
||||||
d endif
|
|
||||||
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
|
|
||||||
call EFeld_1(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
|
|
||||||
|
|
||||||
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
|
|
||||||
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
|
|
||||||
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
|
|
||||||
|
|
||||||
! wiederhole Berechnung mit mittlerem EFeld:
|
|
||||||
|
|
||||||
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmax-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenende reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenende
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmax-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 2: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
! Berechnen des neuen Ortes:
|
|
||||||
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x(1).NE.xmax) then
|
|
||||||
d write(*,*)' x(1),x(1)-xmax = ',x(1),x(1)-xmax
|
|
||||||
x(1) = xmax
|
|
||||||
d endif
|
|
||||||
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
! Berechnen der neuen Geschwindigkeit:
|
|
||||||
v(1) = v(1)+a*dt
|
|
||||||
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
|
|
||||||
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
|
|
||||||
! Berechnen der neuen Zeit:
|
|
||||||
t = t + dt
|
|
||||||
|
|
||||||
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
|
|
||||||
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
|
|
||||||
|
|
||||||
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
|
|
||||||
|
|
||||||
998 if (returnCode_EFeld.EQ.1) then
|
|
||||||
write(*,*) 'Mappe '//Nr//':'
|
|
||||||
write(*,*)' aktueller Teilchenort (nicht Testort!) hinter Potentialmappe!'
|
|
||||||
write(*,*)' start_nr = ',start_Nr
|
|
||||||
write(*,*)' x = ',x
|
|
||||||
write(*,*)' v = ',v
|
|
||||||
write(*,*)' -> STOP'
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
c - Fehler trat auf bei Berechnung des EFeldes am aktuellen Teilchenort oder
|
|
||||||
c an einem Testort (in 1. Fall erfolgt Einstieg bei 998):
|
|
||||||
|
|
||||||
999 if (returnCode_EFeld.EQ.1) then
|
|
||||||
if (.NOT.found_upper_upp) dt_save = dt
|
|
||||||
dtupper = dt
|
|
||||||
found_upper_upp = .true.
|
|
||||||
if (.NOT.found_lower_upp) then
|
|
||||||
dt = 0.5*dt
|
|
||||||
else
|
|
||||||
dt = (dtlower+dtupper)/2.
|
|
||||||
endif
|
|
||||||
goto 10
|
|
||||||
elseif (returnCode_EFeld.EQ.2) then
|
|
||||||
destiny = code_neben_Mappe
|
|
||||||
elseif (returnCode_EFeld.EQ.3) then
|
|
||||||
if (t.EQ.0.) then ! -> kann manchmal vorkommen
|
|
||||||
destiny = code_reflektiert
|
|
||||||
elseif (v(1).LE.0) then ! reflektiert -> kann vorkommen
|
|
||||||
destiny = code_reflektiert
|
|
||||||
else ! in Vorwaertsbewegung -> darf nicht vorkommen!!
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) 'Mappe '//Nr//':'
|
|
||||||
write(*,*)
|
|
||||||
write(*,*)' Test-x liegt vor der Mappe!'
|
|
||||||
write(*,*)' t = ',t
|
|
||||||
write(*,*)' x0 = ',x0
|
|
||||||
write(*,*)' v0 = ',v0
|
|
||||||
write(*,*)' E0 = ',E0
|
|
||||||
write(*,*)' theta0 = ',theta0
|
|
||||||
write(*,*)' phi0 = ',phi0
|
|
||||||
write(*,*)' x = ',x
|
|
||||||
write(*,*)' v = ',v
|
|
||||||
write(*,*)' Teilchen-Nr = ',Start_Nr
|
|
||||||
write(*,*)' Step = ',Steps
|
|
||||||
write(*,*)
|
|
||||||
write(*,*)' -> STOP'
|
|
||||||
write(*,*)
|
|
||||||
destiny = code_vor_Mappe
|
|
||||||
c STOP
|
|
||||||
endif
|
|
||||||
elseif (returnCode_EFeld.NE.0) then
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
|
|
||||||
write(*,*) 'unallowed value of ''returnCode_EFeld'': ',returnCode_Efeld
|
|
||||||
write(*,*) '-> STOP'
|
|
||||||
write(*,*)
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c - Fehler trat auf im Zusammenhang von Berechnungen des Schnittpunktes der
|
|
||||||
c Trajektorie mit einer Mappenbegrenzung:
|
|
||||||
|
|
||||||
997 if (returnCode_EFeld.EQ.2) then
|
|
||||||
destiny = code_neben_Mappe
|
|
||||||
else
|
|
||||||
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
|
|
||||||
write(*,*) 'alternate Return from EFELD_'//Nr//' while calculating intersection'
|
|
||||||
write(*,*) 'of trajectory and x equals xmax line.'
|
|
||||||
write(*,*)
|
|
||||||
write(*,*)' returnCode_EFeld = ',returnCode_EFeld
|
|
||||||
write(*,*)' t = ',t
|
|
||||||
write(*,*)' x0 = ',x0
|
|
||||||
write(*,*)' v0 = ',v0
|
|
||||||
write(*,*)' E0 = ',E0
|
|
||||||
write(*,*)' theta0 = ',theta0
|
|
||||||
write(*,*)' phi0 = ',phi0
|
|
||||||
write(*,*)' x = ',x
|
|
||||||
write(*,*)' v = ',v
|
|
||||||
write(*,*)' Teilchen-Nr = ',Start_Nr
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) '-> STOP'
|
|
||||||
write(*,*)
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE SINGLESTEP_RUNGE_KUTTA_1(dt,E0,x0,v0, Dx,Dv, *)
|
|
||||||
c ==========================================================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
c Diese Subroutine berechnet bei vorgegebenem Zeitschritt einen einzelnen
|
|
||||||
c Runge-Kutta-Integrationsschritt (4. Ordnung).
|
|
||||||
c Die Vorgehensweise entspricht den Ausfuehrungen in Kapitel 15.1 der
|
|
||||||
c NUMERICAL RECIPIES: 'Runge-Kutta Method'.
|
|
||||||
|
|
||||||
c Zurueckgegeben werden die errechneten Orts- und Geschwindigkeitsaenderungen
|
|
||||||
c anstatt direkt der neuen Werte, da sonst vor allem bei den Ortskoordinaten
|
|
||||||
c Schwierigkeiten auftreten koennen, wenn in der Subroutine 'INTEGRATIONSSTEP_
|
|
||||||
c RUNGE_KUTTA' aus der Differenz der neuen Werte aus den beiden dt/2- und dem
|
|
||||||
c dt-Schritt der Fehler abgeschaetzt werden soll (kleine Differenz moeglicher-
|
|
||||||
c weise grosser Werte).
|
|
||||||
|
|
||||||
|
|
||||||
real Beschl_Faktor
|
|
||||||
COMMON /Beschl_Faktor/ Beschl_Faktor
|
|
||||||
|
|
||||||
real E0(3), x0(3), v0(3) ! Eingangsgroessen
|
|
||||||
real E1(3), E2(3), E3(3) ! E-Felder an Testorten
|
|
||||||
real v1(3), v2(3), v3(3) ! Geschwindigkeiten an Testorten
|
|
||||||
real dt,dt_half,dt_sixth ! zeitl. Aenderung, dt/2, dt/6
|
|
||||||
real help, help_half, help_sixth ! Hilfsvariable, help/2, help/6
|
|
||||||
real xTest(3) ! Test-Orte
|
|
||||||
real Dx(3), Dv(3) ! Ergebnisspeicher
|
|
||||||
|
|
||||||
integer i ! Zaehlvariable
|
|
||||||
|
|
||||||
c = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|
||||||
|
|
||||||
dt_half = dt / 2.
|
|
||||||
dt_sixth = dt / 6.
|
|
||||||
help = Beschl_Faktor * dt
|
|
||||||
help_half = help / 2.
|
|
||||||
help_sixth = help / 6.
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xTest(i) = x0(i) + v0(i) * dt_half
|
|
||||||
v1(i) = v0(i) + E0(i) * help_half
|
|
||||||
enddo
|
|
||||||
call EFeld_1(xTest,E1,*999)
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xTest(i) = x0(i) + v1(i) * dt_half
|
|
||||||
v2(i) = v0(i) + E1(i) * help_half
|
|
||||||
enddo
|
|
||||||
call EFeld_1(xTest,E2,*999)
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xTest(i) = x0(i) + v2(i) * dt
|
|
||||||
v3(i) = v0(i) + E2(i) * help
|
|
||||||
enddo
|
|
||||||
call EFeld_1(xTest,E3,*999)
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
Dx(i) = (v0(i) + 2.*(v1(i)+v2(i)) + v3(i)) * dt_sixth
|
|
||||||
Dv(i) = (E0(i) + 2.*(E1(i)+E2(i)) + E3(i)) * help_sixth
|
|
||||||
enddo
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
999 RETURN 1
|
|
||||||
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE EFeld_1(x,E,*)
|
|
||||||
c =========================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_1.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:CALC_FIELD_1.INC'
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
c Rechne in Gittereinheiten um:
|
|
||||||
|
|
||||||
real_i = (x(1)-xmin) / Dx_
|
|
||||||
real_j = abs(x(2)) / Dy_
|
|
||||||
real_k = abs(x(3)) / Dz_
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
c Mache die Tests und berechne die Feldstaerke:
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:CALC_FIELD_2.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
@ -1,551 +0,0 @@
|
|||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE READ_INFO_2
|
|
||||||
c ======================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='2')
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_2.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:READ_INFO.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE READ_MAP_2
|
|
||||||
c =====================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='2')
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_2.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:READ_MAP.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE ADD_MAP_2
|
|
||||||
c ====================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='2')
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_2.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:ADD_MAP.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_2(dt)
|
|
||||||
c =============================================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
SAVE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='2')
|
|
||||||
|
|
||||||
c Diese Subroutine berechnet zu einem vorgegebenen Zeitschritt dt den
|
|
||||||
c Integrationsschritt zweimal: einmal direkt mit dt und einmal ueber zwei
|
|
||||||
c aufeinanderfolgende Schritte mit dt/2. (die beiden dt/2-Schritte werden
|
|
||||||
c zuerst ausgefuehrt).
|
|
||||||
c
|
|
||||||
c Aus der Differenz der beiden Resultate wird eine Abschaetzung fuer den Fehler
|
|
||||||
c des dt-Schrittes gewonnen, die dazu verwendet wird zu entscheiden, ob der
|
|
||||||
c Integrationsschritt mit einem verkuerzten Zeitintervall wiederholt werden
|
|
||||||
c muss, oder ob das Zeitintervall fuer den folgenden ausgedehnt werden kann.
|
|
||||||
c
|
|
||||||
c Die beiden Einzelergebnisse aus dem dt- und den beiden dt/2-Schritten, die
|
|
||||||
c jeweils ueber Runge-Kutta-Rechnung vierter Ordnung erhalten werden, werden
|
|
||||||
c zum Schluss noch zusammengenommen, um ein Resultat mit Genauigkeit fuenfter
|
|
||||||
c Ordnung in dt zu erhalten.
|
|
||||||
c
|
|
||||||
c Der ganze Ablauf entspricht den Ausfuehrungen in Kapitel 15.2 der NUMERICAL
|
|
||||||
c RECIPIES: 'Adaptive Stepsize Control for Runge-Kutta' (vgl. Referenz im
|
|
||||||
c fileheader von 'ACCEL.FOR')
|
|
||||||
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_2.INC'
|
|
||||||
|
|
||||||
real help
|
|
||||||
real dt_save
|
|
||||||
|
|
||||||
integer i ! Zaehlvariable
|
|
||||||
|
|
||||||
real dt,dt_half ! zeitl. Aenderung, halbe zeitl. Aenderung
|
|
||||||
real EFeld0(3), EFeld1(3) ! elektr. Felder
|
|
||||||
real x1(3),Dx1(3),Dx2(3) ! fuer Ortsintegration
|
|
||||||
real v1(3),Dv1(3),Dv2(3) ! fuer Geschw.Integration
|
|
||||||
real xDifferenz(3), vDifferenz(3)
|
|
||||||
real x_1 ! Hilfsvariable fuer testweises x(1)
|
|
||||||
real a ! Beschleunigung
|
|
||||||
|
|
||||||
real maxErr_x,maxErr_v,maxErr ! fuer Fehlerbetrachtung
|
|
||||||
|
|
||||||
real errCon, safety ! fuer Schrittweitenkontrolle
|
|
||||||
real pShrink, pGrow ! fuer Schrittweitenkontrolle
|
|
||||||
|
|
||||||
PARAMETER (errCon = 6.e-4, safety = .9) ! vgl. Referenz
|
|
||||||
PARAMETER (pShrink = -.25, pGrow = -.2)
|
|
||||||
! errCon = (4./safety)**(1/pGrow)
|
|
||||||
|
|
||||||
logical flag_dtSmall ! wenn dt kleiner als dtsmall ist und
|
|
||||||
! der Fehler immer noch zu gross ist.
|
|
||||||
|
|
||||||
logical found_lower_upp ! obere und untere Grenze fuer dt um
|
|
||||||
logical found_upper_upp ! Uebergabebereich zu treffen
|
|
||||||
logical found_lower_low ! obere und untere Grenze fuer dt um
|
|
||||||
logical found_upper_low ! Uebergabebereich zu treffen
|
|
||||||
real dtlower,dtupper
|
|
||||||
|
|
||||||
integer returnCode_EFeld
|
|
||||||
COMMON /returnCode_EFeld/ returnCode_EFeld
|
|
||||||
! 1: Testort hinter der Mappe
|
|
||||||
! 2: Testort neben der Mappe
|
|
||||||
! 3: Testort vor der Mappe
|
|
||||||
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
flag_dtSmall = .false. ! flag resetten
|
|
||||||
found_lower_upp = .false.
|
|
||||||
found_upper_upp = .false.
|
|
||||||
found_lower_low = .false.
|
|
||||||
found_upper_low = .false.
|
|
||||||
if (dt.lt.dtsmall) dt = dtsmall
|
|
||||||
|
|
||||||
c berechne EFeld am aktuellen Ort. Speichere in EFeld0, damit sie wiederverwendet
|
|
||||||
c werden kann, falls mit kuerzerem Zeitschritt wiederholt werden muss:
|
|
||||||
|
|
||||||
call EFeld_2(x,EFeld0,*998)
|
|
||||||
|
|
||||||
c...............................................................................
|
|
||||||
10 continue ! hier gehts wieder von vorne los, falls Zeitschritt dt
|
|
||||||
! abgeaendert werden muss.
|
|
||||||
|
|
||||||
dt_half = dt / 2.
|
|
||||||
|
|
||||||
|
|
||||||
c mache ersten dt/2 - Schritt:
|
|
||||||
|
|
||||||
call SINGLESTEP_RUNGE_KUTTA_2(dt_half,EFeld0,x,v, Dx1,Dv1 ,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c berechne EFeld bei x1:
|
|
||||||
|
|
||||||
x1(1) = x(1) + Dx1(1)
|
|
||||||
x1(2) = x(2) + Dx1(2)
|
|
||||||
x1(3) = x(3) + Dx1(3)
|
|
||||||
|
|
||||||
v1(1) = v(1) + Dv1(1)
|
|
||||||
v1(2) = v(2) + Dv1(2)
|
|
||||||
v1(3) = v(3) + Dv1(3)
|
|
||||||
|
|
||||||
call EFeld_2(x1,EFeld1,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c mache zweiten dt/2 - Schritt:
|
|
||||||
|
|
||||||
call SINGLESTEP_RUNGE_KUTTA_2(dt_half,EFeld1,x1,v1, Dx2,Dv2 ,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c Summiere Ergebnisse der beiden dt/2 -Schritte und speichere in Dx1, Dv1:
|
|
||||||
|
|
||||||
Dx1(1) = Dx1(1) + Dx2(1)
|
|
||||||
Dx1(2) = Dx1(2) + Dx2(2)
|
|
||||||
Dx1(3) = Dx1(3) + Dx2(3)
|
|
||||||
|
|
||||||
Dv1(1) = Dv1(1) + Dv2(1)
|
|
||||||
Dv1(2) = Dv1(2) + Dv2(2)
|
|
||||||
Dv1(3) = Dv1(3) + Dv2(3)
|
|
||||||
|
|
||||||
|
|
||||||
c mache dt - Schritt:
|
|
||||||
|
|
||||||
call SINGLESTEP_RUNGE_KUTTA_2(dt,EFeld0,x,v, Dx2,Dv2 ,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
c Fehlerbetrachtung und gegebenenfalls Berechnung von neuem Ort und neuer
|
|
||||||
c Geschwindigkeit (falls der Fehler ausserhalb der Toleranz liegt wird Zeit-
|
|
||||||
c schritt dt verkuerzt und bei Label 10 erneut begonnen):
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:RUNGE_KUTTA.INC'
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
|
|
||||||
c Stuetzstelle vor dem Mappenende liegt und die momentane Geschwindigkeit
|
|
||||||
c in positiver x-Richtung geht.
|
|
||||||
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
|
|
||||||
c ende (x=xmax) unter der Annahme eines konstanten mittleren EFeldes.
|
|
||||||
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
|
|
||||||
c Mappenende reflektiert werden koennte:
|
|
||||||
|
|
||||||
7766 continue
|
|
||||||
|
|
||||||
call EFeld_2(x,EFeld0,*997) ! Efeld am aktuellen Ort
|
|
||||||
|
|
||||||
! a == Beschleunigung bei x in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmax-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenende reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenende
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmax-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 1: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x1(1).NE.xmax) then
|
|
||||||
d write(*,*)' x1(1),x1(1)-xmax = ',x1(1),x1(1)-xmax
|
|
||||||
x1(1) = xmax
|
|
||||||
d endif
|
|
||||||
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
|
|
||||||
call EFeld_2(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
|
|
||||||
|
|
||||||
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
|
|
||||||
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
|
|
||||||
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
|
|
||||||
|
|
||||||
! wiederhole Berechnung mit mittlerem EFeld:
|
|
||||||
|
|
||||||
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmax-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenende reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenende
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmax-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 2: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
! Berechnen des neuen Ortes:
|
|
||||||
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x(1).NE.xmax) then
|
|
||||||
d write(*,*)' x(1),x(1)-xmax = ',x(1),x(1)-xmax
|
|
||||||
x(1) = xmax
|
|
||||||
d endif
|
|
||||||
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
! Berechnen der neuen Geschwindigkeit:
|
|
||||||
v(1) = v(1)+a*dt
|
|
||||||
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
|
|
||||||
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
|
|
||||||
! Berechnen der neuen Zeit:
|
|
||||||
t = t + dt
|
|
||||||
|
|
||||||
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
|
|
||||||
c Stuetzstelle hinter dem Mappenanfang liegt und die momentane Geschwindigkeit
|
|
||||||
c in negativer x-Richtung geht.
|
|
||||||
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
|
|
||||||
c anfang (x=xmin) unter der Annahme eines konstanten mittleren EFeldes.
|
|
||||||
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
|
|
||||||
c Mappenanfang reflektiert werden koennte:
|
|
||||||
|
|
||||||
7767 continue
|
|
||||||
|
|
||||||
call EFeld_2(x,EFeld0,*997) ! Efeld am aktuellen Ort
|
|
||||||
|
|
||||||
! a == Beschleunigung bei x in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmin-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenanfang
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (-sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmin-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 3: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x1(1).NE.xmin) then
|
|
||||||
d write(*,*)' x1(1),x1(1)-xmin = ',x1(1),x1(1)-xmin
|
|
||||||
x1(1) = xmin
|
|
||||||
d endif
|
|
||||||
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
|
|
||||||
call EFeld_2(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
|
|
||||||
|
|
||||||
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
|
|
||||||
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
|
|
||||||
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
|
|
||||||
|
|
||||||
! wiederhole Berechnung mit mittlerem EFeld:
|
|
||||||
|
|
||||||
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmin-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenanfang
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (-sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmin-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 4: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
! Berechnen des neuen Ortes:
|
|
||||||
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x(1).NE.xmin) then
|
|
||||||
d write(*,*)' x(1),x(1)-xmin = ',x(1),x(1)-xmin
|
|
||||||
x(1) = xmin
|
|
||||||
d endif
|
|
||||||
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
! Berechnen der neuen Geschwindigkeit:
|
|
||||||
v(1) = v(1)+a*dt
|
|
||||||
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
|
|
||||||
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
|
|
||||||
! Berechnen der neuen Zeit:
|
|
||||||
t = t + dt
|
|
||||||
|
|
||||||
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
|
|
||||||
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
|
|
||||||
|
|
||||||
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
|
|
||||||
|
|
||||||
998 if (returnCode_EFeld.EQ.1) then
|
|
||||||
write(*,*) 'Mappe '//Nr//':'
|
|
||||||
write(*,*)' aktueller Teilchenort (nicht Testort!) hinter Potentialmappe!'
|
|
||||||
write(*,*)' -> STOP'
|
|
||||||
write(*,*)
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
c - Fehler trat auf bei Berechnung des EFeldes am aktuellen Teilchenort oder
|
|
||||||
c an einem Testort (in 1. Fall erfolgt Einstieg bei 998):
|
|
||||||
|
|
||||||
999 if (returnCode_EFeld.EQ.1) then
|
|
||||||
if (.NOT.found_upper_upp) dt_save = dt
|
|
||||||
dtupper = dt
|
|
||||||
found_upper_upp = .true.
|
|
||||||
if (.NOT.found_lower_upp) then
|
|
||||||
dt = 0.5*dt
|
|
||||||
else
|
|
||||||
dt = (dtlower+dtupper)/2.
|
|
||||||
endif
|
|
||||||
goto 10
|
|
||||||
elseif (returnCode_EFeld.EQ.2) then
|
|
||||||
destiny = code_neben_Mappe
|
|
||||||
elseif (returnCode_EFeld.EQ.3) then
|
|
||||||
if (.NOT.found_upper_low) dt_save = dt
|
|
||||||
dtupper = dt
|
|
||||||
found_upper_low = .true.
|
|
||||||
if (.NOT.found_lower_low) then
|
|
||||||
dt = 0.5*dt
|
|
||||||
else
|
|
||||||
dt = (dtlower+dtupper)/2.
|
|
||||||
endif
|
|
||||||
goto 10
|
|
||||||
elseif (returnCode_EFeld.NE.0) then
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
|
|
||||||
write(*,*) 'unallowed value of ''returnCode_EFeld'': ',returnCode_Efeld
|
|
||||||
write(*,*) '-> STOP'
|
|
||||||
write(*,*)
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c - Fehler trat auf im Zusammenhang von Berechnungen des Schnittpunktes der
|
|
||||||
c Trajektorie mit einer Mappenbegrenzung:
|
|
||||||
|
|
||||||
997 if (returnCode_EFeld.EQ.2) then
|
|
||||||
destiny = code_neben_Mappe
|
|
||||||
else
|
|
||||||
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
|
|
||||||
write(*,*) 'alternate Return from EFELD_'//Nr//' while calculating intersection'
|
|
||||||
write(*,*) 'of trajectory and x equals xmax or xmin line.'
|
|
||||||
write(*,*)
|
|
||||||
write(*,*)' returnCode_EFeld = ',returnCode_EFeld
|
|
||||||
write(*,*)' t = ',t
|
|
||||||
write(*,*)' x0 = ',x0
|
|
||||||
write(*,*)' v0 = ',v0
|
|
||||||
write(*,*)' E0 = ',E0
|
|
||||||
write(*,*)' theta0 = ',theta0
|
|
||||||
write(*,*)' phi0 = ',phi0
|
|
||||||
write(*,*)' x = ',x
|
|
||||||
write(*,*)' v = ',v
|
|
||||||
write(*,*)' Teilchen-Nr = ',Start_Nr
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) '-> STOP'
|
|
||||||
write(*,*)
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE SINGLESTEP_RUNGE_KUTTA_2(dt,E0,x0,v0, Dx,Dv, *)
|
|
||||||
c ==========================================================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
c Diese Subroutine berechnet bei vorgegebenem Zeitschritt einen einzelnen
|
|
||||||
c Runge-Kutta-Integrationsschritt (4. Ordnung).
|
|
||||||
c Die Vorgehensweise entspricht den Ausfuehrungen in Kapitel 15.1 der
|
|
||||||
c NUMERICAL RECIPIES: 'Runge-Kutta Method'.
|
|
||||||
|
|
||||||
c Zurueckgegeben werden die errechneten Orts- und Geschwindigkeitsaenderungen
|
|
||||||
c anstatt direkt der neuen Werte, da sonst vor allem bei den Ortskoordinaten
|
|
||||||
c Schwierigkeiten auftreten koennen, wenn in der Subroutine 'INTEGRATIONSSTEP_
|
|
||||||
c RUNGE_KUTTA' aus der Differenz der neuen Werte aus den beiden dt/2- und dem
|
|
||||||
c dt-Schritt der Fehler abgeschaetzt werden soll (kleine Differenz moeglicher-
|
|
||||||
c weise grosser Werte).
|
|
||||||
|
|
||||||
|
|
||||||
real Beschl_Faktor
|
|
||||||
COMMON /Beschl_Faktor/ Beschl_Faktor
|
|
||||||
|
|
||||||
real E0(3), x0(3), v0(3) ! Eingangsgroessen
|
|
||||||
real E1(3), E2(3), E3(3) ! E-Felder an Testorten
|
|
||||||
real v1(3), v2(3), v3(3) ! Geschwindigkeiten an Testorten
|
|
||||||
real dt,dt_half,dt_sixth ! zeitl. Aenderung, dt/2, dt/6
|
|
||||||
real help, help_half, help_sixth ! Hilfsvariable, help/2, help/6
|
|
||||||
real xTest(3) ! Test-Orte
|
|
||||||
real Dx(3), Dv(3) ! Ergebnisspeicher
|
|
||||||
|
|
||||||
integer i ! Zaehlvariable
|
|
||||||
|
|
||||||
c = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|
||||||
|
|
||||||
dt_half = dt / 2.
|
|
||||||
dt_sixth = dt / 6.
|
|
||||||
help = Beschl_Faktor * dt
|
|
||||||
help_half = help / 2.
|
|
||||||
help_sixth = help / 6.
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xTest(i) = x0(i) + v0(i) * dt_half
|
|
||||||
v1(i) = v0(i) + E0(i) * help_half
|
|
||||||
enddo
|
|
||||||
call EFeld_2(xTest,E1,*999)
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xTest(i) = x0(i) + v1(i) * dt_half
|
|
||||||
v2(i) = v0(i) + E1(i) * help_half
|
|
||||||
enddo
|
|
||||||
call EFeld_2(xTest,E2,*999)
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xTest(i) = x0(i) + v2(i) * dt
|
|
||||||
v3(i) = v0(i) + E2(i) * help
|
|
||||||
enddo
|
|
||||||
call EFeld_2(xTest,E3,*999)
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
Dx(i) = (v0(i) + 2.*(v1(i)+v2(i)) + v3(i)) * dt_sixth
|
|
||||||
Dv(i) = (E0(i) + 2.*(E1(i)+E2(i)) + E3(i)) * help_sixth
|
|
||||||
enddo
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
999 RETURN 1
|
|
||||||
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE EFeld_2(x,E,*)
|
|
||||||
c =========================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_2.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:CALC_FIELD_1.INC'
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
c Rechne in Gittereinheiten um:
|
|
||||||
|
|
||||||
real_i = (x(1)-xmin) / Dx_
|
|
||||||
real_j = abs(x(2)) / Dy_
|
|
||||||
real_k = abs(x(3)) / Dz_
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
c Mache die Tests und berechne die Feldstaerke:
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:CALC_FIELD_2.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
@ -1,553 +0,0 @@
|
|||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE READ_INFO_3
|
|
||||||
c ======================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='3')
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_3.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:READ_INFO.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE READ_MAP_3
|
|
||||||
c =====================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='3')
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_3.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:READ_MAP.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE ADD_MAP_3
|
|
||||||
c ====================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='3')
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_3.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:ADD_MAP.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_3(dt)
|
|
||||||
c =============================================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
SAVE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='3')
|
|
||||||
|
|
||||||
c Diese Subroutine berechnet zu einem vorgegebenen Zeitschritt dt den
|
|
||||||
c Integrationsschritt zweimal: einmal direkt mit dt und einmal ueber zwei
|
|
||||||
c aufeinanderfolgende Schritte mit dt/2. (die beiden dt/2-Schritte werden
|
|
||||||
c zuerst ausgefuehrt).
|
|
||||||
c
|
|
||||||
c Aus der Differenz der beiden Resultate wird eine Abschaetzung fuer den Fehler
|
|
||||||
c des dt-Schrittes gewonnen, die dazu verwendet wird zu entscheiden, ob der
|
|
||||||
c Integrationsschritt mit einem verkuerzten Zeitintervall wiederholt werden
|
|
||||||
c muss, oder ob das Zeitintervall fuer den folgenden ausgedehnt werden kann.
|
|
||||||
c
|
|
||||||
c Die beiden Einzelergebnisse aus dem dt- und den beiden dt/2-Schritten, die
|
|
||||||
c jeweils ueber Runge-Kutta-Rechnung vierter Ordnung erhalten werden, werden
|
|
||||||
c zum Schluss noch zusammengenommen, um ein Resultat mit Genauigkeit fuenfter
|
|
||||||
c Ordnung in dt zu erhalten.
|
|
||||||
c
|
|
||||||
c Der ganze Ablauf entspricht den Ausfuehrungen in Kapitel 15.2 der NUMERICAL
|
|
||||||
c RECIPIES: 'Adaptive Stepsize Control for Runge-Kutta' (vgl. Referenz im
|
|
||||||
c fileheader von 'ACCEL.FOR')
|
|
||||||
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_3.INC'
|
|
||||||
|
|
||||||
real help
|
|
||||||
real dt_save
|
|
||||||
|
|
||||||
integer i ! Zaehlvariable
|
|
||||||
|
|
||||||
real dt,dt_half ! zeitl. Aenderung, halbe zeitl. Aenderung
|
|
||||||
real EFeld0(3), EFeld1(3) ! elektr. Felder
|
|
||||||
real x1(3),Dx1(3),Dx2(3) ! fuer Ortsintegration
|
|
||||||
real v1(3),Dv1(3),Dv2(3) ! fuer Geschw.Integration
|
|
||||||
real xDifferenz(3), vDifferenz(3)
|
|
||||||
real x_1 ! Hilfsvariable fuer testweises x(1)
|
|
||||||
real a ! Beschleunigung
|
|
||||||
|
|
||||||
real maxErr_x,maxErr_v,maxErr ! fuer Fehlerbetrachtung
|
|
||||||
|
|
||||||
real errCon, safety ! fuer Schrittweitenkontrolle
|
|
||||||
real pShrink, pGrow ! fuer Schrittweitenkontrolle
|
|
||||||
|
|
||||||
PARAMETER (errCon = 6.e-4, safety = .9) ! vgl. Referenz
|
|
||||||
PARAMETER (pShrink = -.25, pGrow = -.2)
|
|
||||||
! errCon = (4./safety)**(1/pGrow)
|
|
||||||
|
|
||||||
logical flag_dtSmall ! wenn dt kleiner als dtsmall ist und
|
|
||||||
! der Fehler immer noch zu gross ist.
|
|
||||||
|
|
||||||
logical found_lower_upp ! obere und untere Grenze fuer dt um
|
|
||||||
logical found_upper_upp ! Uebergabebereich zu treffen
|
|
||||||
logical found_lower_low ! obere und untere Grenze fuer dt um
|
|
||||||
logical found_upper_low ! Uebergabebereich zu treffen
|
|
||||||
real dtlower,dtupper
|
|
||||||
|
|
||||||
integer returnCode_EFeld
|
|
||||||
COMMON /returnCode_EFeld/ returnCode_EFeld
|
|
||||||
! 1: Testort hinter der Mappe
|
|
||||||
! 2: Testort neben der Mappe
|
|
||||||
! 3: Testort vor der Mappe
|
|
||||||
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
flag_dtSmall = .false. ! flag resetten
|
|
||||||
found_lower_upp = .false.
|
|
||||||
found_upper_upp = .false.
|
|
||||||
found_lower_low = .false.
|
|
||||||
found_upper_low = .false.
|
|
||||||
if (dt.lt.dtsmall) dt = dtsmall
|
|
||||||
|
|
||||||
c berechne EFeld am aktuellen Ort. Speichere in EFeld0, damit sie wiederverwendet
|
|
||||||
c werden kann, falls mit kuerzerem Zeitschritt wiederholt werden muss:
|
|
||||||
|
|
||||||
call EFeld_3(x,EFeld0,*998)
|
|
||||||
|
|
||||||
c...............................................................................
|
|
||||||
10 continue ! hier gehts wieder von vorne los, falls Zeitschritt dt
|
|
||||||
! abgeaendert werden muss.
|
|
||||||
|
|
||||||
dt_half = dt / 2.
|
|
||||||
|
|
||||||
|
|
||||||
c mache ersten dt/2 - Schritt:
|
|
||||||
|
|
||||||
call SINGLESTEP_RUNGE_KUTTA_3(dt_half,EFeld0,x,v, Dx1,Dv1 ,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c berechne EFeld bei x1:
|
|
||||||
|
|
||||||
x1(1) = x(1) + Dx1(1)
|
|
||||||
x1(2) = x(2) + Dx1(2)
|
|
||||||
x1(3) = x(3) + Dx1(3)
|
|
||||||
|
|
||||||
v1(1) = v(1) + Dv1(1)
|
|
||||||
v1(2) = v(2) + Dv1(2)
|
|
||||||
v1(3) = v(3) + Dv1(3)
|
|
||||||
|
|
||||||
call EFeld_3(x1,EFeld1,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c mache zweiten dt/2 - Schritt:
|
|
||||||
|
|
||||||
call SINGLESTEP_RUNGE_KUTTA_3(dt_half,EFeld1,x1,v1, Dx2,Dv2 ,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c Summiere Ergebnisse der beiden dt/2 -Schritte und speichere in Dx1, Dv1:
|
|
||||||
|
|
||||||
Dx1(1) = Dx1(1) + Dx2(1)
|
|
||||||
Dx1(2) = Dx1(2) + Dx2(2)
|
|
||||||
Dx1(3) = Dx1(3) + Dx2(3)
|
|
||||||
|
|
||||||
Dv1(1) = Dv1(1) + Dv2(1)
|
|
||||||
Dv1(2) = Dv1(2) + Dv2(2)
|
|
||||||
Dv1(3) = Dv1(3) + Dv2(3)
|
|
||||||
|
|
||||||
|
|
||||||
c mache dt - Schritt:
|
|
||||||
|
|
||||||
call SINGLESTEP_RUNGE_KUTTA_3(dt,EFeld0,x,v, Dx2,Dv2 ,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
c Fehlerbetrachtung und gegebenenfalls Berechnung von neuem Ort und neuer
|
|
||||||
c Geschwindigkeit (falls der Fehler ausserhalb der Toleranz liegt wird Zeit-
|
|
||||||
c schritt dt verkuerzt und bei Label 10 erneut begonnen):
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:RUNGE_KUTTA.INC'
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
|
|
||||||
c Stuetzstelle vor dem Mappenende liegt und die momentane Geschwindigkeit
|
|
||||||
c in positiver x-Richtung geht.
|
|
||||||
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
|
|
||||||
c ende (x=xmax) unter der Annahme eines konstanten mittleren EFeldes.
|
|
||||||
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
|
|
||||||
c Mappenende reflektiert werden koennte:
|
|
||||||
|
|
||||||
7766 continue
|
|
||||||
|
|
||||||
call EFeld_3(x,EFeld0,*997) ! Efeld am aktuellen Ort
|
|
||||||
|
|
||||||
! a == Beschleunigung bei x in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmax-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenende reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenende
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmax-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 1: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x1(1).NE.xmax) then
|
|
||||||
d write(*,*)' x1(1),x1(1)-xmax = ',x1(1),x1(1)-xmax
|
|
||||||
x1(1) = xmax
|
|
||||||
d endif
|
|
||||||
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
|
|
||||||
call EFeld_3(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
|
|
||||||
|
|
||||||
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
|
|
||||||
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
|
|
||||||
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
|
|
||||||
|
|
||||||
! wiederhole Berechnung mit mittlerem EFeld:
|
|
||||||
|
|
||||||
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmax-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenende reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenende
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmax-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 2: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
! Berechnen des neuen Ortes:
|
|
||||||
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x(1).NE.xmax) then
|
|
||||||
d write(*,*)' x(1),x(1)-xmax = ',x(1),x(1)-xmax
|
|
||||||
x(1) = xmax
|
|
||||||
d endif
|
|
||||||
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
! Berechnen der neuen Geschwindigkeit:
|
|
||||||
v(1) = v(1)+a*dt
|
|
||||||
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
|
|
||||||
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
|
|
||||||
! Berechnen der neuen Zeit:
|
|
||||||
t = t + dt
|
|
||||||
|
|
||||||
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
|
|
||||||
c Stuetzstelle hinter dem Mappenanfang liegt und die momentane Geschwindigkeit
|
|
||||||
c in negativer x-Richtung geht.
|
|
||||||
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
|
|
||||||
c anfang (x=xmin) unter der Annahme eines konstanten mittleren EFeldes.
|
|
||||||
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
|
|
||||||
c Mappenanfang reflektiert werden koennte:
|
|
||||||
|
|
||||||
7767 continue
|
|
||||||
|
|
||||||
call EFeld_3(x,EFeld0,*997) ! Efeld am aktuellen Ort
|
|
||||||
|
|
||||||
! a == Beschleunigung bei x in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmin-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenanfang
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (-sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmin-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 3: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x1(1).NE.xmin) then
|
|
||||||
d write(*,*)' x1(1),x1(1)-xmin = ',x1(1),x1(1)-xmin
|
|
||||||
x1(1) = xmin
|
|
||||||
d endif
|
|
||||||
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
|
|
||||||
call EFeld_3(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
|
|
||||||
|
|
||||||
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
|
|
||||||
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
|
|
||||||
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
|
|
||||||
|
|
||||||
! wiederhole Berechnung mit mittlerem EFeld:
|
|
||||||
|
|
||||||
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmin-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenanfang
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (-sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmin-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 4: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
! Berechnen des neuen Ortes:
|
|
||||||
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x(1).NE.xmin) then
|
|
||||||
d write(*,*)' x(1),x(1)-xmin = ',x(1),x(1)-xmin
|
|
||||||
x(1) = xmin
|
|
||||||
d endif
|
|
||||||
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
! Berechnen der neuen Geschwindigkeit:
|
|
||||||
v(1) = v(1)+a*dt
|
|
||||||
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
|
|
||||||
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
|
|
||||||
! Berechnen der neuen Zeit:
|
|
||||||
t = t + dt
|
|
||||||
|
|
||||||
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
|
|
||||||
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
|
|
||||||
|
|
||||||
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
|
|
||||||
|
|
||||||
998 if (returnCode_EFeld.EQ.1) then
|
|
||||||
write(*,*) 'Mappe '//Nr//':'
|
|
||||||
write(*,*)' aktueller Teilchenort (nicht Testort!) hinter Potentialmappe!'
|
|
||||||
write(*,*)' -> STOP'
|
|
||||||
write(*,*)
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
|
|
||||||
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
|
|
||||||
|
|
||||||
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
|
|
||||||
|
|
||||||
999 if (returnCode_EFeld.EQ.1) then
|
|
||||||
if (.NOT.found_upper_upp) dt_save = dt
|
|
||||||
dtupper = dt
|
|
||||||
found_upper_upp = .true.
|
|
||||||
if (.NOT.found_lower_upp) then
|
|
||||||
dt = 0.5*dt
|
|
||||||
else
|
|
||||||
dt = (dtlower+dtupper)/2.
|
|
||||||
endif
|
|
||||||
goto 10
|
|
||||||
elseif (returnCode_EFeld.EQ.2) then
|
|
||||||
destiny = code_neben_Mappe
|
|
||||||
elseif (returnCode_EFeld.EQ.3) then
|
|
||||||
if (.NOT.found_upper_low) dt_save = dt
|
|
||||||
dtupper = dt
|
|
||||||
found_upper_low = .true.
|
|
||||||
if (.NOT.found_lower_low) then
|
|
||||||
dt = 0.5*dt
|
|
||||||
else
|
|
||||||
dt = (dtlower+dtupper)/2.
|
|
||||||
endif
|
|
||||||
goto 10
|
|
||||||
elseif (returnCode_EFeld.NE.0) then
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
|
|
||||||
write(*,*) 'unallowed value of ''returnCode_EFeld'': ',returnCode_Efeld
|
|
||||||
write(*,*) '-> STOP'
|
|
||||||
write(*,*)
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c - Fehler trat auf im Zusammenhang von Berechnungen des Schnittpunktes der
|
|
||||||
c Trajektorie mit einer Mappenbegrenzung:
|
|
||||||
|
|
||||||
997 if (returnCode_EFeld.EQ.2) then
|
|
||||||
destiny = code_neben_Mappe
|
|
||||||
else
|
|
||||||
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
|
|
||||||
write(*,*) 'alternate Return from EFELD_'//Nr//' while calculating intersection'
|
|
||||||
write(*,*) 'of trajectory and x equals xmax line.'
|
|
||||||
write(*,*)
|
|
||||||
write(*,*)' returnCode_EFeld = ',returnCode_EFeld
|
|
||||||
write(*,*)' t = ',t
|
|
||||||
write(*,*)' x0 = ',x0
|
|
||||||
write(*,*)' v0 = ',v0
|
|
||||||
write(*,*)' E0 = ',E0
|
|
||||||
write(*,*)' theta0 = ',theta0
|
|
||||||
write(*,*)' phi0 = ',phi0
|
|
||||||
write(*,*)' x = ',x
|
|
||||||
write(*,*)' v = ',v
|
|
||||||
write(*,*)' Teilchen-Nr = ',Start_Nr
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) '-> STOP'
|
|
||||||
write(*,*)
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE SINGLESTEP_RUNGE_KUTTA_3(dt,E0,x0,v0, Dx,Dv, *)
|
|
||||||
c ==========================================================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
c Diese Subroutine berechnet bei vorgegebenem Zeitschritt einen einzelnen
|
|
||||||
c Runge-Kutta-Integrationsschritt (4. Ordnung).
|
|
||||||
c Die Vorgehensweise entspricht den Ausfuehrungen in Kapitel 15.1 der
|
|
||||||
c NUMERICAL RECIPIES: 'Runge-Kutta Method'.
|
|
||||||
|
|
||||||
c Zurueckgegeben werden die errechneten Orts- und Geschwindigkeitsaenderungen
|
|
||||||
c anstatt direkt der neuen Werte, da sonst vor allem bei den Ortskoordinaten
|
|
||||||
c Schwierigkeiten auftreten koennen, wenn in der Subroutine 'INTEGRATIONSSTEP_
|
|
||||||
c RUNGE_KUTTA' aus der Differenz der neuen Werte aus den beiden dt/2- und dem
|
|
||||||
c dt-Schritt der Fehler abgeschaetzt werden soll (kleine Differenz moeglicher-
|
|
||||||
c weise grosser Werte).
|
|
||||||
|
|
||||||
|
|
||||||
real Beschl_Faktor
|
|
||||||
COMMON /Beschl_Faktor/ Beschl_Faktor
|
|
||||||
|
|
||||||
real E0(3), x0(3), v0(3) ! Eingangsgroessen
|
|
||||||
real E1(3), E2(3), E3(3) ! E-Felder an Testorten
|
|
||||||
real v1(3), v2(3), v3(3) ! Geschwindigkeiten an Testorten
|
|
||||||
real dt,dt_half,dt_sixth ! zeitl. Aenderung, dt/2, dt/6
|
|
||||||
real help, help_half, help_sixth ! Hilfsvariable, help/2, help/6
|
|
||||||
real xTest(3) ! Test-Orte
|
|
||||||
real Dx(3), Dv(3) ! Ergebnisspeicher
|
|
||||||
|
|
||||||
integer i ! Zaehlvariable
|
|
||||||
|
|
||||||
c = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|
||||||
|
|
||||||
dt_half = dt / 2.
|
|
||||||
dt_sixth = dt / 6.
|
|
||||||
help = Beschl_Faktor * dt
|
|
||||||
help_half = help / 2.
|
|
||||||
help_sixth = help / 6.
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xTest(i) = x0(i) + v0(i) * dt_half
|
|
||||||
v1(i) = v0(i) + E0(i) * help_half
|
|
||||||
enddo
|
|
||||||
call EFeld_3(xTest,E1,*999)
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xTest(i) = x0(i) + v1(i) * dt_half
|
|
||||||
v2(i) = v0(i) + E1(i) * help_half
|
|
||||||
enddo
|
|
||||||
call EFeld_3(xTest,E2,*999)
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xTest(i) = x0(i) + v2(i) * dt
|
|
||||||
v3(i) = v0(i) + E2(i) * help
|
|
||||||
enddo
|
|
||||||
call EFeld_3(xTest,E3,*999)
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
Dx(i) = (v0(i) + 2.*(v1(i)+v2(i)) + v3(i)) * dt_sixth
|
|
||||||
Dv(i) = (E0(i) + 2.*(E1(i)+E2(i)) + E3(i)) * help_sixth
|
|
||||||
enddo
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
999 RETURN 1
|
|
||||||
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE EFeld_3(x,E,*)
|
|
||||||
c =========================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_3.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:CALC_FIELD_1.INC'
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
c Rechne in Gittereinheiten um:
|
|
||||||
|
|
||||||
real_i = (x(1)-xmin) / Dx_
|
|
||||||
real_j = abs(x(2)) / Dy_
|
|
||||||
real_k = abs(x(3)) / Dz_
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
c Mache die Tests und berechne die Feldstaerke:
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:CALC_FIELD_2.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
@ -1,553 +0,0 @@
|
|||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE READ_INFO_4
|
|
||||||
c ======================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='4')
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_4.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:READ_INFO.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE READ_MAP_4
|
|
||||||
c =====================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='4')
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_4.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:READ_MAP.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE ADD_MAP_4
|
|
||||||
c ====================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='4')
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_4.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:ADD_MAP.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_4(dt)
|
|
||||||
c =============================================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
SAVE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='4')
|
|
||||||
|
|
||||||
c Diese Subroutine berechnet zu einem vorgegebenen Zeitschritt dt den
|
|
||||||
c Integrationsschritt zweimal: einmal direkt mit dt und einmal ueber zwei
|
|
||||||
c aufeinanderfolgende Schritte mit dt/2. (die beiden dt/2-Schritte werden
|
|
||||||
c zuerst ausgefuehrt).
|
|
||||||
c
|
|
||||||
c Aus der Differenz der beiden Resultate wird eine Abschaetzung fuer den Fehler
|
|
||||||
c des dt-Schrittes gewonnen, die dazu verwendet wird zu entscheiden, ob der
|
|
||||||
c Integrationsschritt mit einem verkuerzten Zeitintervall wiederholt werden
|
|
||||||
c muss, oder ob das Zeitintervall fuer den folgenden ausgedehnt werden kann.
|
|
||||||
c
|
|
||||||
c Die beiden Einzelergebnisse aus dem dt- und den beiden dt/2-Schritten, die
|
|
||||||
c jeweils ueber Runge-Kutta-Rechnung vierter Ordnung erhalten werden, werden
|
|
||||||
c zum Schluss noch zusammengenommen, um ein Resultat mit Genauigkeit fuenfter
|
|
||||||
c Ordnung in dt zu erhalten.
|
|
||||||
c
|
|
||||||
c Der ganze Ablauf entspricht den Ausfuehrungen in Kapitel 15.2 der NUMERICAL
|
|
||||||
c RECIPIES: 'Adaptive Stepsize Control for Runge-Kutta' (vgl. Referenz im
|
|
||||||
c fileheader von 'ACCEL.FOR')
|
|
||||||
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_4.INC'
|
|
||||||
|
|
||||||
real help
|
|
||||||
real dt_save
|
|
||||||
|
|
||||||
integer i ! Zaehlvariable
|
|
||||||
|
|
||||||
real dt,dt_half ! zeitl. Aenderung, halbe zeitl. Aenderung
|
|
||||||
real EFeld0(3), EFeld1(3) ! elektr. Felder
|
|
||||||
real x1(3),Dx1(3),Dx2(3) ! fuer Ortsintegration
|
|
||||||
real v1(3),Dv1(3),Dv2(3) ! fuer Geschw.Integration
|
|
||||||
real xDifferenz(3), vDifferenz(3)
|
|
||||||
real x_1 ! Hilfsvariable fuer testweises x(1)
|
|
||||||
real a ! Beschleunigung
|
|
||||||
|
|
||||||
real maxErr_x,maxErr_v,maxErr ! fuer Fehlerbetrachtung
|
|
||||||
|
|
||||||
real errCon, safety ! fuer Schrittweitenkontrolle
|
|
||||||
real pShrink, pGrow ! fuer Schrittweitenkontrolle
|
|
||||||
|
|
||||||
PARAMETER (errCon = 6.e-4, safety = .9) ! vgl. Referenz
|
|
||||||
PARAMETER (pShrink = -.25, pGrow = -.2)
|
|
||||||
! errCon = (4./safety)**(1/pGrow)
|
|
||||||
|
|
||||||
logical flag_dtSmall ! wenn dt kleiner als dtsmall ist und
|
|
||||||
! der Fehler immer noch zu gross ist.
|
|
||||||
|
|
||||||
logical found_lower_upp ! obere und untere Grenze fuer dt um
|
|
||||||
logical found_upper_upp ! Uebergabebereich zu treffen
|
|
||||||
logical found_lower_low ! obere und untere Grenze fuer dt um
|
|
||||||
logical found_upper_low ! Uebergabebereich zu treffen
|
|
||||||
real dtlower,dtupper
|
|
||||||
|
|
||||||
integer returnCode_EFeld
|
|
||||||
COMMON /returnCode_EFeld/ returnCode_EFeld
|
|
||||||
! 1: Testort hinter der Mappe
|
|
||||||
! 2: Testort neben der Mappe
|
|
||||||
! 3: Testort vor der Mappe
|
|
||||||
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
flag_dtSmall = .false. ! flag resetten
|
|
||||||
found_lower_upp = .false.
|
|
||||||
found_upper_upp = .false.
|
|
||||||
found_lower_low = .false.
|
|
||||||
found_upper_low = .false.
|
|
||||||
if (dt.lt.dtsmall) dt = dtsmall
|
|
||||||
|
|
||||||
c berechne EFeld am aktuellen Ort. Speichere in EFeld0, damit sie wiederverwendet
|
|
||||||
c werden kann, falls mit kuerzerem Zeitschritt wiederholt werden muss:
|
|
||||||
|
|
||||||
call EFeld_4(x,EFeld0,*998)
|
|
||||||
|
|
||||||
c...............................................................................
|
|
||||||
10 continue ! hier gehts wieder von vorne los, falls Zeitschritt dt
|
|
||||||
! abgeaendert werden muss.
|
|
||||||
|
|
||||||
dt_half = dt / 2.
|
|
||||||
|
|
||||||
|
|
||||||
c mache ersten dt/2 - Schritt:
|
|
||||||
|
|
||||||
call SINGLESTEP_RUNGE_KUTTA_4(dt_half,EFeld0,x,v, Dx1,Dv1 ,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c berechne EFeld bei x1:
|
|
||||||
|
|
||||||
x1(1) = x(1) + Dx1(1)
|
|
||||||
x1(2) = x(2) + Dx1(2)
|
|
||||||
x1(3) = x(3) + Dx1(3)
|
|
||||||
|
|
||||||
v1(1) = v(1) + Dv1(1)
|
|
||||||
v1(2) = v(2) + Dv1(2)
|
|
||||||
v1(3) = v(3) + Dv1(3)
|
|
||||||
|
|
||||||
call EFeld_4(x1,EFeld1,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c mache zweiten dt/2 - Schritt:
|
|
||||||
|
|
||||||
call SINGLESTEP_RUNGE_KUTTA_4(dt_half,EFeld1,x1,v1, Dx2,Dv2 ,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c Summiere Ergebnisse der beiden dt/2 -Schritte und speichere in Dx1, Dv1:
|
|
||||||
|
|
||||||
Dx1(1) = Dx1(1) + Dx2(1)
|
|
||||||
Dx1(2) = Dx1(2) + Dx2(2)
|
|
||||||
Dx1(3) = Dx1(3) + Dx2(3)
|
|
||||||
|
|
||||||
Dv1(1) = Dv1(1) + Dv2(1)
|
|
||||||
Dv1(2) = Dv1(2) + Dv2(2)
|
|
||||||
Dv1(3) = Dv1(3) + Dv2(3)
|
|
||||||
|
|
||||||
|
|
||||||
c mache dt - Schritt:
|
|
||||||
|
|
||||||
call SINGLESTEP_RUNGE_KUTTA_4(dt,EFeld0,x,v, Dx2,Dv2 ,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
c Fehlerbetrachtung und gegebenenfalls Berechnung von neuem Ort und neuer
|
|
||||||
c Geschwindigkeit (falls der Fehler ausserhalb der Toleranz liegt wird Zeit-
|
|
||||||
c schritt dt verkuerzt und bei Label 10 erneut begonnen):
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:RUNGE_KUTTA.INC'
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
|
|
||||||
c Stuetzstelle vor dem Mappenende liegt und die momentane Geschwindigkeit
|
|
||||||
c in positiver x-Richtung geht.
|
|
||||||
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
|
|
||||||
c ende (x=xmax) unter der Annahme eines konstanten mittleren EFeldes.
|
|
||||||
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
|
|
||||||
c Mappenende reflektiert werden koennte:
|
|
||||||
|
|
||||||
7766 continue
|
|
||||||
|
|
||||||
call EFeld_4(x,EFeld0,*997) ! Efeld am aktuellen Ort
|
|
||||||
|
|
||||||
! a == Beschleunigung bei x in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmax-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenende reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenende
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmax-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 1: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x1(1).NE.xmax) then
|
|
||||||
d write(*,*)' x1(1),x1(1)-xmax = ',x1(1),x1(1)-xmax
|
|
||||||
x1(1) = xmax
|
|
||||||
d endif
|
|
||||||
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
|
|
||||||
call EFeld_4(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
|
|
||||||
|
|
||||||
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
|
|
||||||
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
|
|
||||||
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
|
|
||||||
|
|
||||||
! wiederhole Berechnung mit mittlerem EFeld:
|
|
||||||
|
|
||||||
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmax-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenende reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenende
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmax-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 2: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
! Berechnen des neuen Ortes:
|
|
||||||
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x(1).NE.xmax) then
|
|
||||||
d write(*,*)' x(1),x(1)-xmax = ',x(1),x(1)-xmax
|
|
||||||
x(1) = xmax
|
|
||||||
d endif
|
|
||||||
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
! Berechnen der neuen Geschwindigkeit:
|
|
||||||
v(1) = v(1)+a*dt
|
|
||||||
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
|
|
||||||
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
|
|
||||||
! Berechnen der neuen Zeit:
|
|
||||||
t = t + dt
|
|
||||||
|
|
||||||
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
|
|
||||||
c Stuetzstelle hinter dem Mappenanfang liegt und die momentane Geschwindigkeit
|
|
||||||
c in negativer x-Richtung geht.
|
|
||||||
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
|
|
||||||
c anfang (x=xmin) unter der Annahme eines konstanten mittleren EFeldes.
|
|
||||||
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
|
|
||||||
c Mappenanfang reflektiert werden koennte:
|
|
||||||
|
|
||||||
7767 continue
|
|
||||||
|
|
||||||
call EFeld_4(x,EFeld0,*997) ! Efeld am aktuellen Ort
|
|
||||||
|
|
||||||
! a == Beschleunigung bei x in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmin-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenanfang
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (-sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmin-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 3: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x1(1).NE.xmin) then
|
|
||||||
d write(*,*)' x1(1),x1(1)-xmin = ',x1(1),x1(1)-xmin
|
|
||||||
x1(1) = xmin
|
|
||||||
d endif
|
|
||||||
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
|
|
||||||
call EFeld_4(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
|
|
||||||
|
|
||||||
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
|
|
||||||
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
|
|
||||||
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
|
|
||||||
|
|
||||||
! wiederhole Berechnung mit mittlerem EFeld:
|
|
||||||
|
|
||||||
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmin-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenanfang
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (-sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmin-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 4: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
! Berechnen des neuen Ortes:
|
|
||||||
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x(1).NE.xmin) then
|
|
||||||
d write(*,*)' x(1),x(1)-xmin = ',x(1),x(1)-xmin
|
|
||||||
x(1) = xmin
|
|
||||||
d endif
|
|
||||||
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
! Berechnen der neuen Geschwindigkeit:
|
|
||||||
v(1) = v(1)+a*dt
|
|
||||||
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
|
|
||||||
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
|
|
||||||
! Berechnen der neuen Zeit:
|
|
||||||
t = t + dt
|
|
||||||
|
|
||||||
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
|
|
||||||
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
|
|
||||||
|
|
||||||
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
|
|
||||||
|
|
||||||
998 if (returnCode_EFeld.EQ.1) then
|
|
||||||
write(*,*) 'Mappe '//Nr//':'
|
|
||||||
write(*,*)' aktueller Teilchenort (nicht Testort!) hinter Potentialmappe!'
|
|
||||||
write(*,*)' -> STOP'
|
|
||||||
write(*,*)
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
|
|
||||||
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
|
|
||||||
|
|
||||||
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
|
|
||||||
|
|
||||||
999 if (returnCode_EFeld.EQ.1) then
|
|
||||||
if (.NOT.found_upper_upp) dt_save = dt
|
|
||||||
dtupper = dt
|
|
||||||
found_upper_upp = .true.
|
|
||||||
if (.NOT.found_lower_upp) then
|
|
||||||
dt = 0.5*dt
|
|
||||||
else
|
|
||||||
dt = (dtlower+dtupper)/2.
|
|
||||||
endif
|
|
||||||
goto 10
|
|
||||||
elseif (returnCode_EFeld.EQ.2) then
|
|
||||||
destiny = code_neben_Mappe
|
|
||||||
elseif (returnCode_EFeld.EQ.3) then
|
|
||||||
if (.NOT.found_upper_low) dt_save = dt
|
|
||||||
dtupper = dt
|
|
||||||
found_upper_low = .true.
|
|
||||||
if (.NOT.found_lower_low) then
|
|
||||||
dt = 0.5*dt
|
|
||||||
else
|
|
||||||
dt = (dtlower+dtupper)/2.
|
|
||||||
endif
|
|
||||||
goto 10
|
|
||||||
elseif (returnCode_EFeld.NE.0) then
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
|
|
||||||
write(*,*) 'unallowed value of ''returnCode_EFeld'': ',returnCode_Efeld
|
|
||||||
write(*,*) '-> STOP'
|
|
||||||
write(*,*)
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c - Fehler trat auf im Zusammenhang von Berechnungen des Schnittpunktes der
|
|
||||||
c Trajektorie mit einer Mappenbegrenzung:
|
|
||||||
|
|
||||||
997 if (returnCode_EFeld.EQ.2) then
|
|
||||||
destiny = code_neben_Mappe
|
|
||||||
else
|
|
||||||
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
|
|
||||||
write(*,*) 'alternate Return from EFELD_'//Nr//' while calculating intersection'
|
|
||||||
write(*,*) 'of trajectory and x equals xmax line.'
|
|
||||||
write(*,*)
|
|
||||||
write(*,*)' returnCode_EFeld = ',returnCode_EFeld
|
|
||||||
write(*,*)' t = ',t
|
|
||||||
write(*,*)' x0 = ',x0
|
|
||||||
write(*,*)' v0 = ',v0
|
|
||||||
write(*,*)' E0 = ',E0
|
|
||||||
write(*,*)' theta0 = ',theta0
|
|
||||||
write(*,*)' phi0 = ',phi0
|
|
||||||
write(*,*)' x = ',x
|
|
||||||
write(*,*)' v = ',v
|
|
||||||
write(*,*)' Teilchen-Nr = ',Start_Nr
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) '-> STOP'
|
|
||||||
write(*,*)
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE SINGLESTEP_RUNGE_KUTTA_4(dt,E0,x0,v0, Dx,Dv, *)
|
|
||||||
c ==========================================================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
c Diese Subroutine berechnet bei vorgegebenem Zeitschritt einen einzelnen
|
|
||||||
c Runge-Kutta-Integrationsschritt (4. Ordnung).
|
|
||||||
c Die Vorgehensweise entspricht den Ausfuehrungen in Kapitel 15.1 der
|
|
||||||
c NUMERICAL RECIPIES: 'Runge-Kutta Method'.
|
|
||||||
|
|
||||||
c Zurueckgegeben werden die errechneten Orts- und Geschwindigkeitsaenderungen
|
|
||||||
c anstatt direkt der neuen Werte, da sonst vor allem bei den Ortskoordinaten
|
|
||||||
c Schwierigkeiten auftreten koennen, wenn in der Subroutine 'INTEGRATIONSSTEP_
|
|
||||||
c RUNGE_KUTTA' aus der Differenz der neuen Werte aus den beiden dt/2- und dem
|
|
||||||
c dt-Schritt der Fehler abgeschaetzt werden soll (kleine Differenz moeglicher-
|
|
||||||
c weise grosser Werte).
|
|
||||||
|
|
||||||
|
|
||||||
real Beschl_Faktor
|
|
||||||
COMMON /Beschl_Faktor/ Beschl_Faktor
|
|
||||||
|
|
||||||
real E0(3), x0(3), v0(3) ! Eingangsgroessen
|
|
||||||
real E1(3), E2(3), E3(3) ! E-Felder an Testorten
|
|
||||||
real v1(3), v2(3), v3(3) ! Geschwindigkeiten an Testorten
|
|
||||||
real dt,dt_half,dt_sixth ! zeitl. Aenderung, dt/2, dt/6
|
|
||||||
real help, help_half, help_sixth ! Hilfsvariable, help/2, help/6
|
|
||||||
real xTest(3) ! Test-Orte
|
|
||||||
real Dx(3), Dv(3) ! Ergebnisspeicher
|
|
||||||
|
|
||||||
integer i ! Zaehlvariable
|
|
||||||
|
|
||||||
c = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|
||||||
|
|
||||||
dt_half = dt / 2.
|
|
||||||
dt_sixth = dt / 6.
|
|
||||||
help = Beschl_Faktor * dt
|
|
||||||
help_half = help / 2.
|
|
||||||
help_sixth = help / 6.
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xTest(i) = x0(i) + v0(i) * dt_half
|
|
||||||
v1(i) = v0(i) + E0(i) * help_half
|
|
||||||
enddo
|
|
||||||
call EFeld_4(xTest,E1,*999)
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xTest(i) = x0(i) + v1(i) * dt_half
|
|
||||||
v2(i) = v0(i) + E1(i) * help_half
|
|
||||||
enddo
|
|
||||||
call EFeld_4(xTest,E2,*999)
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xTest(i) = x0(i) + v2(i) * dt
|
|
||||||
v3(i) = v0(i) + E2(i) * help
|
|
||||||
enddo
|
|
||||||
call EFeld_4(xTest,E3,*999)
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
Dx(i) = (v0(i) + 2.*(v1(i)+v2(i)) + v3(i)) * dt_sixth
|
|
||||||
Dv(i) = (E0(i) + 2.*(E1(i)+E2(i)) + E3(i)) * help_sixth
|
|
||||||
enddo
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
999 RETURN 1
|
|
||||||
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE EFeld_4(x,E,*)
|
|
||||||
c =========================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_4.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:CALC_FIELD_1.INC'
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
c Rechne in Gittereinheiten um:
|
|
||||||
|
|
||||||
real_i = (x(1)-xmin) / Dx_
|
|
||||||
real_j = abs(x(2)) / Dy_
|
|
||||||
real_k = abs(x(3)) / Dz_
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
c Mache die Tests und berechne die Feldstaerke:
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:CALC_FIELD_2.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
@ -1,553 +0,0 @@
|
|||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE READ_INFO_5
|
|
||||||
c ======================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='5')
|
|
||||||
|
|
||||||
INCLUDE 'accel$SOURCEdirectory:MAP_DEF_5.INC'
|
|
||||||
INCLUDE 'accel$SOURCEdirectory:READ_INFO.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE READ_MAP_5
|
|
||||||
c =====================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='5')
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_5.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:READ_MAP.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE ADD_MAP_5
|
|
||||||
c ====================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='5')
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_5.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:ADD_MAP.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE INTEGRATIONSSTEP_RUNGE_KUTTA_5(dt)
|
|
||||||
c =============================================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
SAVE
|
|
||||||
|
|
||||||
character*1 Nr
|
|
||||||
parameter (Nr='5')
|
|
||||||
|
|
||||||
c Diese Subroutine berechnet zu einem vorgegebenen Zeitschritt dt den
|
|
||||||
c Integrationsschritt zweimal: einmal direkt mit dt und einmal ueber zwei
|
|
||||||
c aufeinanderfolgende Schritte mit dt/2. (die beiden dt/2-Schritte werden
|
|
||||||
c zuerst ausgefuehrt).
|
|
||||||
c
|
|
||||||
c Aus der Differenz der beiden Resultate wird eine Abschaetzung fuer den Fehler
|
|
||||||
c des dt-Schrittes gewonnen, die dazu verwendet wird zu entscheiden, ob der
|
|
||||||
c Integrationsschritt mit einem verkuerzten Zeitintervall wiederholt werden
|
|
||||||
c muss, oder ob das Zeitintervall fuer den folgenden ausgedehnt werden kann.
|
|
||||||
c
|
|
||||||
c Die beiden Einzelergebnisse aus dem dt- und den beiden dt/2-Schritten, die
|
|
||||||
c jeweils ueber Runge-Kutta-Rechnung vierter Ordnung erhalten werden, werden
|
|
||||||
c zum Schluss noch zusammengenommen, um ein Resultat mit Genauigkeit fuenfter
|
|
||||||
c Ordnung in dt zu erhalten.
|
|
||||||
c
|
|
||||||
c Der ganze Ablauf entspricht den Ausfuehrungen in Kapitel 15.2 der NUMERICAL
|
|
||||||
c RECIPIES: 'Adaptive Stepsize Control for Runge-Kutta' (vgl. Referenz im
|
|
||||||
c fileheader von 'ACCEL.FOR')
|
|
||||||
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_ACCEL.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_5.INC'
|
|
||||||
|
|
||||||
real help
|
|
||||||
real dt_save
|
|
||||||
|
|
||||||
integer i ! Zaehlvariable
|
|
||||||
|
|
||||||
real dt,dt_half ! zeitl. Aenderung, halbe zeitl. Aenderung
|
|
||||||
real EFeld0(3), EFeld1(3) ! elektr. Felder
|
|
||||||
real x1(3),Dx1(3),Dx2(3) ! fuer Ortsintegration
|
|
||||||
real v1(3),Dv1(3),Dv2(3) ! fuer Geschw.Integration
|
|
||||||
real xDifferenz(3), vDifferenz(3)
|
|
||||||
real x_1 ! Hilfsvariable fuer testweises x(1)
|
|
||||||
real a ! Beschleunigung
|
|
||||||
|
|
||||||
real maxErr_x,maxErr_v,maxErr ! fuer Fehlerbetrachtung
|
|
||||||
|
|
||||||
real errCon, safety ! fuer Schrittweitenkontrolle
|
|
||||||
real pShrink, pGrow ! fuer Schrittweitenkontrolle
|
|
||||||
|
|
||||||
PARAMETER (errCon = 6.e-4, safety = .9) ! vgl. Referenz
|
|
||||||
PARAMETER (pShrink = -.25, pGrow = -.2)
|
|
||||||
! errCon = (4./safety)**(1/pGrow)
|
|
||||||
|
|
||||||
logical flag_dtSmall ! wenn dt kleiner als dtsmall ist und
|
|
||||||
! der Fehler immer noch zu gross ist.
|
|
||||||
|
|
||||||
logical found_lower_upp ! obere und untere Grenze fuer dt um
|
|
||||||
logical found_upper_upp ! Uebergabebereich zu treffen
|
|
||||||
logical found_lower_low ! obere und untere Grenze fuer dt um
|
|
||||||
logical found_upper_low ! Uebergabebereich zu treffen
|
|
||||||
real dtlower,dtupper
|
|
||||||
|
|
||||||
integer returnCode_EFeld
|
|
||||||
COMMON /returnCode_EFeld/ returnCode_EFeld
|
|
||||||
! 1: Testort hinter der Mappe
|
|
||||||
! 2: Testort neben der Mappe
|
|
||||||
! 3: Testort vor der Mappe
|
|
||||||
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
flag_dtSmall = .false. ! flag resetten
|
|
||||||
found_lower_upp = .false.
|
|
||||||
found_upper_upp = .false.
|
|
||||||
found_lower_low = .false.
|
|
||||||
found_upper_low = .false.
|
|
||||||
if (dt.lt.dtsmall) dt = dtsmall
|
|
||||||
|
|
||||||
c berechne EFeld am aktuellen Ort. Speichere in EFeld0, damit sie wiederverwendet
|
|
||||||
c werden kann, falls mit kuerzerem Zeitschritt wiederholt werden muss:
|
|
||||||
|
|
||||||
call EFeld_5(x,EFeld0,*998)
|
|
||||||
|
|
||||||
c...............................................................................
|
|
||||||
10 continue ! hier gehts wieder von vorne los, falls Zeitschritt dt
|
|
||||||
! abgeaendert werden muss.
|
|
||||||
|
|
||||||
dt_half = dt / 2.
|
|
||||||
|
|
||||||
|
|
||||||
c mache ersten dt/2 - Schritt:
|
|
||||||
|
|
||||||
call SINGLESTEP_RUNGE_KUTTA_5(dt_half,EFeld0,x,v, Dx1,Dv1 ,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c berechne EFeld bei x1:
|
|
||||||
|
|
||||||
x1(1) = x(1) + Dx1(1)
|
|
||||||
x1(2) = x(2) + Dx1(2)
|
|
||||||
x1(3) = x(3) + Dx1(3)
|
|
||||||
|
|
||||||
v1(1) = v(1) + Dv1(1)
|
|
||||||
v1(2) = v(2) + Dv1(2)
|
|
||||||
v1(3) = v(3) + Dv1(3)
|
|
||||||
|
|
||||||
call EFeld_5(x1,EFeld1,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c mache zweiten dt/2 - Schritt:
|
|
||||||
|
|
||||||
call SINGLESTEP_RUNGE_KUTTA_5(dt_half,EFeld1,x1,v1, Dx2,Dv2 ,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c Summiere Ergebnisse der beiden dt/2 -Schritte und speichere in Dx1, Dv1:
|
|
||||||
|
|
||||||
Dx1(1) = Dx1(1) + Dx2(1)
|
|
||||||
Dx1(2) = Dx1(2) + Dx2(2)
|
|
||||||
Dx1(3) = Dx1(3) + Dx2(3)
|
|
||||||
|
|
||||||
Dv1(1) = Dv1(1) + Dv2(1)
|
|
||||||
Dv1(2) = Dv1(2) + Dv2(2)
|
|
||||||
Dv1(3) = Dv1(3) + Dv2(3)
|
|
||||||
|
|
||||||
|
|
||||||
c mache dt - Schritt:
|
|
||||||
|
|
||||||
call SINGLESTEP_RUNGE_KUTTA_5(dt,EFeld0,x,v, Dx2,Dv2 ,*999)
|
|
||||||
|
|
||||||
|
|
||||||
c . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
|
|
||||||
|
|
||||||
c Fehlerbetrachtung und gegebenenfalls Berechnung von neuem Ort und neuer
|
|
||||||
c Geschwindigkeit (falls der Fehler ausserhalb der Toleranz liegt wird Zeit-
|
|
||||||
c schritt dt verkuerzt und bei Label 10 erneut begonnen):
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:RUNGE_KUTTA.INC'
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
|
|
||||||
c Stuetzstelle vor dem Mappenende liegt und die momentane Geschwindigkeit
|
|
||||||
c in positiver x-Richtung geht.
|
|
||||||
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
|
|
||||||
c ende (x=xmax) unter der Annahme eines konstanten mittleren EFeldes.
|
|
||||||
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
|
|
||||||
c Mappenende reflektiert werden koennte:
|
|
||||||
|
|
||||||
7766 continue
|
|
||||||
|
|
||||||
call EFeld_5(x,EFeld0,*997) ! Efeld am aktuellen Ort
|
|
||||||
|
|
||||||
! a == Beschleunigung bei x in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmax-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenende reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenende
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmax-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 1: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x1(1).NE.xmax) then
|
|
||||||
d write(*,*)' x1(1),x1(1)-xmax = ',x1(1),x1(1)-xmax
|
|
||||||
x1(1) = xmax
|
|
||||||
d endif
|
|
||||||
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
|
|
||||||
call EFeld_5(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
|
|
||||||
|
|
||||||
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
|
|
||||||
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
|
|
||||||
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
|
|
||||||
|
|
||||||
! wiederhole Berechnung mit mittlerem EFeld:
|
|
||||||
|
|
||||||
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmax-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenende reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenende
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmax-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 2: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
! Berechnen des neuen Ortes:
|
|
||||||
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x(1).NE.xmax) then
|
|
||||||
d write(*,*)' x(1),x(1)-xmax = ',x(1),x(1)-xmax
|
|
||||||
x(1) = xmax
|
|
||||||
d endif
|
|
||||||
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
! Berechnen der neuen Geschwindigkeit:
|
|
||||||
v(1) = v(1)+a*dt
|
|
||||||
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
|
|
||||||
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
|
|
||||||
! Berechnen der neuen Zeit:
|
|
||||||
t = t + dt
|
|
||||||
|
|
||||||
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c Einsprungposition fuer den Fall, dass x(1) jetzt im Bereich einer halben
|
|
||||||
c Stuetzstelle hinter dem Mappenanfang liegt und die momentane Geschwindigkeit
|
|
||||||
c in negativer x-Richtung geht.
|
|
||||||
c -> Berechne naeherungsweise den Schnittpunkt der Trajektorie mit dem Mappen-
|
|
||||||
c anfang (x=xmin) unter der Annahme eines konstanten mittleren EFeldes.
|
|
||||||
c Beruecksichtige dabei die Moeglichkeit, dass das Teilchen noch vor dem
|
|
||||||
c Mappenanfang reflektiert werden koennte:
|
|
||||||
|
|
||||||
7767 continue
|
|
||||||
|
|
||||||
call EFeld_5(x,EFeld0,*997) ! Efeld am aktuellen Ort
|
|
||||||
|
|
||||||
! a == Beschleunigung bei x in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmin-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenanfang
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (-sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmin-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 3: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
d x1(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x1(1).NE.xmin) then
|
|
||||||
d write(*,*)' x1(1),x1(1)-xmin = ',x1(1),x1(1)-xmin
|
|
||||||
x1(1) = xmin
|
|
||||||
d endif
|
|
||||||
x1(2) = x(2)+v(2)*dt+.5*Efeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x1(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
|
|
||||||
call EFeld_5(x1,EFeld1,*997) ! Efeld am naeherungsweisen Schnittpunkt
|
|
||||||
|
|
||||||
EFeld0(1) = (EFeld0(1)+EFeld1(1))/2. ! Mittelwert berechnen
|
|
||||||
EFeld0(2) = (EFeld0(2)+EFeld1(2))/2.
|
|
||||||
EFeld0(3) = (EFeld0(3)+EFeld1(3))/2.
|
|
||||||
|
|
||||||
! wiederhole Berechnung mit mittlerem EFeld:
|
|
||||||
|
|
||||||
! a == Beschleunigung mit mittlerem EFeld in x-Richtung
|
|
||||||
a = EFeld0(1)*Beschl_Faktor
|
|
||||||
! help == Radiant in entsprechender 'Mitternachtsformel'
|
|
||||||
help = v(1)*v(1) + 2.*a*(xmin-x(1))
|
|
||||||
if (help.LT.0) then ! noch vor Mappenanfang reflektiert
|
|
||||||
reachedEndOfMap = .false.
|
|
||||||
dt = dt_save ! dt restaurieren
|
|
||||||
goto 3454 ! Festlegen des neuen dt, RETURN
|
|
||||||
else
|
|
||||||
! dt == Zeit bis Mappenanfang
|
|
||||||
if (a.NE.0) then
|
|
||||||
dt = (-sqrt(help) - v(1))/a
|
|
||||||
else
|
|
||||||
dt = (xmin-x(1))/v(1)
|
|
||||||
endif
|
|
||||||
if (dt.lt.0) write(*,*) 'warning 4: dt<0: dt = ',dt
|
|
||||||
endif
|
|
||||||
! Berechnen des neuen Ortes:
|
|
||||||
d x(1) = x(1)+v(1)*dt+.5*a*dt*dt
|
|
||||||
d if (x(1).NE.xmin) then
|
|
||||||
d write(*,*)' x(1),x(1)-xmin = ',x(1),x(1)-xmin
|
|
||||||
x(1) = xmin
|
|
||||||
d endif
|
|
||||||
x(2) = x(2)+v(2)*dt+.5*EFeld0(2)*Beschl_Faktor*dt*dt
|
|
||||||
x(3) = x(3)+v(3)*dt+.5*Efeld0(3)*Beschl_Faktor*dt*dt
|
|
||||||
! Berechnen der neuen Geschwindigkeit:
|
|
||||||
v(1) = v(1)+a*dt
|
|
||||||
v(2) = v(2)+Efeld0(2)*Beschl_Faktor*dt
|
|
||||||
v(3) = v(3)+Efeld0(3)*Beschl_Faktor*dt
|
|
||||||
! Berechnen der neuen Zeit:
|
|
||||||
t = t + dt
|
|
||||||
|
|
||||||
dt = dt_save ! Zeitschritt fuer Start in neue Mappe restaurieren
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
|
|
||||||
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
|
|
||||||
|
|
||||||
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
|
|
||||||
|
|
||||||
998 if (returnCode_EFeld.EQ.1) then
|
|
||||||
write(*,*) 'Mappe '//Nr//':'
|
|
||||||
write(*,*)' aktueller Teilchenort (nicht Testort!) hinter Potentialmappe!'
|
|
||||||
write(*,*)' -> STOP'
|
|
||||||
write(*,*)
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
c hier folgt der Code fuer 'returnCode_EFeld.NE.0', also fuer den Fall, dass
|
|
||||||
c bei der Berechnung des Feldes eine Fehlersituation auftrat:
|
|
||||||
|
|
||||||
c - Fehler trat auf bei Berechnung des EFeldes am AKTUELLEN TEILCHENORT:
|
|
||||||
|
|
||||||
999 if (returnCode_EFeld.EQ.1) then
|
|
||||||
if (.NOT.found_upper_upp) dt_save = dt
|
|
||||||
dtupper = dt
|
|
||||||
found_upper_upp = .true.
|
|
||||||
if (.NOT.found_lower_upp) then
|
|
||||||
dt = 0.5*dt
|
|
||||||
else
|
|
||||||
dt = (dtlower+dtupper)/2.
|
|
||||||
endif
|
|
||||||
goto 10
|
|
||||||
elseif (returnCode_EFeld.EQ.2) then
|
|
||||||
destiny = code_neben_Mappe
|
|
||||||
elseif (returnCode_EFeld.EQ.3) then
|
|
||||||
if (.NOT.found_upper_low) dt_save = dt
|
|
||||||
dtupper = dt
|
|
||||||
found_upper_low = .true.
|
|
||||||
if (.NOT.found_lower_low) then
|
|
||||||
dt = 0.5*dt
|
|
||||||
else
|
|
||||||
dt = (dtlower+dtupper)/2.
|
|
||||||
endif
|
|
||||||
goto 10
|
|
||||||
elseif (returnCode_EFeld.NE.0) then
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
|
|
||||||
write(*,*) 'unallowed value of ''returnCode_EFeld'': ',returnCode_Efeld
|
|
||||||
write(*,*) '-> STOP'
|
|
||||||
write(*,*)
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
|
|
||||||
c - Fehler trat auf im Zusammenhang von Berechnungen des Schnittpunktes der
|
|
||||||
c Trajektorie mit einer Mappenbegrenzung:
|
|
||||||
|
|
||||||
997 if (returnCode_EFeld.EQ.2) then
|
|
||||||
destiny = code_neben_Mappe
|
|
||||||
else
|
|
||||||
write(*,*) 'SINGLESTEP_RUNGE_KUTTA_'//Nr//': '
|
|
||||||
write(*,*) 'alternate Return from EFELD_'//Nr//' while calculating intersection'
|
|
||||||
write(*,*) 'of trajectory and x equals xmax line.'
|
|
||||||
write(*,*)
|
|
||||||
write(*,*)' returnCode_EFeld = ',returnCode_EFeld
|
|
||||||
write(*,*)' t = ',t
|
|
||||||
write(*,*)' x0 = ',x0
|
|
||||||
write(*,*)' v0 = ',v0
|
|
||||||
write(*,*)' E0 = ',E0
|
|
||||||
write(*,*)' theta0 = ',theta0
|
|
||||||
write(*,*)' phi0 = ',phi0
|
|
||||||
write(*,*)' x = ',x
|
|
||||||
write(*,*)' v = ',v
|
|
||||||
write(*,*)' Teilchen-Nr = ',Start_Nr
|
|
||||||
write(*,*)
|
|
||||||
write(*,*) '-> STOP'
|
|
||||||
write(*,*)
|
|
||||||
STOP
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE SINGLESTEP_RUNGE_KUTTA_5(dt,E0,x0,v0, Dx,Dv, *)
|
|
||||||
c ==========================================================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
c Diese Subroutine berechnet bei vorgegebenem Zeitschritt einen einzelnen
|
|
||||||
c Runge-Kutta-Integrationsschritt (4. Ordnung).
|
|
||||||
c Die Vorgehensweise entspricht den Ausfuehrungen in Kapitel 15.1 der
|
|
||||||
c NUMERICAL RECIPIES: 'Runge-Kutta Method'.
|
|
||||||
|
|
||||||
c Zurueckgegeben werden die errechneten Orts- und Geschwindigkeitsaenderungen
|
|
||||||
c anstatt direkt der neuen Werte, da sonst vor allem bei den Ortskoordinaten
|
|
||||||
c Schwierigkeiten auftreten koennen, wenn in der Subroutine 'INTEGRATIONSSTEP_
|
|
||||||
c RUNGE_KUTTA' aus der Differenz der neuen Werte aus den beiden dt/2- und dem
|
|
||||||
c dt-Schritt der Fehler abgeschaetzt werden soll (kleine Differenz moeglicher-
|
|
||||||
c weise grosser Werte).
|
|
||||||
|
|
||||||
|
|
||||||
real Beschl_Faktor
|
|
||||||
COMMON /Beschl_Faktor/ Beschl_Faktor
|
|
||||||
|
|
||||||
real E0(3), x0(3), v0(3) ! Eingangsgroessen
|
|
||||||
real E1(3), E2(3), E3(3) ! E-Felder an Testorten
|
|
||||||
real v1(3), v2(3), v3(3) ! Geschwindigkeiten an Testorten
|
|
||||||
real dt,dt_half,dt_sixth ! zeitl. Aenderung, dt/2, dt/6
|
|
||||||
real help, help_half, help_sixth ! Hilfsvariable, help/2, help/6
|
|
||||||
real xTest(3) ! Test-Orte
|
|
||||||
real Dx(3), Dv(3) ! Ergebnisspeicher
|
|
||||||
|
|
||||||
integer i ! Zaehlvariable
|
|
||||||
|
|
||||||
c = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
|
|
||||||
|
|
||||||
dt_half = dt / 2.
|
|
||||||
dt_sixth = dt / 6.
|
|
||||||
help = Beschl_Faktor * dt
|
|
||||||
help_half = help / 2.
|
|
||||||
help_sixth = help / 6.
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xTest(i) = x0(i) + v0(i) * dt_half
|
|
||||||
v1(i) = v0(i) + E0(i) * help_half
|
|
||||||
enddo
|
|
||||||
call EFeld_5(xTest,E1,*999)
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xTest(i) = x0(i) + v1(i) * dt_half
|
|
||||||
v2(i) = v0(i) + E1(i) * help_half
|
|
||||||
enddo
|
|
||||||
call EFeld_5(xTest,E2,*999)
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
xTest(i) = x0(i) + v2(i) * dt
|
|
||||||
v3(i) = v0(i) + E2(i) * help
|
|
||||||
enddo
|
|
||||||
call EFeld_5(xTest,E3,*999)
|
|
||||||
|
|
||||||
do i = 1, 3
|
|
||||||
Dx(i) = (v0(i) + 2.*(v1(i)+v2(i)) + v3(i)) * dt_sixth
|
|
||||||
Dv(i) = (E0(i) + 2.*(E1(i)+E2(i)) + E3(i)) * help_sixth
|
|
||||||
enddo
|
|
||||||
|
|
||||||
RETURN
|
|
||||||
|
|
||||||
999 RETURN 1
|
|
||||||
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE EFeld_5(x,E,*)
|
|
||||||
c =========================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:MAP_DEF_5.INC'
|
|
||||||
INCLUDE 'accel$sourcedirectory:CALC_FIELD_1.INC'
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
c Rechne in Gittereinheiten um:
|
|
||||||
|
|
||||||
real_i = (x(1)-xmin) / Dx_
|
|
||||||
real_j = abs(x(2)) / Dy_
|
|
||||||
real_k = abs(x(3)) / Dz_
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
c Mache die Tests und berechne die Feldstaerke:
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:CALC_FIELD_2.INC'
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -1,336 +0,0 @@
|
|||||||
c===============================================================================
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE MASSTAB_SETZEN
|
|
||||||
c =========================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
REAL*4 X1WC_P2,X2WC_P2,Y1WC_P2,Y2WC_P2
|
|
||||||
INTEGER*4 RPAW(1000000)
|
|
||||||
|
|
||||||
COMMON /PAWC/ RPAW
|
|
||||||
|
|
||||||
real scale
|
|
||||||
COMMON /scaleFactor/ scale
|
|
||||||
|
|
||||||
|
|
||||||
c DIMENSIONEN DES TRANSPORTSYSTEMS IN 'WELTKOORDINATEN'
|
|
||||||
|
|
||||||
CALL HLIMIT(1000000)
|
|
||||||
|
|
||||||
CALL HPLINT(0) ! init. HPLOT-package (without opening a
|
|
||||||
! graphics window)
|
|
||||||
c CALL IGZSET ('GZ') ! output to workstation and to ZEBRA
|
|
||||||
c 7-Aug-1996: herauskommentiert, da offensichtlich unnoetig oder sogar stoerend
|
|
||||||
|
|
||||||
c CALL IOPKS(6) ! init. graphic package (error mess. to screen)
|
|
||||||
c 7-Aug-1996: herauskommentiert, da HPLINT wohl IOPKS impliziert
|
|
||||||
|
|
||||||
CALL IOPWK(1,11,2) ! open WS for 'CHAMBER'
|
|
||||||
CALL IOPWK(4,31,3) ! open WS for 'HISTO'
|
|
||||||
CALL IOPWK(5,41,4) ! open WS for 'TEXT'
|
|
||||||
|
|
||||||
X1WC_P2 = -50.*scale
|
|
||||||
X2WC_P2 = 50.*scale
|
|
||||||
Y1WC_P2 = -50.*scale
|
|
||||||
Y2WC_P2 = 50.*scale
|
|
||||||
|
|
||||||
c MASSTAB SETZEN: (use normalization transformation index 2)
|
|
||||||
|
|
||||||
! Define window in world coordinates:
|
|
||||||
CALL ISWN(2, X1WC_P2,X2WC_P2,Y1WC_P2,Y2WC_P2)
|
|
||||||
! Define window in normalized device coordinates:
|
|
||||||
CALL ISVP(2, 0.,1.,0.,1.)
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE PLOT_CHAMBER
|
|
||||||
c =======================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_GEO.INC'
|
|
||||||
real scale,help
|
|
||||||
COMMON /scaleFactor/ scale
|
|
||||||
|
|
||||||
REAL*4 X(14),Y(14)
|
|
||||||
real alfa_HeWindow ! halber Oeffnungswinkel des He-Fensters
|
|
||||||
|
|
||||||
INTEGER*4 RPAW(1000000)
|
|
||||||
COMMON /PAWC/ RPAW
|
|
||||||
|
|
||||||
c - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
||||||
|
|
||||||
CALL IZPICT ('CHAMBER','C') ! make 'CHAMBER' the currrent picture
|
|
||||||
CALL ISELNT (2) ! select norm. transf. index 2
|
|
||||||
|
|
||||||
help = scale * 50.
|
|
||||||
CALL IGBOX(-help,help,-help,help) ! BOX UM 1. KAMMERTEIL
|
|
||||||
|
|
||||||
C HIER WIRD GEZEICHNET:
|
|
||||||
|
|
||||||
! alle dy und dz geben die halbe Gesamtausdehnung an, dx die ganze!
|
|
||||||
|
|
||||||
c - He-Shield:
|
|
||||||
|
|
||||||
alfa_HeWindow = asinD(dy_HeWindow/rHeShield)
|
|
||||||
CALL IGARC (0.,0.,scale*rHeShield,scale*rHeShield,alfa_HeWindow,-alfa_HeWindow)
|
|
||||||
|
|
||||||
c - targethalter:
|
|
||||||
|
|
||||||
x(1) = scale * xFoil
|
|
||||||
x(2) = scale * xFoil
|
|
||||||
x(3) = scale * xEnd_TgtHolder
|
|
||||||
x(4) = scale * xEnd_TgtHolder
|
|
||||||
x(5) = scale * (xFoil-1)
|
|
||||||
x(6) = scale * (xFoil-1)
|
|
||||||
x(7) = scale * (xFoil)
|
|
||||||
x(8) = scale * (xFoil)
|
|
||||||
x(9) = scale * (xFoil-1)
|
|
||||||
x(10) = scale * (xFoil-1)
|
|
||||||
x(11) = scale * xEnd_TgtHolder
|
|
||||||
x(12) = scale * xEnd_TgtHolder
|
|
||||||
x(13) = scale * xFoil
|
|
||||||
x(14) = scale * xFoil
|
|
||||||
|
|
||||||
y(1) = scale * Dy_Foil
|
|
||||||
y(2) = scale * innerDy1_TgtHolder
|
|
||||||
y(3) = scale * innerDy2_TgtHolder
|
|
||||||
y(4) = scale * outerDy_TgtHolder
|
|
||||||
y(5) = scale * outerDy_TgtHolder
|
|
||||||
y(6) = scale * Dy_Foil
|
|
||||||
y(7) = scale * Dy_Foil
|
|
||||||
y(8) = -scale * Dy_Foil
|
|
||||||
y(9) = -scale * Dy_Foil
|
|
||||||
y(10) = -scale * outerDy_TgtHolder
|
|
||||||
y(11) = -scale * outerDy_TgtHolder
|
|
||||||
y(12) = -scale * innerDy2_TgtHolder
|
|
||||||
y(13) = -scale * innerDy1_TgtHolder
|
|
||||||
y(14)= -scale * Dy_Foil
|
|
||||||
|
|
||||||
CALL ISLWSC(2.) !LINIENDICKE: dicker
|
|
||||||
CALL IPL (14,X,Y)
|
|
||||||
CALL ISLWSC(1.) !LINIENDICKE: wieder duenn
|
|
||||||
|
|
||||||
c - moderatorflaeche:
|
|
||||||
|
|
||||||
x(1) = scale * xFoil
|
|
||||||
x(2) = scale * xFoil
|
|
||||||
|
|
||||||
y(1) = scale * Dy_Foil
|
|
||||||
y(2) = -scale * Dy_Foil
|
|
||||||
|
|
||||||
c CALL ISLN(3) !LINIENTYP: gepunktet
|
|
||||||
CALL ISLWSC(3.) !LINIENDICKE: dick
|
|
||||||
CALL IPL(2,X,Y)
|
|
||||||
CALL ISLWSC(1.) !LINIENDICKE: duenn
|
|
||||||
c CALL ISLN (1) !LINIENTYP: wieder durchgezogen
|
|
||||||
|
|
||||||
c - guardring:
|
|
||||||
|
|
||||||
if (xStart_Guardring.LE.xEnd_Guardring) then
|
|
||||||
CALL IGBOX ( scale * xStart_Guardring, scale * xEnd_Guardring,
|
|
||||||
+ scale * innerDy_Guardring, scale * outerDy_Guardring)
|
|
||||||
|
|
||||||
CALL IGBOX ( scale * xStart_Guardring, scale * xEnd_Guardring,
|
|
||||||
+ -scale * innerDy_Guardring, -scale * outerDy_Guardring)
|
|
||||||
endif
|
|
||||||
|
|
||||||
c - frame 1. grid:
|
|
||||||
|
|
||||||
if (xStart_Gridframe1.LE.xEnd_Gridframe1) then
|
|
||||||
CALL IGBOX ( scale * xStart_Gridframe1, scale * xEnd_Gridframe1,
|
|
||||||
+ scale * innerDy_Gridframe1, scale * outerDy_Gridframe1)
|
|
||||||
|
|
||||||
CALL IGBOX ( scale * xStart_Gridframe1, scale * xEnd_Gridframe1,
|
|
||||||
+ -scale * innerDy_Gridframe1, -scale * outerDy_Gridframe1)
|
|
||||||
endif
|
|
||||||
|
|
||||||
c - frame 2. grid:
|
|
||||||
|
|
||||||
if (xStart_Gridframe2.LE.xEnd_Gridframe2) then
|
|
||||||
CALL IGBOX ( scale * xStart_Gridframe2, scale * xEnd_Gridframe2,
|
|
||||||
+ scale * innerDy_Gridframe2, scale * outerDy_Gridframe2)
|
|
||||||
|
|
||||||
CALL IGBOX ( scale * xStart_Gridframe2, scale * xEnd_Gridframe2,
|
|
||||||
+ -scale * innerDy_Gridframe2, -scale * outerDy_Gridframe2)
|
|
||||||
endif
|
|
||||||
|
|
||||||
|
|
||||||
CALL ISLN (3) !LINIENTYP: gepunktet
|
|
||||||
CALL ISLWSC(1.) !LINIENDICKE: duenn
|
|
||||||
|
|
||||||
c - 1. grid:
|
|
||||||
|
|
||||||
if (xStart_Gridframe1.LE.xEnd_Gridframe1) then
|
|
||||||
X(1) = scale * xPosition_Grid1
|
|
||||||
X(2) = scale * xPosition_Grid1
|
|
||||||
Y(1) = scale * y_Pos_lastWire1
|
|
||||||
Y(2) = -scale * y_Pos_lastWire1
|
|
||||||
CALL IPL (2,X,Y)
|
|
||||||
endif
|
|
||||||
|
|
||||||
c - 2. grid:
|
|
||||||
|
|
||||||
if (xStart_Gridframe2.LE.xEnd_Gridframe2) then
|
|
||||||
X(1) = scale * xPosition_Grid2
|
|
||||||
X(2) = scale * xPosition_Grid2
|
|
||||||
Y(1) = scale * y_Pos_lastWire2
|
|
||||||
Y(2) = -scale * y_Pos_lastWire2
|
|
||||||
CALL IPL (2,X,Y)
|
|
||||||
endif
|
|
||||||
|
|
||||||
c - Achsen:
|
|
||||||
|
|
||||||
CALL ISLN(1) ! LINIENTYP: durchgezogen
|
|
||||||
help = scale * 40.
|
|
||||||
CALL IGAXIS (-help,help,-help,-help,-help,help,414,'O+') ! X-ACHSE
|
|
||||||
CALL IGAXIS (-help,-help,-help,help,-help,help,414,'O-') ! Y-ACHSE
|
|
||||||
|
|
||||||
|
|
||||||
c Graphik auf Bildschirm geben:
|
|
||||||
|
|
||||||
CALL IACWK(1) !aktiviere WS 1
|
|
||||||
CALL IZPICT('CHAMBER','D') !display 'CHAMBER'
|
|
||||||
CALL IGTERM !update open WS and return to
|
|
||||||
! alfanumeric mode
|
|
||||||
CALL IDAWK(1) !desaktiviere WS 1
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE TEXT_PLOT
|
|
||||||
c ====================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
INTEGER*4 RPAW(1000000)
|
|
||||||
COMMON /PAWC/ RPAW
|
|
||||||
|
|
||||||
integer GraphTextZeilen, i
|
|
||||||
CHARACTER GraphText(15)*30
|
|
||||||
COMMON /GRAPHTEXT/ GraphTextZeilen,GraphText
|
|
||||||
|
|
||||||
CALL IZPICT('TEXT','C')
|
|
||||||
do i = 1, GraphTextZeilen
|
|
||||||
CALL IGTEXT(0.0,1.-real(i)/real(GraphTextZeilen),
|
|
||||||
+ GRAPHTEXT(i), 0.04,0.0,'L')
|
|
||||||
enddo
|
|
||||||
CALL IACWK(5)
|
|
||||||
CALL IZPICT('TEXT','D')
|
|
||||||
CALL IGTERM
|
|
||||||
CALL IDAWK(5)
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE PLOT_TRAJECTORY
|
|
||||||
c ==========================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
REAL TRAJ_X(1000),TRAJ_Y(1000),TRAJ_Z(1000)
|
|
||||||
INTEGER TRAJ_N
|
|
||||||
COMMON/GRAPHIX/TRAJ_X,TRAJ_Y,TRAJ_Z,TRAJ_N
|
|
||||||
INTEGER*4 RPAW(1000000)
|
|
||||||
COMMON /PAWC/ RPAW
|
|
||||||
|
|
||||||
CALL IZPICT('CHAMBER','C')
|
|
||||||
CALL ISELNT(2)
|
|
||||||
CALL ISLN(1)
|
|
||||||
|
|
||||||
CALL IPL(TRAJ_N,TRAJ_X,TRAJ_Y)
|
|
||||||
CALL IACWK(1)
|
|
||||||
CALL ISELNT(2)
|
|
||||||
CALL IZPICT ('CHAMBER','D')
|
|
||||||
CALL IGTERM
|
|
||||||
CALL IDAWK(1)
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE SCHNITT_PLOT
|
|
||||||
c =======================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
INTEGER*4 RPAW(1000000)
|
|
||||||
|
|
||||||
COMMON /PAWC/ RPAW
|
|
||||||
|
|
||||||
CALL IACWK (4)
|
|
||||||
CALL IZPICT ('HISTO','C')
|
|
||||||
CALL HPLOT(50,'BOX',' ',1)
|
|
||||||
C CALL IZPICT('HISTO','D')
|
|
||||||
CALL IGTERM
|
|
||||||
CALL IDAWK (4)
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
|
|
||||||
OPTIONS /EXTEND_SOURCE
|
|
||||||
|
|
||||||
SUBROUTINE MAKE_PS(FILENAME)
|
|
||||||
c ============================
|
|
||||||
|
|
||||||
IMPLICIT NONE
|
|
||||||
|
|
||||||
INCLUDE 'accel$sourcedirectory:COM_DIRS.INC'
|
|
||||||
|
|
||||||
REAL*4 XSIZE /12./, YSIZE /6./
|
|
||||||
CHARACTER*100 PSZEILE
|
|
||||||
CHARACTER*(*) FILENAME
|
|
||||||
|
|
||||||
INTEGER*4 RPAW(1000000)
|
|
||||||
COMMON /PAWC/ RPAW
|
|
||||||
|
|
||||||
OPEN (30,FILE='PPIC.TMP',FORM='FORMATTED',DEFAULTFILE=OUTDIR,
|
|
||||||
+ STATUS='UNKNOWN')
|
|
||||||
|
|
||||||
|
|
||||||
c ZUSAMMENFUEGEN VON 'CHAMBER' UND 'TEXT':
|
|
||||||
|
|
||||||
CALL IGMETA(-30,-4121)
|
|
||||||
CALL IGRNG(XSIZE,YSIZE)
|
|
||||||
CALL IZPICT('CHAMBER','D')
|
|
||||||
CALL ICLRWK(2,0)
|
|
||||||
CALL IZPICT('TEXT','D')
|
|
||||||
CALL IGMETA(0,0)
|
|
||||||
|
|
||||||
CALL ICLWK(2)
|
|
||||||
|
|
||||||
|
|
||||||
C ANFUEGEN EINES blanks AN DEN ANFANG JEDER PS-FILE-ZEILE:
|
|
||||||
c (kann dies nicht durch entsprechende option beim oeffnen des files
|
|
||||||
c direkt erreicht werden?)
|
|
||||||
|
|
||||||
REWIND (30)
|
|
||||||
OPEN (UNIT=31,FILE=FILENAME//'.PS',FORM='FORMATTED',DEFAULTFILE=OUTDIR,
|
|
||||||
+ STATUS='NEW')
|
|
||||||
|
|
||||||
38 READ (30, '(A100)', END=37) PSZEILE
|
|
||||||
WRITE (31,'(1X,A100)') PSZEILE
|
|
||||||
GOTO 38
|
|
||||||
|
|
||||||
37 CLOSE (30,STATUS='DELETE')
|
|
||||||
CLOSE (31)
|
|
||||||
|
|
||||||
END
|
|
||||||
|
|
||||||
c===============================================================================
|
|
||||||
@ -1,339 +0,0 @@
|
|||||||
GNU GENERAL PUBLIC LICENSE
|
|
||||||
Version 2, June 1991
|
|
||||||
|
|
||||||
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
|
|
||||||
675 Mass Ave, Cambridge, MA 02139, USA
|
|
||||||
Everyone is permitted to copy and distribute verbatim copies
|
|
||||||
of this license document, but changing it is not allowed.
|
|
||||||
|
|
||||||
Preamble
|
|
||||||
|
|
||||||
The licenses for most software are designed to take away your
|
|
||||||
freedom to share and change it. By contrast, the GNU General Public
|
|
||||||
License is intended to guarantee your freedom to share and change free
|
|
||||||
software--to make sure the software is free for all its users. This
|
|
||||||
General Public License applies to most of the Free Software
|
|
||||||
Foundation's software and to any other program whose authors commit to
|
|
||||||
using it. (Some other Free Software Foundation software is covered by
|
|
||||||
the GNU Library General Public License instead.) You can apply it to
|
|
||||||
your programs, too.
|
|
||||||
|
|
||||||
When we speak of free software, we are referring to freedom, not
|
|
||||||
price. Our General Public Licenses are designed to make sure that you
|
|
||||||
have the freedom to distribute copies of free software (and charge for
|
|
||||||
this service if you wish), that you receive source code or can get it
|
|
||||||
if you want it, that you can change the software or use pieces of it
|
|
||||||
in new free programs; and that you know you can do these things.
|
|
||||||
|
|
||||||
To protect your rights, we need to make restrictions that forbid
|
|
||||||
anyone to deny you these rights or to ask you to surrender the rights.
|
|
||||||
These restrictions translate to certain responsibilities for you if you
|
|
||||||
distribute copies of the software, or if you modify it.
|
|
||||||
|
|
||||||
For example, if you distribute copies of such a program, whether
|
|
||||||
gratis or for a fee, you must give the recipients all the rights that
|
|
||||||
you have. You must make sure that they, too, receive or can get the
|
|
||||||
source code. And you must show them these terms so they know their
|
|
||||||
rights.
|
|
||||||
|
|
||||||
We protect your rights with two steps: (1) copyright the software, and
|
|
||||||
(2) offer you this license which gives you legal permission to copy,
|
|
||||||
distribute and/or modify the software.
|
|
||||||
|
|
||||||
Also, for each author's protection and ours, we want to make certain
|
|
||||||
that everyone understands that there is no warranty for this free
|
|
||||||
software. If the software is modified by someone else and passed on, we
|
|
||||||
want its recipients to know that what they have is not the original, so
|
|
||||||
that any problems introduced by others will not reflect on the original
|
|
||||||
authors' reputations.
|
|
||||||
|
|
||||||
Finally, any free program is threatened constantly by software
|
|
||||||
patents. We wish to avoid the danger that redistributors of a free
|
|
||||||
program will individually obtain patent licenses, in effect making the
|
|
||||||
program proprietary. To prevent this, we have made it clear that any
|
|
||||||
patent must be licensed for everyone's free use or not licensed at all.
|
|
||||||
|
|
||||||
The precise terms and conditions for copying, distribution and
|
|
||||||
modification follow.
|
|
||||||
|
|
||||||
GNU GENERAL PUBLIC LICENSE
|
|
||||||
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
|
|
||||||
|
|
||||||
0. This License applies to any program or other work which contains
|
|
||||||
a notice placed by the copyright holder saying it may be distributed
|
|
||||||
under the terms of this General Public License. The "Program", below,
|
|
||||||
refers to any such program or work, and a "work based on the Program"
|
|
||||||
means either the Program or any derivative work under copyright law:
|
|
||||||
that is to say, a work containing the Program or a portion of it,
|
|
||||||
either verbatim or with modifications and/or translated into another
|
|
||||||
language. (Hereinafter, translation is included without limitation in
|
|
||||||
the term "modification".) Each licensee is addressed as "you".
|
|
||||||
|
|
||||||
Activities other than copying, distribution and modification are not
|
|
||||||
covered by this License; they are outside its scope. The act of
|
|
||||||
running the Program is not restricted, and the output from the Program
|
|
||||||
is covered only if its contents constitute a work based on the
|
|
||||||
Program (independent of having been made by running the Program).
|
|
||||||
Whether that is true depends on what the Program does.
|
|
||||||
|
|
||||||
1. You may copy and distribute verbatim copies of the Program's
|
|
||||||
source code as you receive it, in any medium, provided that you
|
|
||||||
conspicuously and appropriately publish on each copy an appropriate
|
|
||||||
copyright notice and disclaimer of warranty; keep intact all the
|
|
||||||
notices that refer to this License and to the absence of any warranty;
|
|
||||||
and give any other recipients of the Program a copy of this License
|
|
||||||
along with the Program.
|
|
||||||
|
|
||||||
You may charge a fee for the physical act of transferring a copy, and
|
|
||||||
you may at your option offer warranty protection in exchange for a fee.
|
|
||||||
|
|
||||||
2. You may modify your copy or copies of the Program or any portion
|
|
||||||
of it, thus forming a work based on the Program, and copy and
|
|
||||||
distribute such modifications or work under the terms of Section 1
|
|
||||||
above, provided that you also meet all of these conditions:
|
|
||||||
|
|
||||||
a) You must cause the modified files to carry prominent notices
|
|
||||||
stating that you changed the files and the date of any change.
|
|
||||||
|
|
||||||
b) You must cause any work that you distribute or publish, that in
|
|
||||||
whole or in part contains or is derived from the Program or any
|
|
||||||
part thereof, to be licensed as a whole at no charge to all third
|
|
||||||
parties under the terms of this License.
|
|
||||||
|
|
||||||
c) If the modified program normally reads commands interactively
|
|
||||||
when run, you must cause it, when started running for such
|
|
||||||
interactive use in the most ordinary way, to print or display an
|
|
||||||
announcement including an appropriate copyright notice and a
|
|
||||||
notice that there is no warranty (or else, saying that you provide
|
|
||||||
a warranty) and that users may redistribute the program under
|
|
||||||
these conditions, and telling the user how to view a copy of this
|
|
||||||
License. (Exception: if the Program itself is interactive but
|
|
||||||
does not normally print such an announcement, your work based on
|
|
||||||
the Program is not required to print an announcement.)
|
|
||||||
|
|
||||||
These requirements apply to the modified work as a whole. If
|
|
||||||
identifiable sections of that work are not derived from the Program,
|
|
||||||
and can be reasonably considered independent and separate works in
|
|
||||||
themselves, then this License, and its terms, do not apply to those
|
|
||||||
sections when you distribute them as separate works. But when you
|
|
||||||
distribute the same sections as part of a whole which is a work based
|
|
||||||
on the Program, the distribution of the whole must be on the terms of
|
|
||||||
this License, whose permissions for other licensees extend to the
|
|
||||||
entire whole, and thus to each and every part regardless of who wrote it.
|
|
||||||
|
|
||||||
Thus, it is not the intent of this section to claim rights or contest
|
|
||||||
your rights to work written entirely by you; rather, the intent is to
|
|
||||||
exercise the right to control the distribution of derivative or
|
|
||||||
collective works based on the Program.
|
|
||||||
|
|
||||||
In addition, mere aggregation of another work not based on the Program
|
|
||||||
with the Program (or with a work based on the Program) on a volume of
|
|
||||||
a storage or distribution medium does not bring the other work under
|
|
||||||
the scope of this License.
|
|
||||||
|
|
||||||
3. You may copy and distribute the Program (or a work based on it,
|
|
||||||
under Section 2) in object code or executable form under the terms of
|
|
||||||
Sections 1 and 2 above provided that you also do one of the following:
|
|
||||||
|
|
||||||
a) Accompany it with the complete corresponding machine-readable
|
|
||||||
source code, which must be distributed under the terms of Sections
|
|
||||||
1 and 2 above on a medium customarily used for software interchange; or,
|
|
||||||
|
|
||||||
b) Accompany it with a written offer, valid for at least three
|
|
||||||
years, to give any third party, for a charge no more than your
|
|
||||||
cost of physically performing source distribution, a complete
|
|
||||||
machine-readable copy of the corresponding source code, to be
|
|
||||||
distributed under the terms of Sections 1 and 2 above on a medium
|
|
||||||
customarily used for software interchange; or,
|
|
||||||
|
|
||||||
c) Accompany it with the information you received as to the offer
|
|
||||||
to distribute corresponding source code. (This alternative is
|
|
||||||
allowed only for noncommercial distribution and only if you
|
|
||||||
received the program in object code or executable form with such
|
|
||||||
an offer, in accord with Subsection b above.)
|
|
||||||
|
|
||||||
The source code for a work means the preferred form of the work for
|
|
||||||
making modifications to it. For an executable work, complete source
|
|
||||||
code means all the source code for all modules it contains, plus any
|
|
||||||
associated interface definition files, plus the scripts used to
|
|
||||||
control compilation and installation of the executable. However, as a
|
|
||||||
special exception, the source code distributed need not include
|
|
||||||
anything that is normally distributed (in either source or binary
|
|
||||||
form) with the major components (compiler, kernel, and so on) of the
|
|
||||||
operating system on which the executable runs, unless that component
|
|
||||||
itself accompanies the executable.
|
|
||||||
|
|
||||||
If distribution of executable or object code is made by offering
|
|
||||||
access to copy from a designated place, then offering equivalent
|
|
||||||
access to copy the source code from the same place counts as
|
|
||||||
distribution of the source code, even though third parties are not
|
|
||||||
compelled to copy the source along with the object code.
|
|
||||||
|
|
||||||
4. You may not copy, modify, sublicense, or distribute the Program
|
|
||||||
except as expressly provided under this License. Any attempt
|
|
||||||
otherwise to copy, modify, sublicense or distribute the Program is
|
|
||||||
void, and will automatically terminate your rights under this License.
|
|
||||||
However, parties who have received copies, or rights, from you under
|
|
||||||
this License will not have their licenses terminated so long as such
|
|
||||||
parties remain in full compliance.
|
|
||||||
|
|
||||||
5. You are not required to accept this License, since you have not
|
|
||||||
signed it. However, nothing else grants you permission to modify or
|
|
||||||
distribute the Program or its derivative works. These actions are
|
|
||||||
prohibited by law if you do not accept this License. Therefore, by
|
|
||||||
modifying or distributing the Program (or any work based on the
|
|
||||||
Program), you indicate your acceptance of this License to do so, and
|
|
||||||
all its terms and conditions for copying, distributing or modifying
|
|
||||||
the Program or works based on it.
|
|
||||||
|
|
||||||
6. Each time you redistribute the Program (or any work based on the
|
|
||||||
Program), the recipient automatically receives a license from the
|
|
||||||
original licensor to copy, distribute or modify the Program subject to
|
|
||||||
these terms and conditions. You may not impose any further
|
|
||||||
restrictions on the recipients' exercise of the rights granted herein.
|
|
||||||
You are not responsible for enforcing compliance by third parties to
|
|
||||||
this License.
|
|
||||||
|
|
||||||
7. If, as a consequence of a court judgment or allegation of patent
|
|
||||||
infringement or for any other reason (not limited to patent issues),
|
|
||||||
conditions are imposed on you (whether by court order, agreement or
|
|
||||||
otherwise) that contradict the conditions of this License, they do not
|
|
||||||
excuse you from the conditions of this License. If you cannot
|
|
||||||
distribute so as to satisfy simultaneously your obligations under this
|
|
||||||
License and any other pertinent obligations, then as a consequence you
|
|
||||||
may not distribute the Program at all. For example, if a patent
|
|
||||||
license would not permit royalty-free redistribution of the Program by
|
|
||||||
all those who receive copies directly or indirectly through you, then
|
|
||||||
the only way you could satisfy both it and this License would be to
|
|
||||||
refrain entirely from distribution of the Program.
|
|
||||||
|
|
||||||
If any portion of this section is held invalid or unenforceable under
|
|
||||||
any particular circumstance, the balance of the section is intended to
|
|
||||||
apply and the section as a whole is intended to apply in other
|
|
||||||
circumstances.
|
|
||||||
|
|
||||||
It is not the purpose of this section to induce you to infringe any
|
|
||||||
patents or other property right claims or to contest validity of any
|
|
||||||
such claims; this section has the sole purpose of protecting the
|
|
||||||
integrity of the free software distribution system, which is
|
|
||||||
implemented by public license practices. Many people have made
|
|
||||||
generous contributions to the wide range of software distributed
|
|
||||||
through that system in reliance on consistent application of that
|
|
||||||
system; it is up to the author/donor to decide if he or she is willing
|
|
||||||
to distribute software through any other system and a licensee cannot
|
|
||||||
impose that choice.
|
|
||||||
|
|
||||||
This section is intended to make thoroughly clear what is believed to
|
|
||||||
be a consequence of the rest of this License.
|
|
||||||
|
|
||||||
8. If the distribution and/or use of the Program is restricted in
|
|
||||||
certain countries either by patents or by copyrighted interfaces, the
|
|
||||||
original copyright holder who places the Program under this License
|
|
||||||
may add an explicit geographical distribution limitation excluding
|
|
||||||
those countries, so that distribution is permitted only in or among
|
|
||||||
countries not thus excluded. In such case, this License incorporates
|
|
||||||
the limitation as if written in the body of this License.
|
|
||||||
|
|
||||||
9. The Free Software Foundation may publish revised and/or new versions
|
|
||||||
of the General Public License from time to time. Such new versions will
|
|
||||||
be similar in spirit to the present version, but may differ in detail to
|
|
||||||
address new problems or concerns.
|
|
||||||
|
|
||||||
Each version is given a distinguishing version number. If the Program
|
|
||||||
specifies a version number of this License which applies to it and "any
|
|
||||||
later version", you have the option of following the terms and conditions
|
|
||||||
either of that version or of any later version published by the Free
|
|
||||||
Software Foundation. If the Program does not specify a version number of
|
|
||||||
this License, you may choose any version ever published by the Free Software
|
|
||||||
Foundation.
|
|
||||||
|
|
||||||
10. If you wish to incorporate parts of the Program into other free
|
|
||||||
programs whose distribution conditions are different, write to the author
|
|
||||||
to ask for permission. For software which is copyrighted by the Free
|
|
||||||
Software Foundation, write to the Free Software Foundation; we sometimes
|
|
||||||
make exceptions for this. Our decision will be guided by the two goals
|
|
||||||
of preserving the free status of all derivatives of our free software and
|
|
||||||
of promoting the sharing and reuse of software generally.
|
|
||||||
|
|
||||||
NO WARRANTY
|
|
||||||
|
|
||||||
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
|
|
||||||
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
|
|
||||||
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
|
|
||||||
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
|
|
||||||
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
|
|
||||||
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
|
|
||||||
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
|
|
||||||
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
|
|
||||||
REPAIR OR CORRECTION.
|
|
||||||
|
|
||||||
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
|
|
||||||
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
|
|
||||||
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
|
|
||||||
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
|
|
||||||
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
|
|
||||||
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
|
|
||||||
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
|
|
||||||
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
|
|
||||||
POSSIBILITY OF SUCH DAMAGES.
|
|
||||||
|
|
||||||
END OF TERMS AND CONDITIONS
|
|
||||||
|
|
||||||
Appendix: How to Apply These Terms to Your New Programs
|
|
||||||
|
|
||||||
If you develop a new program, and you want it to be of the greatest
|
|
||||||
possible use to the public, the best way to achieve this is to make it
|
|
||||||
free software which everyone can redistribute and change under these terms.
|
|
||||||
|
|
||||||
To do so, attach the following notices to the program. It is safest
|
|
||||||
to attach them to the start of each source file to most effectively
|
|
||||||
convey the exclusion of warranty; and each file should have at least
|
|
||||||
the "copyright" line and a pointer to where the full notice is found.
|
|
||||||
|
|
||||||
<one line to give the program's name and a brief idea of what it does.>
|
|
||||||
Copyright (C) 19yy <name of author>
|
|
||||||
|
|
||||||
This program is free software; you can redistribute it and/or modify
|
|
||||||
it under the terms of the GNU General Public License as published by
|
|
||||||
the Free Software Foundation; either version 2 of the License, or
|
|
||||||
(at your option) any later version.
|
|
||||||
|
|
||||||
This program is distributed in the hope that it will be useful,
|
|
||||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
||||||
GNU General Public License for more details.
|
|
||||||
|
|
||||||
You should have received a copy of the GNU General Public License
|
|
||||||
along with this program; if not, write to the Free Software
|
|
||||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
||||||
|
|
||||||
Also add information on how to contact you by electronic and paper mail.
|
|
||||||
|
|
||||||
If the program is interactive, make it output a short notice like this
|
|
||||||
when it starts in an interactive mode:
|
|
||||||
|
|
||||||
Gnomovision version 69, Copyright (C) 19yy name of author
|
|
||||||
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
|
|
||||||
This is free software, and you are welcome to redistribute it
|
|
||||||
under certain conditions; type `show c' for details.
|
|
||||||
|
|
||||||
The hypothetical commands `show w' and `show c' should show the appropriate
|
|
||||||
parts of the General Public License. Of course, the commands you use may
|
|
||||||
be called something other than `show w' and `show c'; they could even be
|
|
||||||
mouse-clicks or menu items--whatever suits your program.
|
|
||||||
|
|
||||||
You should also get your employer (if you work as a programmer) or your
|
|
||||||
school, if any, to sign a "copyright disclaimer" for the program, if
|
|
||||||
necessary. Here is a sample; alter the names:
|
|
||||||
|
|
||||||
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
|
|
||||||
`Gnomovision' (which makes passes at compilers) written by James Hacker.
|
|
||||||
|
|
||||||
<signature of Ty Coon>, 1 April 1989
|
|
||||||
Ty Coon, President of Vice
|
|
||||||
|
|
||||||
This General Public License does not permit incorporating your program into
|
|
||||||
proprietary programs. If your program is a subroutine library, you may
|
|
||||||
consider it more useful to permit linking proprietary applications with the
|
|
||||||
library. If this is what you want to do, use the GNU Library General
|
|
||||||
Public License instead of this License.
|
|
||||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user