diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..94a9ed0 --- /dev/null +++ b/LICENSE @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. 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 +them 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 prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. 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. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey 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; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If 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 convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU 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 that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + 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. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +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. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + 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 +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + 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 3 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, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program 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, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU 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 Lesser General +Public License instead of this License. But first, please read +. diff --git a/amat.f b/amat.f new file mode 100644 index 0000000..6e083dd --- /dev/null +++ b/amat.f @@ -0,0 +1,142 @@ + SUBROUTINE AMAT(E,W,G,X1,Y1,Z1,X2,Y2,Z2,L,DUT,N1,N2,I,RY,CT) + + INCLUDE 'param.dat' + REAL*8 RK(12,12),B(NODC),CT(NODC) + REAL*8 T(12,12),TT(12,12),DUT(NODM) + REAL*8 F(12),X1,Y1,Z1,X2,Y2,Z2 + REAL*8 E,W,L,G,SPRK,SRK,SF + INTEGER I,J,S,N1,N2,RY,myid +c COMMON /KM/ RK +c COMMON /BT/ T +c COMMON /BTT/ TT +c COMMON /CT/ CT + PARAMETER(ZERO = 0.0E+0) + + +c OPEN(UNIT=20,FILE='TEST',STATUS='UNKNOWN') + +c write(20,*) (X1+X2)/2.0, L +c IF (L.LT.0.01) L=0.01 +c write(*,*) 'E=',E +c L=1.0 + + CALL TMAT(X1,Y1,Z1,X2,Y2,Z2,RY,T) + CALL KMAT(E,G,W,L,RY,RK) + + + B(12*I-11)= + 1 T(1,1)*DUT(6*N1-5) + T(1,2)*DUT(6*N1-4) + 1 + T(1,3)*DUT(6*N1-3) + + B(12*I-10)= + 1 T(2,1)*DUT(6*N1-5) + T(2,2)*DUT(6*N1-4) + 1 + T(2,3)*DUT(6*N1-3) + + B(12*I-9)= + 1 T(3,1)*DUT(6*N1-5) + T(3,2)*DUT(6*N1-4) + 1 + T(3,3)*DUT(6*N1-3) + + B(12*I-8)= + 1 T(4,4)*DUT(6*N1-2) + 1 + T(4,5)*DUT(6*N1-1) + T(4,6)*DUT(6*N1-0) + + B(12*I-7)= + 1 T(5,4)*DUT(6*N1-2) + 1 + T(5,5)*DUT(6*N1-1) + T(5,6)*DUT(6*N1-0) + + B(12*I-6)= + 1 T(6,4)*DUT(6*N1-2) + 1 + T(6,5)*DUT(6*N1-1) + T(6,6)*DUT(6*N1-0) + + B(12*I-5)= + 1 T(7,7)*DUT(6*N2-5) + T(7,8)*DUT(6*N2-4) + 1 + T(7,9)*DUT(6*N2-3) + + B(12*I-4)= + 1 T(8,7)*DUT(6*N2-5) + T(8,8)*DUT(6*N2-4) + 1 + T(8,9)*DUT(6*N2-3) + + B(12*I-3)= + 1 T(9,7)*DUT(6*N2-5) + T(9,8)*DUT(6*N2-4) + 1 + T(9,9)*DUT(6*N2-3) + + B(12*I-2)= + 1 T(10,10)*DUT(6*N2-2) + 1 + T(10,11)*DUT(6*N2-1) + T(10,12)*DUT(6*N2-0) + + B(12*I-1)= + 1 T(11,10)*DUT(6*N2-2) + 1 + T(11,11)*DUT(6*N2-1) + T(11,12)*DUT(6*N2-0) + + B(12*I-0)= + 1 T(12,10)*DUT(6*N2-2) + 1 + T(12,11)*DUT(6*N2-1) + T(12,12)*DUT(6*N2-0) +c---------------------------------------------------------------- + CT(12*I-11)= CT(12*I-11) + 1 + RK(1,1)*B(12*I-11)+ RK(1,7)*B(12*I-5) + + CT(12*I-10)= CT(12*I-10) + 1 + RK(2,2)*B(12*I-10) + 1 + RK(2,6)*B(12*I-6) + 1 + RK(2,8)*B(12*I-4) + 1 + RK(2,12)*B(12*I-0) + + CT(12*I-9)= CT(12*I-9) + 1 + RK(3,3)*B(12*I-9) + 1 + RK(3,5)*B(12*I-7) + 1 + RK(3,9)*B(12*I-3) + 1 + RK(3,11)*B(12*I-1) + + CT(12*I-8)= CT(12*I-8) + 1 + RK(4,4)*B(12*I-8) + 1 + RK(4,10)*B(12*I-2) + + + CT(12*I-7)= CT(12*I-7) + 1 + RK(5,3)*B(12*I-9) + 1 + RK(5,5)*B(12*I-7) + 1 + RK(5,9)*B(12*I-3) + 1 + RK(5,11)*B(12*I-1) + + CT(12*I-6)= CT(12*I-6) + 1 + RK(6,2)*B(12*I-10) + 1 + RK(6,6)*B(12*I-6) + 1 + RK(6,8)*B(12*I-4) + 1 + RK(6,12)*B(12*I-0) + + CT(12*I-5)= CT(12*I-5) + 1 + RK(7,1)*B(12*I-11) + 1 + RK(7,7)*B(12*I-5) + + CT(12*I-4)= CT(12*I-4) + 1 + RK(8,2)*B(12*I-10) + 1 + RK(8,6)*B(12*I-6) + 1 + RK(8,8)*B(12*I-4) + 1 + RK(8,12)*B(12*I-0) + + CT(12*I-3)= CT(12*I-3) + 1 + RK(9,3)*B(12*I-9) + 1 + RK(9,5)*B(12*I-7) + 1 + RK(9,9)*B(12*I-3) + 1 + RK(9,11)*B(12*I-1) + + CT(12*I-2)= CT(12*I-2) + 1 + RK(10,4)*B(12*I-8) + 1 + RK(10,10)*B(12*I-2) + + + CT(12*I-1)= CT(12*I-1) + 1 + RK(11,3)*B(12*I-9) + 1 + RK(11,5)*B(12*I-7) + 1 + RK(11,9)*B(12*I-3) + 1 + RK(11,11)*B(12*I-1) + + CT(12*I-0)= CT(12*I-0) + 1 + RK(12,2)*B(12*I-10) + 1 + RK(12,6)*B(12*I-6) + 1 + RK(12,8)*B(12*I-4) + 1 + RK(12,12)*B(12*I-0) +c----------------------------------------------------------- + + RETURN + END diff --git a/ave.f b/ave.f new file mode 100644 index 0000000..fe8afbd --- /dev/null +++ b/ave.f @@ -0,0 +1,93 @@ + PROGRAM STAND + + REAL AFIL(2000),NFIL(2000),DX,DY,J,LJ,DR,DT + REAL STR + INTEGER IDX,N,T,I,SDX + CHARACTER*2 na(0:64) + data na/'00','01','02','03','04','05','06','07','08', + 1 '09','10','11','12','13','14','15','16','17', + 1 '18','19','20','21','22','23','24','25','26', + 1 '27','28','29','30','31','32','33','34','35', + 1 '36','37','38','39','40','41','42','43','44', + 1 '45','46','47','48','49','50','51','52','53', + 1 '54','55','56','57','58','59','60','61','62','63','64'/ + CHARACTER*20 INFI + + 2 FORMAT (A) +c WRITE(*,*) 'N?' + WRITE(*,*) 'INFI?,N' + READ(*,2) INFI + READ(*,*) N + + SDX=0 + OPEN(UNIT=10,FILE=INFI,STATUS='OLD') + OPEN(UNIT=700,FILE='AR',STATUS='UNKNOWN') + + DO 5 I=1,2000 + AFIL(I)=0.0 + NFIL(I)=0.0 + 5 CONTINUE + + + DO 20 T=1,N + READ(10,*) DX,DR + DX=(DX*50.0*50.0)/1000.0 +! DX=(DX*50.0*50.0*50.0)**0.667 +! DR=DR**0.5 + IF (DX.LT.10) THEN + IDX=DX + AFIL(IDX)=AFIL(IDX)+DR + GOTO 20 + ENDIF + + DO 10 I=1,200 + J=I-50 +c J=(I+1)/7.0 +c LJ=(I-1)/7.0 + RI=EXP(J/6.0) + ORI=EXP((J-1)/6.0) + IF (DX.GE.ORI.AND.DX.LT.RI) THEN + AFIL(I)=AFIL(I)+DR + NFIL(I)=NFIL(I)+1.0 + ENDIF + 10 CONTINUE + 20 CONTINUE + + +! DO 23 T=1,9 +! WRITE(700,*) T,AFIL(T) +! 23 CONTINUE + + + SM=0 + DO 30 T=1,200 + J=T-50 + IF (NFIL(T).GE.1) THEN +c write(*,*) NFIL(T) +c WRITE(70,*) (EXP(J/10.)+EXP((J-1)/10.))/2.,(AFIL(T)/NFIL(T)) + WRITE(700,*) EXP((T-50.0-0.5)/6.0), + 1 AFIL(T)/(EXP((J)/6.)-EXP((J-1.0)/6.)) + ENDIF + 30 CONTINUE + + STOP + END + + + + + + + + + + + + + + + + + + + diff --git a/ave2.f b/ave2.f new file mode 100644 index 0000000..1fadcbd --- /dev/null +++ b/ave2.f @@ -0,0 +1,90 @@ + PROGRAM STAND + + REAL AFIL(2000),NFIL(2000),DX,DY,J,LJ,DR,DT + REAL STR + INTEGER IDX,N,T,I,SDX + CHARACTER*2 na(0:64) + data na/'00','01','02','03','04','05','06','07','08', + 1 '09','10','11','12','13','14','15','16','17', + 1 '18','19','20','21','22','23','24','25','26', + 1 '27','28','29','30','31','32','33','34','35', + 1 '36','37','38','39','40','41','42','43','44', + 1 '45','46','47','48','49','50','51','52','53', + 1 '54','55','56','57','58','59','60','61','62','63','64'/ + CHARACTER*20 INFI + + 2 FORMAT (A) +c WRITE(*,*) 'N?' + WRITE(*,*) 'INFI?,N' + READ(*,2) INFI + READ(*,*) N + + SDX=0 + OPEN(UNIT=10,FILE=INFI,STATUS='OLD') + OPEN(UNIT=700,FILE='AR',STATUS='UNKNOWN') + + DO 5 I=1,2000 + AFIL(I)=0.0 + NFIL(I)=0.0 + 5 CONTINUE + + + DO 20 T=1,N + READ(10,*) DX,DR + IF (DX.LT.10) THEN + IDX=DX + AFIL(IDX)=AFIL(IDX)+DR + GOTO 20 + ENDIF + + DO 10 I=1,200 + J=I-50 +c J=(I+1)/7.0 +c LJ=(I-1)/7.0 + RI=EXP(J/3.0) + ORI=EXP((J-1)/3.0) + IF (DX.GE.ORI.AND.DX.LT.RI) THEN + AFIL(I)=AFIL(I)+DR + NFIL(I)=NFIL(I)+1.0 + ENDIF + 10 CONTINUE + 20 CONTINUE + + + DO 23 T=1,9 + WRITE(700,*) T,AFIL(T) + 23 CONTINUE + + + SM=0 + DO 30 T=10,200 + J=T-50 + IF (NFIL(T).GE.1) THEN +c write(*,*) NFIL(T) +c WRITE(70,*) (EXP(J/10.)+EXP((J-1)/10.))/2.,(AFIL(T)/NFIL(T)) + WRITE(700,*) EXP((T-50.0-0.5)/3.0), + 1 AFIL(T)/(EXP((J)/3.)-EXP((J-1.0)/3.)) + ENDIF + 30 CONTINUE + + STOP + END + + + + + + + + + + + + + + + + + + + diff --git a/ave3.f b/ave3.f new file mode 100644 index 0000000..d191f61 --- /dev/null +++ b/ave3.f @@ -0,0 +1,90 @@ + PROGRAM STAND + + REAL AFIL(2000),NFIL(2000),DX,DY,J,LJ,DR,DT + REAL STR + INTEGER IDX,N,T,I,SDX + CHARACTER*2 na(0:64) + data na/'00','01','02','03','04','05','06','07','08', + 1 '09','10','11','12','13','14','15','16','17', + 1 '18','19','20','21','22','23','24','25','26', + 1 '27','28','29','30','31','32','33','34','35', + 1 '36','37','38','39','40','41','42','43','44', + 1 '45','46','47','48','49','50','51','52','53', + 1 '54','55','56','57','58','59','60','61','62','63','64'/ + CHARACTER*20 INFI + + 2 FORMAT (A) +c WRITE(*,*) 'N?' + WRITE(*,*) 'INFI?,N' + READ(*,2) INFI + READ(*,*) N + + SDX=0 + OPEN(UNIT=10,FILE=INFI,STATUS='OLD') + OPEN(UNIT=700,FILE='AR',STATUS='UNKNOWN') + + DO 5 I=1,2000 + AFIL(I)=0.0 + NFIL(I)=0.0 + 5 CONTINUE + + + DO 20 T=1,N + READ(10,*) X,Y,ANG,DX +! IF (DX.LT.10) THEN +! IDX=DX +! AFIL(IDX)=AFIL(IDX)+1 +! GOTO 20 +! ENDIF + + DO 10 I=1,200 + J=I-50 +c J=(I+1)/7.0 +c LJ=(I-1)/7.0 + RI=EXP(J/3.0) + ORI=EXP((J-1)/3.0) + IF (DX.GE.ORI.AND.DX.LT.RI) THEN + AFIL(I)=AFIL(I)+DR + NFIL(I)=NFIL(I)+1.0 + ENDIF + 10 CONTINUE + 20 CONTINUE + + +! DO 23 T=1,9 +! WRITE(700,*) T,AFIL(T) +! 23 CONTINUE + + + SM=0 + DO 30 T=1,200 + J=T-50 + IF (NFIL(T).GE.1) THEN +c write(*,*) NFIL(T) +c WRITE(70,*) (EXP(J/10.)+EXP((J-1)/10.))/2.,(AFIL(T)/NFIL(T)) + WRITE(700,*) EXP((T-50.0-0.5)/3.0), + 1 NFIL(T)/(EXP((J)/3.)-EXP((J-1.0)/3.)) + ENDIF + 30 CONTINUE + + STOP + END + + + + + + + + + + + + + + + + + + + diff --git a/aves.f b/aves.f new file mode 100644 index 0000000..4de9a9f --- /dev/null +++ b/aves.f @@ -0,0 +1,90 @@ + PROGRAM STAND + + REAL AFIL(2000),NFIL(2000),DX,DY,J,LJ,DR,DT + REAL DX1,DX2,DX3,DX4,STR + INTEGER IDX,N,T,I,SDX + CHARACTER*2 na(0:64) + data na/'00','01','02','03','04','05','06','07','08', + 1 '09','10','11','12','13','14','15','16','17', + 1 '18','19','20','21','22','23','24','25','26', + 1 '27','28','29','30','31','32','33','34','35', + 1 '36','37','38','39','40','41','42','43','44', + 1 '45','46','47','48','49','50','51','52','53', + 1 '54','55','56','57','58','59','60','61','62','63','64'/ + CHARACTER*20 INFI + + 2 FORMAT (A) +c WRITE(*,*) 'N?' + WRITE(*,*) 'INFI?,N' + READ(*,2) INFI + READ(*,*) N + + SDX=0 + OPEN(UNIT=10,FILE=INFI,STATUS='OLD') + OPEN(UNIT=700,FILE='AR',STATUS='UNKNOWN') + + DO 5 I=1,2000 + AFIL(I)=0.0 + NFIL(I)=0.0 + 5 CONTINUE + + + DO 20 T=1,N + READ(10,*) DT,DX1,DX2,DX3,DX4 +! IF (DX.LT.10) THEN +! IDX=DX +! AFIL(IDX)=AFIL(IDX)+DR +! GOTO 20 +! ENDIF + + DO 10 I=1,2000 + J=I-50 +c J=(I+1)/7.0 +c LJ=(I-1)/7.0 + RI=EXP(J/3.0) + ORI=EXP((J-1)/3.0) + IF (DX3.GE.ORI.AND.DX3.LT.RI) THEN + AFIL(I)=AFIL(I)+DR + NFIL(I)=NFIL(I)+1.0 + ENDIF + 10 CONTINUE + 20 CONTINUE + + +! DO 23 T=1,9 +! WRITE(700,*) T,AFIL(T) +! 23 CONTINUE + + + SM=0 + DO 30 T=1,2000 + J=T-50 + IF (NFIL(T).GE.1) THEN +c write(*,*) NFIL(T) +c WRITE(70,*) (EXP(J/10.)+EXP((J-1)/10.))/2.,(AFIL(T)/NFIL(T)) + WRITE(700,*) EXP((T-50.0-0.5)/3.0), + 1 NFIL(T)/(EXP((J)/3.)-EXP((J-1.0)/3.)) + ENDIF + 30 CONTINUE + + STOP + END + + + + + + + + + + + + + + + + + + + diff --git a/bipint.f90 b/bipint.f90 new file mode 100644 index 0000000..c84a82f --- /dev/null +++ b/bipint.f90 @@ -0,0 +1,5 @@ +Subroutine BIPINT(x,y,f11,f12,f21,f22,fint) +Implicit none +Real*8 :: x,y,f11,f12,f21,f22,fint +fint=f11*(1.0-x)*(1.0-y)+f21*x*(1.0-y)+f12*(1.0-x)*y+f22*x*y +End Subroutine diff --git a/circ.f b/circ.f new file mode 100644 index 0000000..eb1cdbb --- /dev/null +++ b/circ.f @@ -0,0 +1,410 @@ + SUBROUTINE CIRC(ND,NN,NRXF,UT,FRX,FRY,FRZ, + 1 T,IS,DT,WE,EFC,FXF,FXC,NDR,NCL,NDL, + 1 NDLL,NDLR,NRXFL,NRXFR,UTL,UTR,myid,ntasks,FXFL,FXFR,FXL,FXR, + 1 FXCF,FXFF,UTF,NRXFF,NDLF,NDF, + 1 FXCB,FXFB,UTB,NRXFB,NDLB,NDB,LNN,YN, + 1 NDFL,NDFR,NDBL,NDBR, + 1 FXCFR,FXCFL,FXCBR,FXCBL, + 1 NDLFL,NDLFR,NDLBL,NDLBR, + 1 UTFL,UTFR,UTBL,UTBR, + 1 NRXFBL,NRXFBR,NRXFFL,NRXFFR, + 1 FXFFR,FXFFL,FXFBR,FXFBL,SCL) + + IMPLICIT NONE + include 'mpif.h' + include 'param.dat' + REAL*8 X1,X2,Y1,Y2,Z1,Z2 + REAL*8 T1,T2 + REAL*8 NRXF(3,NOMA),NRXFR(3,NOMA),NRXFL(3,NOMA) + REAL*8 NRXFF(3,NOMA),NRXFB(3,NOMA),EFC(NOMA) + REAL*8 NRXFFL(3,NOMA),NRXFBL(3,NOMA) + REAL*8 NRXFFR(3,NOMA),NRXFBR(3,NOMA) + REAL*8 UT(NODM),UTR(NODM),UTL(NODM),UTB(NODM),UTF(NODM) + REAL*8 UTBL(NODM),UTFL(NODM),UTBR(NODM),UTFR(NODM) + REAL*8 SX,SY,SZ,SUM,T,WE(NOMA),L0 + REAL*8 DDEL,DWE,OWE,DT,ESUM,LNN + REAL*8 LS,LS2,DEL,SCL + INTEGER myid,ntasks,ierr,YN + INTEGER dest,source,tag,stat(MPI_STATUS_SIZE),comm + INTEGER FXF(2,NODC),NDL(2,NODC),NDLR(2,NODC),NDLL(2,NODC) + INTEGER NDLF(2,NODC),NDLB(2,NODC) + INTEGER NDLFL(2,NODC),NDLBL(2,NODC) + INTEGER NDLFR(2,NODC),NDLBR(2,NODC) + REAL*8 RC,RCX,RCY,RCZ,FRX(NOMA),FRY(NOMA),FRZ(NOMA) + INTEGER NTOT,I,N1,N2,ND,IS,NN,FXC,NCL,NDR,NDF,NDB + INTEGER NDFL,NDFR,NDBL,NDBR + INTEGER FXL,FXR,FXFR(2,NODC),FXFL(2,NODC) + INTEGER FXCF,FXCB,FXFB(2,NODC),FXFF(2,NODC) + INTEGER FXCFL,FXCBL,FXFBL(2,NODC),FXFFL(2,NODC) + INTEGER FXCFR,FXCBR,FXFBR(2,NODC),FXFFR(2,NODC) + + + DO I=1,NOMA + FRX(I)=0.0 + FRY(I)=0.0 + FRZ(I)=0.0 + WE(I)=0.0 + END DO + + FXC=0 + DO I=1,ND + N1=NDL(1,I) + N2=NDL(2,I) + X1=NRXF(1,N1)+UT(6*N1-5) + Y1=NRXF(2,N1)+UT(6*N1-4) + Z1=NRXF(3,N1)+UT(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N1)=FRX(N1)+EFC(N1)*(LNN-RC)**1.5*RCX + FRY(N1)=FRY(N1)+EFC(N1)*(LNN-RC)**1.5*RCY + FRZ(N1)=FRZ(N1)+EFC(N1)*(LNN-RC)**1.5*RCZ + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXC=FXC+1 + FXF(1,FXC)=N1 + FXF(2,FXC)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N1)=FRX(N1)+SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N1)=FRY(N1)+SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N1)=FRZ(N1)+SCL**2.0*1.0e+06*(LNN-RC)*RCZ + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + +c IF (myid.ne.0.and.myid.ne.(ntasks-1)/2+1) THEN + IF (MOD(myid,ntasks/YN).ne.0) THEN + FXL=0 + DO I=1,NCL + N1=NDLL(1,I) + N2=NDLL(2,I) + X1=NRXFL(1,N1)+UTL(6*N1-5) + Y1=NRXFL(2,N1)+UTL(6*N1-4) + Z1=NRXFL(3,N1)+UTL(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXL=FXL+1 + FXFL(1,FXL)=N1 + FXFL(2,FXL)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + +c IF (myid.ne.ntasks-1.and.myid.ne.(ntasks-1)/2) THEN + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + FXR=0 + DO I=1,NDR + N1=NDLR(1,I) + N2=NDLR(2,I) + X1=NRXFR(1,N1)+UTR(6*N1-5) + Y1=NRXFR(2,N1)+UTR(6*N1-4) + Z1=NRXFR(3,N1)+UTR(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN +! write(*,*) N1,N2,RC,LNN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXR=FXR+1 + FXFR(1,FXR)=N1 + FXFR(2,FXR)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + +c------------------------------------------------ + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + FXCF=0 + DO I=1,NDF + N1=NDLF(1,I) + N2=NDLF(2,I) + X1=NRXFF(1,N1)+UTF(6*N1-5) + Y1=NRXFF(2,N1)+UTF(6*N1-4) + Z1=NRXFF(3,N1)+UTF(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXCF=FXCF+1 + FXFF(1,FXCF)=N1 + FXFF(2,FXCF)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + FXCFL=0 + DO I=1,NDFL + N1=NDLFL(1,I) + N2=NDLFL(2,I) + X1=NRXFFL(1,N1)+UTFL(6*N1-5) + Y1=NRXFFL(2,N1)+UTFL(6*N1-4) + Z1=NRXFFL(3,N1)+UTFL(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXCFL=FXCFL+1 + FXFFL(1,FXCFL)=N1 + FXFFL(2,FXCFL)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + FXCFR=0 + DO I=1,NDFR + N1=NDLFR(1,I) + N2=NDLFR(2,I) + X1=NRXFFR(1,N1)+UTFR(6*N1-5) + Y1=NRXFFR(2,N1)+UTFR(6*N1-4) + Z1=NRXFFR(3,N1)+UTFR(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXCFR=FXCFR+1 + FXFFR(1,FXCFR)=N1 + FXFFR(2,FXCFR)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN) THEN + FXCB=0 + DO I=1,NDB + N1=NDLB(1,I) + N2=NDLB(2,I) + X1=NRXFB(1,N1)+UTB(6*N1-5) + Y1=NRXFB(2,N1)+UTB(6*N1-4) + Z1=NRXFB(3,N1)+UTB(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXCB=FXCB+1 + FXFB(1,FXCB)=N1 + FXFB(2,FXCB)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + FXCBL=0 + DO I=1,NDBL + N1=NDLBL(1,I) + N2=NDLBL(2,I) + X1=NRXFBL(1,N1)+UTBL(6*N1-5) + Y1=NRXFBL(2,N1)+UTBL(6*N1-4) + Z1=NRXFBL(3,N1)+UTBL(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXCBL=FXCBL+1 + FXFBL(1,FXCBL)=N1 + FXFBL(2,FXCBL)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + FXCBR=0 + DO I=1,NDBR + N1=NDLBR(1,I) + N2=NDLBR(2,I) + X1=NRXFBR(1,N1)+UTBR(6*N1-5) + Y1=NRXFBR(2,N1)+UTBR(6*N1-4) + Z1=NRXFBR(3,N1)+UTBR(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXCBR=FXCBR+1 + FXFBR(1,FXCBR)=N1 + FXFBR(2,FXCBR)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + + + RETURN + END + + + + + + diff --git a/circ.f90 b/circ.f90 new file mode 100644 index 0000000..26dabe5 --- /dev/null +++ b/circ.f90 @@ -0,0 +1,410 @@ + SUBROUTINE CIRC(ND,NN,NRXF,UT,FRX,FRY,FRZ, & + T,IS,DT,WE,EFC,FXF,FXC,NDR,NCL,NDL, & + NDLL,NDLR,NRXFL,NRXFR,UTL,UTR,myid,ntasks,FXFL,FXFR,FXL,FXR, & + FXCF,FXFF,UTF,NRXFF,NDLF,NDF, & + FXCB,FXFB,UTB,NRXFB,NDLB,NDB,LNN,YN, & + NDFL,NDFR,NDBL,NDBR, & + FXCFR,FXCFL,FXCBR,FXCBL, & + NDLFL,NDLFR,NDLBL,NDLBR, & + UTFL,UTFR,UTBL,UTBR, & + NRXFBL,NRXFBR,NRXFFL,NRXFFR, & + FXFFR,FXFFL,FXFBR,FXFBL,SCL) + + IMPLICIT NONE + include 'mpif.h' + include 'param.dat' + REAL*8 X1,X2,Y1,Y2,Z1,Z2 + REAL*8 T1,T2 + REAL*8 NRXF(3,NOMA),NRXFR(3,NOMA),NRXFL(3,NOMA) + REAL*8 NRXFF(3,NOMA),NRXFB(3,NOMA),EFC(NOMA) + REAL*8 NRXFFL(3,NOMA),NRXFBL(3,NOMA) + REAL*8 NRXFFR(3,NOMA),NRXFBR(3,NOMA) + REAL*8 UT(NODM),UTR(NODM),UTL(NODM),UTB(NODM),UTF(NODM) + REAL*8 UTBL(NODM),UTFL(NODM),UTBR(NODM),UTFR(NODM) + REAL*8 SX,SY,SZ,SUM,T,WE(NOMA),L0 + REAL*8 DDEL,DWE,OWE,DT,ESUM,LNN + REAL*8 LS,LS2,DEL,SCL + INTEGER myid,ntasks,ierr,YN + INTEGER dest,source,tag,stat(MPI_STATUS_SIZE),comm + INTEGER FXF(2,NODC),NDL(2,NODC),NDLR(2,NODC),NDLL(2,NODC) + INTEGER NDLF(2,NODC),NDLB(2,NODC) + INTEGER NDLFL(2,NODC),NDLBL(2,NODC) + INTEGER NDLFR(2,NODC),NDLBR(2,NODC) + REAL*8 RC,RCX,RCY,RCZ,FRX(NOMA),FRY(NOMA),FRZ(NOMA) + INTEGER NTOT,I,N1,N2,ND,IS,NN,FXC,NCL,NDR,NDF,NDB + INTEGER NDFL,NDFR,NDBL,NDBR + INTEGER FXL,FXR,FXFR(2,NODC),FXFL(2,NODC) + INTEGER FXCF,FXCB,FXFB(2,NODC),FXFF(2,NODC) + INTEGER FXCFL,FXCBL,FXFBL(2,NODC),FXFFL(2,NODC) + INTEGER FXCFR,FXCBR,FXFBR(2,NODC),FXFFR(2,NODC) + + + DO I=1,NOMA + FRX(I)=0.0 + FRY(I)=0.0 + FRZ(I)=0.0 + WE(I)=0.0 + END DO + + FXC=0 + DO I=1,ND + N1=NDL(1,I) + N2=NDL(2,I) + X1=NRXF(1,N1)+UT(6*N1-5) + Y1=NRXF(2,N1)+UT(6*N1-4) + Z1=NRXF(3,N1)+UT(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N1)=FRX(N1)+EFC(N1)*(LNN-RC)**1.5*RCX + FRY(N1)=FRY(N1)+EFC(N1)*(LNN-RC)**1.5*RCY + FRZ(N1)=FRZ(N1)+EFC(N1)*(LNN-RC)**1.5*RCZ + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXC=FXC+1 + FXF(1,FXC)=N1 + FXF(2,FXC)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N1)=FRX(N1)+SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N1)=FRY(N1)+SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N1)=FRZ(N1)+SCL**2.0*1.0e+06*(LNN-RC)*RCZ + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + +c IF (myid.ne.0.and.myid.ne.(ntasks-1)/2+1) THEN + IF (MOD(myid,ntasks/YN).ne.0) THEN + FXL=0 + DO I=1,NCL + N1=NDLL(1,I) + N2=NDLL(2,I) + X1=NRXFL(1,N1)+UTL(6*N1-5) + Y1=NRXFL(2,N1)+UTL(6*N1-4) + Z1=NRXFL(3,N1)+UTL(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXL=FXL+1 + FXFL(1,FXL)=N1 + FXFL(2,FXL)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + +c IF (myid.ne.ntasks-1.and.myid.ne.(ntasks-1)/2) THEN + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + FXR=0 + DO I=1,NDR + N1=NDLR(1,I) + N2=NDLR(2,I) + X1=NRXFR(1,N1)+UTR(6*N1-5) + Y1=NRXFR(2,N1)+UTR(6*N1-4) + Z1=NRXFR(3,N1)+UTR(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN +! write(*,*) N1,N2,RC,LNN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXR=FXR+1 + FXFR(1,FXR)=N1 + FXFR(2,FXR)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + +c------------------------------------------------ + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + FXCF=0 + DO I=1,NDF + N1=NDLF(1,I) + N2=NDLF(2,I) + X1=NRXFF(1,N1)+UTF(6*N1-5) + Y1=NRXFF(2,N1)+UTF(6*N1-4) + Z1=NRXFF(3,N1)+UTF(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXCF=FXCF+1 + FXFF(1,FXCF)=N1 + FXFF(2,FXCF)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + FXCFL=0 + DO I=1,NDFL + N1=NDLFL(1,I) + N2=NDLFL(2,I) + X1=NRXFFL(1,N1)+UTFL(6*N1-5) + Y1=NRXFFL(2,N1)+UTFL(6*N1-4) + Z1=NRXFFL(3,N1)+UTFL(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXCFL=FXCFL+1 + FXFFL(1,FXCFL)=N1 + FXFFL(2,FXCFL)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + FXCFR=0 + DO I=1,NDFR + N1=NDLFR(1,I) + N2=NDLFR(2,I) + X1=NRXFFR(1,N1)+UTFR(6*N1-5) + Y1=NRXFFR(2,N1)+UTFR(6*N1-4) + Z1=NRXFFR(3,N1)+UTFR(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXCFR=FXCFR+1 + FXFFR(1,FXCFR)=N1 + FXFFR(2,FXCFR)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN) THEN + FXCB=0 + DO I=1,NDB + N1=NDLB(1,I) + N2=NDLB(2,I) + X1=NRXFB(1,N1)+UTB(6*N1-5) + Y1=NRXFB(2,N1)+UTB(6*N1-4) + Z1=NRXFB(3,N1)+UTB(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXCB=FXCB+1 + FXFB(1,FXCB)=N1 + FXFB(2,FXCB)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + FXCBL=0 + DO I=1,NDBL + N1=NDLBL(1,I) + N2=NDLBL(2,I) + X1=NRXFBL(1,N1)+UTBL(6*N1-5) + Y1=NRXFBL(2,N1)+UTBL(6*N1-4) + Z1=NRXFBL(3,N1)+UTBL(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXCBL=FXCBL+1 + FXFBL(1,FXCBL)=N1 + FXFBL(2,FXCBL)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + FXCBR=0 + DO I=1,NDBR + N1=NDLBR(1,I) + N2=NDLBR(2,I) + X1=NRXFBR(1,N1)+UTBR(6*N1-5) + Y1=NRXFBR(2,N1)+UTBR(6*N1-4) + Z1=NRXFBR(3,N1)+UTBR(6*N1-3) + X2=NRXF(1,N2)+UT(6*N2-5) + Y2=NRXF(2,N2)+UT(6*N2-4) + Z2=NRXF(3,N2)+UT(6*N2-3) + IF (ABS(X1-X2).LE.LNN.AND.ABS(Y1-Y2).LE.LNN.AND.ABS(Z1-Z2).LE.LNN) THEN + RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RCX=(X1-X2)/RC + RCY=(Y1-Y2)/RC + RCZ=(Z1-Z2)/RC + + IF (RC.LT.LNN) THEN + FRX(N2)=FRX(N2)-EFC(N2)*(LNN-RC)**1.5*RCX + FRY(N2)=FRY(N2)-EFC(N2)*(LNN-RC)**1.5*RCY + FRZ(N2)=FRZ(N2)-EFC(N2)*(LNN-RC)**1.5*RCZ + WE(N2)=WE(N2)+0.4*EFC(N2)*(LNN-RC)**2.5 + FXCBR=FXCBR+1 + FXFBR(1,FXCBR)=N1 + FXFBR(2,FXCBR)=N2 + ENDIF + + IF (RC.GT.LNN.AND.RC.LT.LNN+0.000*SCL) THEN + FRX(N2)=FRX(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCX + FRY(N2)=FRY(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCY + FRZ(N2)=FRZ(N2)-SCL**2.0*1.0e+06*(LNN-RC)*RCZ + WE(N2)=WE(N2)+SCL**2.0*0.5e+06*(LNN-RC)**2.0 + ENDIF + + ENDIF + ENDDO + ENDIF + + + RETURN + END + + + + + + diff --git a/crackt.f90 b/crackt.f90 new file mode 100644 index 0000000..c6ee1b2 --- /dev/null +++ b/crackt.f90 @@ -0,0 +1,142 @@ + SUBROUTINE CRACK(ntasks,NTOTW,PNN,PTR,PTB,YN) + + IMPLICIT NONE + INCLUDE 'param.dat' + INCLUDE 'na90.dat' + INTEGER I,N1,N2,NN,NTOT,NTOR,PTB(0:1000),PNN(0:1000),NTOTW(0:1000) + INTEGER CCN(50000000),CLUST(50000000),CN(50000000),SPN(10000) + INTEGER MAXI,MAXCN + REAL*8 STC,MN,TT,E + REAL*8 X1,Y1,Z1,X2,Y2,Z2 + INTEGER J,TTC,ntasks,my,PTR(0:1000),M1,M2,YN,IS,SNN + + OPEN(UNIT=112,FILE='frag',STATUS='UNKNOWN') + OPEN(UNIT=211,FILE='maxi',STATUS='UNKNOWN') + + 3 FORMAT(2F11.6,' ',2I6,' ',F11.6) + 4 FORMAT(3F15.6) + + IS=0 + DO my=0,ntasks-1 + SPN(my)=IS + DO I=1,PNN(my) + IS=IS+1 + CLUST(IS)=IS + CN(IS)=0 + CCN(IS)=0 + END DO + END DO + + + SNN=0 + DO my=0,ntasks-1 + OPEN(UNIT=117,FILE='FS'//na(my),STATUS='UNKNOWN') + DO I=1,NTOTW(my) + READ(117,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + N1=N1+SNN + N2=N2+SNN + IF (E.GT.0.0) THEN + M1=CLUST(N1) + M2=CLUST(N2) + MN=MIN(CLUST(N1),CLUST(N2)) + DO J=1+SNN,PNN(my)+SNN + IF (CLUST(J).EQ.M1.OR.CLUST(J).EQ.M2) CLUST(J)=MN + END DO + CLUST(N1)=MN + CLUST(N2)=MN + END IF + END DO + CLOSE(117) + SNN=SNN+PNN(my) + END DO + + DO my=0,ntasks-1 + OPEN(UNIT=117,FILE='FSR'//na(my),STATUS='UNKNOWN') + DO I=1,PTR(my) + READ(117,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + N1=N1+SPN(my+1) + N2=N2+SPN(my) + IF (E.GT.0.0) THEN + M1=CLUST(N1) + M2=CLUST(N2) + MN=MIN(CLUST(N1),CLUST(N2)) + DO J=1,IS + IF (CLUST(J).EQ.M1.OR.CLUST(J).EQ.M2) CLUST(J)=MN + END DO + CLUST(N1)=MN + CLUST(N2)=MN + END IF + END DO + CLOSE(117) + END DO + + DO my=0,ntasks-1 + OPEN(UNIT=117,FILE='FSB'//na(my),STATUS='UNKNOWN') + DO I=1,PTB(my) + READ(117,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + N1=N1+SPN(my-ntasks/YN) + N2=N2+SPN(my) + IF (E.GT.0.0) THEN + M1=CLUST(N1) + M2=CLUST(N2) + MN=MIN(CLUST(N1),CLUST(N2)) + DO J=1,IS + IF (CLUST(J).EQ.M1.OR.CLUST(J).EQ.M2) CLUST(J)=MN + END DO + CLUST(N1)=MN + CLUST(N2)=MN + END IF + END DO + CLOSE(117) + END DO + + DO I=1,IS + CN(CLUST(I))=CN(CLUST(I))+1 + END DO + + MAXCN=0 + DO I=1,IS + CCN(CN(I))=CCN(CN(I))+1 + IF (CN(I).GT.MAXCN) THEN + MAXCN=CN(I) + MAXI=I + ENDIF + END DO + + SNN=0 + DO my=0,ntasks-1 + OPEN(UNIT=117,FILE='NODFIL2'//na(my),STATUS='UNKNOWN') + DO I=1,PNN(my) + READ(117,*) N1,X1,Y1,Z1,E + N1=N1+SNN + IF (CLUST(N1).EQ.MAXI) WRITE(211,4) X1,Y1,Z1 + ENDDO + CLOSE(117) + SNN=SNN+PNN(my) + ENDDO + + + DO I=1,IS + IF (CCN(I).NE.0) WRITE(112,*) I,CCN(I) + END DO + + + TTC=0 + STC=0.0 + DO I=1,IS + TTC=TTC+CCN(I) + STC=STC+I*CCN(I) + END DO + STC=STC/(1.0*TTC) + WRITE(*,*) 'STC=',STC + + CLOSE(112) + CLOSE(211) + + RETURN + END + + + + + diff --git a/dist.f b/dist.f new file mode 100644 index 0000000..e7ac12c --- /dev/null +++ b/dist.f @@ -0,0 +1,281 @@ + SUBROUTINE DIST(NNA,UT,ND,NCL,NDR,NRXF, + 1 NDL,NDLL,NDLR,NRXFL,NRXFR,UTL,UTR,NRXFF, + 1 NRXFB,UTB,UTF,NDLF,NDLB,NDF,NDB,myid,ntasks,SCL,PNN,YN, + 1 NRXFBL,NRXFBR,NRXFFL,NRXFFR,NDLFL,NDLFR,NDLBR,NDLBL, + 1 NDFL,NDFR,NDBR,NDBL,UTBL,UTBR,UTFL,UTFR) + + IMPLICIT NONE + include 'mpif.h' + include 'param.dat' + REAL*8 NRXF(3,NOMA),UT(NODM) + REAL*8 NRXFR(3,NOMA),UTR(NODM) + REAL*8 NRXFL(3,NOMA),UTL(NODM) + REAL*8 NRXFB(3,NOMA),UTB(NODM) + REAL*8 NRXFF(3,NOMA),UTF(NODM) + REAL*8 NRXFBL(3,NOMA),UTBL(NODM) + REAL*8 NRXFBR(3,NOMA),UTBR(NODM) + REAL*8 NRXFFL(3,NOMA),UTFL(NODM) + REAL*8 NRXFFR(3,NOMA),UTFR(NODM) + REAL*8 DX1,DX2,DY1,DY2,DZ1,DZ2 + REAL*8 X1,X2,Y1,Y2,Z1,Z2 + REAL*8 RC,SCL,RT + INTEGER NCL,NDR,NDF,NDB + INTEGER NDFL,NDBL + INTEGER NDFR,NDBR + INTEGER dest,source,tag,stat(MPI_STATUS_SIZE),comm + INTEGER myid,ntasks,ierr,YN + INTEGER NNA,ND,I,J,PNN(0:5000) + INTEGER NDL(2,NODC),NDLR(2,NODC),NDLL(2,NODC) + INTEGER NDLF(2,NODC),NDLB(2,NODC) + INTEGER NDLFL(2,NODC),NDLBL(2,NODC) + INTEGER NDLFR(2,NODC),NDLBR(2,NODC) + + +c OPEN(UNIT=10,FILE='TSR',STATUS='UNKNOWN') +c OPEN(UNIT=11,FILE='TSL',STATUS='UNKNOWN') + + ND=0 + NDR=0 + NDB=0 + NDF=0 + NDBR=0 + NDFR=0 + NDBL=0 + NDFL=0 + NCL=0 + RT=SCL*SCL*3.5 + + DO 100 I=1,NNA-1 + DX1=UT(6*I-5) + DY1=UT(6*I-4) + DZ1=UT(6*I-3) + X1=NRXF(1,I)+DX1 + Y1=NRXF(2,I)+DY1 + Z1=NRXF(3,I)+DZ1 + DO J=I+1,NNA + DX2=UT(6*J-5) + DY2=UT(6*J-4) + DZ2=UT(6*J-3) + X2=NRXF(1,J)+DX2 + Y2=NRXF(2,J)+DY2 + Z2=NRXF(3,J)+DZ2 + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.RT) THEN + ND=ND+1 + NDL(1,ND)=I + NDL(2,ND)=J + ENDIF + END DO + 100 CONTINUE + + IF (MOD(myid,ntasks/YN).ne.0) THEN + DO I=1,PNN(myid-1) + DX1=UTL(6*I-5) + DY1=UTL(6*I-4) + DZ1=UTL(6*I-3) + X1=NRXFL(1,I)+DX1 + Y1=NRXFL(2,I)+DY1 + Z1=NRXFL(3,I)+DZ1 + DO J=1,NNA + DX2=UT(6*J-5) + DY2=UT(6*J-4) + DZ2=UT(6*J-3) + X2=NRXF(1,J)+DX2 + Y2=NRXF(2,J)+DY2 + Z2=NRXF(3,J)+DZ2 + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.RT) THEN + NCL=NCL+1 + NDLL(1,NCL)=I + NDLL(2,NCL)=J + ENDIF + END DO + END DO + END IF + + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO I=1,PNN(myid+1) + DX1=UTR(6*I-5) + DY1=UTR(6*I-4) + DZ1=UTR(6*I-3) + X1=NRXFR(1,I)+DX1 + Y1=NRXFR(2,I)+DY1 + Z1=NRXFR(3,I)+DZ1 + DO J=1,NNA + DX2=UT(6*J-5) + DY2=UT(6*J-4) + DZ2=UT(6*J-3) + X2=NRXF(1,J)+DX2 + Y2=NRXF(2,J)+DY2 + Z2=NRXF(3,J)+DZ2 + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.RT) THEN + NDR=NDR+1 + NDLR(1,NDR)=I + NDLR(2,NDR)=J + ENDIF + END DO + END DO + END IF + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + DO I=1,PNN(myid+ntasks/YN) + DX1=UTF(6*I-5) + DY1=UTF(6*I-4) + DZ1=UTF(6*I-3) + X1=NRXFF(1,I)+DX1 + Y1=NRXFF(2,I)+DY1 + Z1=NRXFF(3,I)+DZ1 + DO J=1,NNA + DX2=UT(6*J-5) + DY2=UT(6*J-4) + DZ2=UT(6*J-3) + X2=NRXF(1,J)+DX2 + Y2=NRXF(2,J)+DY2 + Z2=NRXF(3,J)+DZ2 + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.RT) THEN + NDF=NDF+1 + NDLF(1,NDF)=I + NDLF(2,NDF)=J + ENDIF + END DO + END DO + END IF + + + IF (myid.ge.ntasks/YN) THEN + DO I=1,PNN(myid-ntasks/YN) + DX1=UTB(6*I-5) + DY1=UTB(6*I-4) + DZ1=UTB(6*I-3) + X1=NRXFB(1,I)+DX1 + Y1=NRXFB(2,I)+DY1 + Z1=NRXFB(3,I)+DZ1 + DO J=1,NNA + DX2=UT(6*J-5) + DY2=UT(6*J-4) + DZ2=UT(6*J-3) + X2=NRXF(1,J)+DX2 + Y2=NRXF(2,J)+DY2 + Z2=NRXF(3,J)+DZ2 + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.RT) THEN + NDB=NDB+1 + NDLB(1,NDB)=I + NDLB(2,NDB)=J + ENDIF + END DO + END DO + END IF + + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO I=1,PNN(myid-ntasks/YN-1) + DX1=UTBL(6*I-5) + DY1=UTBL(6*I-4) + DZ1=UTBL(6*I-3) + X1=NRXFBL(1,I)+DX1 + Y1=NRXFBL(2,I)+DY1 + Z1=NRXFBL(3,I)+DZ1 + DO J=1,NNA + DX2=UT(6*J-5) + DY2=UT(6*J-4) + DZ2=UT(6*J-3) + X2=NRXF(1,J)+DX2 + Y2=NRXF(2,J)+DY2 + Z2=NRXF(3,J)+DZ2 + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.RT) THEN + NDBL=NDBL+1 + NDLBL(1,NDBL)=I + NDLBL(2,NDBL)=J + ENDIF + END DO + END DO + END IF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO I=1,PNN(myid-ntasks/YN+1) + DX1=UTBR(6*I-5) + DY1=UTBR(6*I-4) + DZ1=UTBR(6*I-3) + X1=NRXFBR(1,I)+DX1 + Y1=NRXFBR(2,I)+DY1 + Z1=NRXFBR(3,I)+DZ1 + DO J=1,NNA + DX2=UT(6*J-5) + DY2=UT(6*J-4) + DZ2=UT(6*J-3) + X2=NRXF(1,J)+DX2 + Y2=NRXF(2,J)+DY2 + Z2=NRXF(3,J)+DZ2 + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.RT) THEN + NDBR=NDBR+1 + NDLBR(1,NDBR)=I + NDLBR(2,NDBR)=J + ENDIF + END DO + END DO + END IF + + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO I=1,PNN(myid+ntasks/YN-1) + DX1=UTFL(6*I-5) + DY1=UTFL(6*I-4) + DZ1=UTFL(6*I-3) + X1=NRXFFL(1,I)+DX1 + Y1=NRXFFL(2,I)+DY1 + Z1=NRXFFL(3,I)+DZ1 + DO J=1,NNA + DX2=UT(6*J-5) + DY2=UT(6*J-4) + DZ2=UT(6*J-3) + X2=NRXF(1,J)+DX2 + Y2=NRXF(2,J)+DY2 + Z2=NRXF(3,J)+DZ2 + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.RT) THEN + NDFL=NDFL+1 + NDLFL(1,NDFL)=I + NDLFL(2,NDFL)=J + ENDIF + END DO + END DO + END IF + + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO I=1,PNN(myid+ntasks/YN+1) + DX1=UTFR(6*I-5) + DY1=UTFR(6*I-4) + DZ1=UTFR(6*I-3) + X1=NRXFFR(1,I)+DX1 + Y1=NRXFFR(2,I)+DY1 + Z1=NRXFFR(3,I)+DZ1 + DO J=1,NNA + DX2=UT(6*J-5) + DY2=UT(6*J-4) + DZ2=UT(6*J-3) + X2=NRXF(1,J)+DX2 + Y2=NRXF(2,J)+DY2 + Z2=NRXF(3,J)+DZ2 + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.RT) THEN + NDFR=NDFR+1 + NDLFR(1,NDFR)=I + NDLFR(2,NDFR)=J + ENDIF + END DO + END DO + END IF + + RETURN + END + + + + + diff --git a/dt.f b/dt.f new file mode 100644 index 0000000..cee5fb3 --- /dev/null +++ b/dt.f @@ -0,0 +1,431 @@ + SUBROUTINE DT(NNA,NRXF,ND,NDLC,NDRC,NDFC,NDBC,NDFRC,NDBRC,NDFLC,NDBLC + 1 ,myid,ntasks,SCL,YN) + + IMPLICIT NONE + include 'mpif.h' + include 'param.dat' + include 'na.dat' + REAL*8 NRXF(3,NOMA),NRXFL(3,NOMA),NRXFR(3,NOMA) + REAL*8 NRXFB(3,NOMA),NRXFF(3,NOMA) + REAL*8 NRXFBL(3,NOMA),NRXFFL(3,NOMA) + REAL*8 NRXFBR(3,NOMA),NRXFFR(3,NOMA) + REAL*8 X1,X2,Y1,Y2,Z1,Z2,RC,SCL,NCN(NOMA) + INTEGER NNA,ND,I,J,PNN(0:5000) + INTEGER NDRC,NDLC,NDFC,NDBC,YN + INTEGER NDFRC,NDBRC,NDFLC,NDBLC + INTEGER dest,source,tag,stat(MPI_STATUS_SIZE),comm + INTEGER myid,ntasks,ierr +c CHARACTER*3 na(0:128) +c data na/ +c 1 '000','001','002','003','004','005','006','007','008', +c 1 '009','010','011','012','013','014','015','016','017', +c 1 '018','019','020','021','022','023','024','025','026', +c 1 '027','028','029','030','031','032','033','034','035', +c 1 '036','037','038','039','040','041','042','043','044', +c 1 '045','046','047','048','049','050','051','052','053', +c 1 '054','055','056','057','058','059','060','061','062', +c 1 '063','064','065','066','067','068','069','070','071', +c 1 '072','073','074','075','076','077','078','079','080', +c 1 '081','082','083','084','085','086','087','088','089', +c 1 '090','091','092','093','094','095','096','097','098', +c 1 '099','100','101','102','103','104','105','106','107', +c 1 '108','109','110','111','112','113','114','115','116', +c 1 '117','118','119','120','121','122','123','124','125', +c 1 '126','127','128'/ + + + 11 FORMAT(2I8,' ',7F18.8) + 12 FORMAT(6F18.8) + + OPEN(UNIT=210+myid,FILE='FS'//na(myid),STATUS='UNKNOWN') + OPEN(UNIT=310+myid,FILE='FSL'//na(myid),STATUS='UNKNOWN') + OPEN(UNIT=410+myid,FILE='FSR'//na(myid),STATUS='UNKNOWN') + + CALL MPI_ALLGATHER(NNA,1,MPI_INTEGER, + 1 PNN,1,MPI_INTEGER,MPI_COMM_WORLD,ierr) + + ND=0 + NDLC=0 + NDRC=0 + + DO I=1,NOMA + NCN(I)=0 + ENDDO + + DO I=1,NNA-1 + X1=NRXF(1,I) + Y1=NRXF(2,I) + Z1=NRXF(3,I) + IF (Z1.GT.70.0*(3000.0-Y1)**0.2.OR.Y1.GT.3000.0) THEN + DO J=I+1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) +c RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + ND=ND+1 + write(210+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +c write(210+myid,*) X1,Y1,Z1 +c write(210+myid,*) X2,Y2,Z2 +c write(210+myid,*) + NCN(I)=NCN(I)+1 + NCN(J)=NCN(J)+1 + ENDIF + END DO + ENDIF + END DO + + + dest=myid+1 + source=myid-1 + + tag=32 + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(NRXFL,3*NOMA,MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-1 + source=myid+1 + + tag=33 + IF (MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(NRXFR,3*NOMA,MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + +c IF (myid.ne.0.and.myid.ne.(ntasks-1)/2+1) THEN + IF (MOD(myid,ntasks/YN).ne.0) THEN + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + IF (Z2.GT.70.0*(3000.0-Y2)**0.2.OR.Y2.GT.3000.0) THEN + DO I=1,PNN(myid-1) + X1=NRXFL(1,I) + Y1=NRXFL(2,I) + Z1=NRXFL(3,I) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDLC=NDLC+1 + write(310+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +c write(310+myid,*) X1,Y1,Z1 +c write(310+myid,*) X2,Y2,Z2 +c write(310+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + ENDIF + END DO + END IF + +c IF (myid.ne.ntasks-1.and.myid.ne.(ntasks-1)/2) THEN + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO I=1,PNN(myid+1) + X1=NRXFR(1,I) + Y1=NRXFR(2,I) + Z1=NRXFR(3,I) + IF (Z1.GT.70.0*(3000.0-Y1)**0.2.OR.Y1.GT.3000.0) THEN + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDRC=NDRC+1 + write(410+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +c write(410+myid,*) X1,Y1,Z1 +c write(410+myid,*) X2,Y2,Z2 +c write(410+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + ENDIF + END DO + END IF + + CLOSE (210+myid) + CLOSE (310+myid) + CLOSE (410+myid) + + + OPEN(UNIT=310+myid,FILE='FSB'//na(myid),STATUS='UNKNOWN') + OPEN(UNIT=410+myid,FILE='FSF'//na(myid),STATUS='UNKNOWN') + + + NDFC=0 + NDBC=0 + + dest=myid+ntasks/YN + source=myid-ntasks/YN + + tag=34 + IF (myid.lt.(YN-1)*ntasks/YN) + 1CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN) + 1CALL MPI_Recv(NRXFB,3*NOMA,MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN + source=myid+ntasks/YN + + tag=35 + IF (myid.ge.ntasks/YN) + 1CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN) + 1CALL MPI_Recv(NRXFF,3*NOMA,MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + + IF (myid.ge.ntasks/YN) THEN + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + IF (Z2.GT.70.0*(3000.0-Y2)**0.2.OR.Y2.GT.3000.0) THEN + DO I=1,PNN(myid-ntasks/YN) + X1=NRXFB(1,I) + Y1=NRXFB(2,I) + Z1=NRXFB(3,I) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDBC=NDBC+1 + write(310+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +c write(310+myid,*) X1,Y1,Z1 +c write(310+myid,*) X2,Y2,Z2 +c write(310+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + ENDIF + END DO + END IF + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + DO I=1,PNN(ntasks/YN+myid) + X1=NRXFF(1,I) + Y1=NRXFF(2,I) + Z1=NRXFF(3,I) + IF (Z1.GT.70.0*(3000.0-Y1)**0.2.OR.Y1.GT.3000.0) THEN + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDFC=NDFC+1 + write(410+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +c write(410+myid,*) X1,Y1,Z1 +c write(410+myid,*) X2,Y2,Z2 +c write(410+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + ENDIF + END DO + END IF + +c write(*,*) 'NDR',NDRC,myid +c write(*,*) 'NDL',NDLC,myid +c write(*,*) 'ND',ND,myid + + CLOSE (310+myid) + CLOSE (410+myid) + + + OPEN(UNIT=310+myid,FILE='FSBR'//na(myid),STATUS='UNKNOWN') + OPEN(UNIT=410+myid,FILE='FSFR'//na(myid),STATUS='UNKNOWN') + + + NDFRC=0 + NDBRC=0 + + dest=myid+ntasks/YN-1 + source=myid-ntasks/YN+1 + + tag=36 + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(NRXFBR,3*NOMA,MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN-1 + source=myid+ntasks/YN+1 + + tag=37 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(NRXFFR,3*NOMA,MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + IF (Z2.GT.70.0*(3000.0-Y2)**0.2.OR.Y2.GT.3000.0) THEN + DO I=1,PNN(myid-ntasks/YN+1) + X1=NRXFBR(1,I) + Y1=NRXFBR(2,I) + Z1=NRXFBR(3,I) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDBRC=NDBRC+1 + write(310+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +c write(310+myid,*) X1,Y1,Z1 +c write(310+myid,*) X2,Y2,Z2 +c write(310+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + ENDIF + END DO + END IF + + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO I=1,PNN(myid+ntasks/YN+1) + X1=NRXFFR(1,I) + Y1=NRXFFR(2,I) + Z1=NRXFFR(3,I) + IF (Z1.GT.70.0*(3000.0-Y1)**0.2.OR.Y1.GT.3000.0) THEN + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDFRC=NDFRC+1 + write(410+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +c write(410+myid,*) X1,Y1,Z1 +c write(410+myid,*) X2,Y2,Z2 +c write(410+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + ENDIF + END DO + END IF + +c write(*,*) 'NDR',NDRC,myid +c write(*,*) 'NDL',NDLC,myid +c write(*,*) 'ND',ND,myid + + CLOSE (310+myid) + CLOSE (410+myid) + + OPEN(UNIT=310+myid,FILE='FSBL'//na(myid),STATUS='UNKNOWN') + OPEN(UNIT=410+myid,FILE='FSFL'//na(myid),STATUS='UNKNOWN') + + + NDFLC=0 + NDBLC=0 + + dest=myid+ntasks/YN+1 + source=myid-ntasks/YN-1 + + tag=38 + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(NRXFBL,3*NOMA,MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN+1 + source=myid+ntasks/YN-1 + + tag=39 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(NRXFFL,3*NOMA,MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + IF (Z2.GT.70.0*(3000.0-Y2)**0.2.OR.Y2.GT.3000.0) THEN + DO I=1,PNN(myid-ntasks/YN-1) + X1=NRXFBL(1,I) + Y1=NRXFBL(2,I) + Z1=NRXFBL(3,I) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDBLC=NDBLC+1 + write(310+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +c write(310+myid,*) X1,Y1,Z1 +c write(310+myid,*) X2,Y2,Z2 +c write(310+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + ENDIF + END DO + END IF + + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO I=1,PNN(myid+ntasks/YN-1) + X1=NRXFFL(1,I) + Y1=NRXFFL(2,I) + Z1=NRXFFL(3,I) + IF (Z1.GT.70.0*(3000.0-Y1)**0.2.OR.Y1.GT.3000.0) THEN + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDFLC=NDFLC+1 + write(410+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +c write(410+myid,*) X1,Y1,Z1 +c write(410+myid,*) X2,Y2,Z2 +c write(410+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + ENDIF + END DO + END IF + +c write(*,*) 'NDR',NDRC,myid +c write(*,*) 'NDL',NDLC,myid +c write(*,*) 'ND',ND,myid + + CLOSE (310+myid) + CLOSE (410+myid) + + OPEN(UNIT=410+myid,FILE='NCN'//na(myid),STATUS='UNKNOWN') + + DO I=1,NNA + write(410+myid,*) NRXF(3,I), NCN(I) + ENDDO + + + RETURN + END + + + + + diff --git a/dt.f90 b/dt.f90 new file mode 100644 index 0000000..0408141 --- /dev/null +++ b/dt.f90 @@ -0,0 +1,394 @@ + SUBROUTINE DT(NNA,NRXF,ND,NDLC,NDRC,NDFC,NDBC,NDFRC,NDBRC,NDFLC,NDBLC,myid,ntasks,SCL,YN) + + IMPLICIT NONE + include 'mpif.h' + include 'param.dat' + include 'na90.dat' + REAL*8 NRXF(3,NOMA),NRXFL(3,NOMA),NRXFR(3,NOMA) + REAL*8 NRXFB(3,NOMA),NRXFF(3,NOMA) + REAL*8 NRXFBL(3,NOMA),NRXFFL(3,NOMA) + REAL*8 NRXFBR(3,NOMA),NRXFFR(3,NOMA) + REAL*8 X1,X2,Y1,Y2,Z1,Z2,RC,SCL,NCN(NOMA) + INTEGER NNA,ND,I,J,PNN(0:5000) + INTEGER NDRC,NDLC,NDFC,NDBC,YN + INTEGER NDFRC,NDBRC,NDFLC,NDBLC + INTEGER dest,source,tag,stat(MPI_STATUS_SIZE),comm + INTEGER myid,ntasks,ierr + + + 11 FORMAT(2I8,' ',7F18.8) + 12 FORMAT(6F18.8) + + OPEN(UNIT=210+myid,FILE='FS'//na(myid),STATUS='UNKNOWN') + OPEN(UNIT=310+myid,FILE='FSL'//na(myid),STATUS='UNKNOWN') + OPEN(UNIT=410+myid,FILE='FSR'//na(myid),STATUS='UNKNOWN') + + CALL MPI_ALLGATHER(NNA,1,MPI_INTEGER,PNN,1,MPI_INTEGER,MPI_COMM_WORLD,ierr) + + ND=0 + NDLC=0 + NDRC=0 + + DO I=1,NOMA + NCN(I)=0 + ENDDO + + DO I=1,NNA-1 + DO J=I+1,NNA + X1=NRXF(1,I) + Y1=NRXF(2,I) + Z1=NRXF(3,I) + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) +! RC=SQRT((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + ND=ND+1 + write(210+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +! write(210+myid,*) X1,Y1,Z1 +! write(210+myid,*) X2,Y2,Z2 +! write(210+myid,*) + NCN(I)=NCN(I)+1 + NCN(J)=NCN(J)+1 + ENDIF + END DO + END DO + + + dest=myid+1 + source=myid-1 + + tag=32 + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Recv(NRXFL,3*NOMA,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-1 + source=myid+1 + + tag=33 + IF (MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Recv(NRXFR,3*NOMA,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + +! IF (myid.ne.0.and.myid.ne.(ntasks-1)/2+1) THEN + IF (MOD(myid,ntasks/YN).ne.0) THEN + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + DO I=1,PNN(myid-1) + X1=NRXFL(1,I) + Y1=NRXFL(2,I) + Z1=NRXFL(3,I) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDLC=NDLC+1 + write(310+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +! write(310+myid,*) X1,Y1,Z1 +! write(310+myid,*) X2,Y2,Z2 +! write(310+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + END DO + END IF + +! IF (myid.ne.ntasks-1.and.myid.ne.(ntasks-1)/2) THEN + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO I=1,PNN(myid+1) + X1=NRXFR(1,I) + Y1=NRXFR(2,I) + Z1=NRXFR(3,I) + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDRC=NDRC+1 + write(410+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +! write(410+myid,*) X1,Y1,Z1 +! write(410+myid,*) X2,Y2,Z2 +! write(410+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + END DO + END IF + + CLOSE (210+myid) + CLOSE (310+myid) + CLOSE (410+myid) + + + OPEN(UNIT=310+myid,FILE='FSB'//na(myid),STATUS='UNKNOWN') + OPEN(UNIT=410+myid,FILE='FSF'//na(myid),STATUS='UNKNOWN') + + + NDFC=0 + NDBC=0 + + dest=myid+ntasks/YN + source=myid-ntasks/YN + + tag=34 + IF (myid.lt.(YN-1)*ntasks/YN)& + CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN)& + CALL MPI_Recv(NRXFB,3*NOMA,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN + source=myid+ntasks/YN + + tag=35 + IF (myid.ge.ntasks/YN)& + CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN)& + CALL MPI_Recv(NRXFF,3*NOMA,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + + IF (myid.ge.ntasks/YN) THEN + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + DO I=1,PNN(myid-ntasks/YN) + X1=NRXFB(1,I) + Y1=NRXFB(2,I) + Z1=NRXFB(3,I) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDBC=NDBC+1 + write(310+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +! write(310+myid,*) X1,Y1,Z1 +! write(310+myid,*) X2,Y2,Z2 +! write(310+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + END DO + END IF + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + DO I=1,PNN(ntasks/YN+myid) + X1=NRXFF(1,I) + Y1=NRXFF(2,I) + Z1=NRXFF(3,I) + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDFC=NDFC+1 + write(410+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +! write(410+myid,*) X1,Y1,Z1 +! write(410+myid,*) X2,Y2,Z2 +! write(410+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + END DO + END IF + +! write(*,*) 'NDR',NDRC,myid +! write(*,*) 'NDL',NDLC,myid +! write(*,*) 'ND',ND,myid + + CLOSE (310+myid) + CLOSE (410+myid) + + + OPEN(UNIT=310+myid,FILE='FSBR'//na(myid),STATUS='UNKNOWN') + OPEN(UNIT=410+myid,FILE='FSFR'//na(myid),STATUS='UNKNOWN') + + + NDFRC=0 + NDBRC=0 + + dest=myid+ntasks/YN-1 + source=myid-ntasks/YN+1 + + tag=36 + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Recv(NRXFBR,3*NOMA,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN-1 + source=myid+ntasks/YN+1 + + tag=37 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN& + .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Recv(NRXFFR,3*NOMA,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + DO I=1,PNN(myid-ntasks/YN+1) + X1=NRXFBR(1,I) + Y1=NRXFBR(2,I) + Z1=NRXFBR(3,I) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDBRC=NDBRC+1 + write(310+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +! write(310+myid,*) X1,Y1,Z1 +! write(310+myid,*) X2,Y2,Z2 +! write(310+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + END DO + END IF + + IF (myid.lt.(YN-1)*ntasks/YN& + .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO I=1,PNN(myid+ntasks/YN+1) + X1=NRXFFR(1,I) + Y1=NRXFFR(2,I) + Z1=NRXFFR(3,I) + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDFRC=NDFRC+1 + write(410+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +! write(410+myid,*) X1,Y1,Z1 +! write(410+myid,*) X2,Y2,Z2 +! write(410+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + END DO + END IF + +! write(*,*) 'NDR',NDRC,myid +! write(*,*) 'NDL',NDLC,myid +! write(*,*) 'ND',ND,myid + + CLOSE (310+myid) + CLOSE (410+myid) + + OPEN(UNIT=310+myid,FILE='FSBL'//na(myid),STATUS='UNKNOWN') + OPEN(UNIT=410+myid,FILE='FSFL'//na(myid),STATUS='UNKNOWN') + + + NDFLC=0 + NDBLC=0 + + dest=myid+ntasks/YN+1 + source=myid-ntasks/YN-1 + + tag=38 + IF (myid.lt.(YN-1)*ntasks/YN& + .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Recv(NRXFBL,3*NOMA,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN+1 + source=myid+ntasks/YN-1 + + tag=39 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Send(NRXF,3*NOMA,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Recv(NRXFFL,3*NOMA,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + DO I=1,PNN(myid-ntasks/YN-1) + X1=NRXFBL(1,I) + Y1=NRXFBL(2,I) + Z1=NRXFBL(3,I) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDBLC=NDBLC+1 + write(310+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +! write(310+myid,*) X1,Y1,Z1 +! write(310+myid,*) X2,Y2,Z2 +! write(310+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + END DO + END IF + + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO I=1,PNN(myid+ntasks/YN-1) + X1=NRXFFL(1,I) + Y1=NRXFFL(2,I) + Z1=NRXFFL(3,I) + DO J=1,NNA + X2=NRXF(1,J) + Y2=NRXF(2,J) + Z2=NRXF(3,J) + RC=((X1-X2)**2.0+(Y1-Y2)**2.0+(Z1-Z2)**2.0) + IF (RC.LT.SCL*SCL*1.6) THEN + NDFLC=NDFLC+1 + write(410+myid,11) I,J,X1,Y1,Z1,X2,Y2,Z2,1.0 +! write(410+myid,*) X1,Y1,Z1 +! write(410+myid,*) X2,Y2,Z2 +! write(410+myid,*) + NCN(J)=NCN(J)+1 + ENDIF + END DO + END DO + END IF + +! write(*,*) 'NDR',NDRC,myid +! write(*,*) 'NDL',NDLC,myid +! write(*,*) 'ND',ND,myid + + CLOSE (310+myid) + CLOSE (410+myid) + +! OPEN(UNIT=410+myid,FILE='NCN'//na(myid),STATUS='UNKNOWN') + +! DO I=1,NNA +! write(410+myid,*) NRXF(3,I), NCN(I) +! ENDDO + + + RETURN + END + + + + + diff --git a/effload.f b/effload.f new file mode 100644 index 0000000..aaf0957 --- /dev/null +++ b/effload.f @@ -0,0 +1,2267 @@ + SUBROUTINE EFFLOAD1(S,NTOT,NN,T,DT,M,JS,UT,UTM,R,EN,RY, + 1 FXF,FXC,VDP,DPE,EF,EFL,EFR,NAN,NRXF,MFIL,CT,NANL,NANR,NTOL, + 1 NTOR,NRXFL,NRXFR,UTL,UTR,myid,ntasks,FXL,FXFL,FXR,FXFR,L, + 1 NTOF,NTOB,NRXFF,NRXFB,UTF,UTB,EFF,EFB, + 1 FXCF,FXFF,FXCB,FXFB,NANB,NANF,PNN,YN, + 1 NANFL,NANFR,NANBL,NANBR, + 1 NRXFFL,NRXFFR,NRXFBL,NRXFBR, + 1 UTFL,UTFR,UTBL,UTBR, + 1 EFFL,EFFR,EFBL,EFBR, + 1 NTOFL,NTOFR,NTOBL,NTOBR, + 1 FXCFL,FXFFL,FXCBL,FXFBL, + 1 FXCFR,FXFFR,FXCBR,FXFBR) + + IMPLICIT NONE + include 'mpif.h' + include 'param.dat' + REAL*8 MFIL(NOMA),NRXF(3,NOMA),VDP(NOMA) + REAL*8 NRXFL(3,NOMA),NRXFR(3,NOMA) + REAL*8 NRXFF(3,NOMA),NRXFB(3,NOMA) + REAL*8 NRXFFL(3,NOMA),NRXFBL(3,NOMA) + REAL*8 NRXFFR(3,NOMA),NRXFBR(3,NOMA) + REAL*8 UTF(NODM),UTB(NODM) + REAL*8 UTFL(NODM),UTBL(NODM) + REAL*8 UTFR(NODM),UTBR(NODM) + REAL*8 A(NODM),C(NODM),F(NODM) + REAL*8 UT(NODM),UTM(NODM),EF(NOCON),EFL(NOCON) + REAL*8 UTL(NODM),UTML(NODM),EFR(NOCON) + REAL*8 UTR(NODM),UTMR(NODM),LNN,UTMB(NODM),UTMF(NODM) + REAL*8 UTMBL(NODM),UTMFL(NODM),UTMBR(NODM),UTMFR(NODM) + REAL*8 DUT(NODM),CT(NODC),EN(NODM),R(NODM) + INTEGER FXF(2,NODC),FXFL(2,NODC),FXFR(2,NODC) + INTEGER FXFF(2,NODC),FXFB(2,NODC),YN + INTEGER FXFFL(2,NODC),FXFBL(2,NODC) + INTEGER FXFFR(2,NODC),FXFBR(2,NODC) + REAL*8 DPE,S,E,EFB(NOCON),EFF(NOCON) + REAL*8 EFBL(NOCON),EFFL(NOCON) + REAL*8 EFBR(NOCON),EFFR(NOCON) + REAL*8 T,DT,M,JS,L,ALF + REAL*8 G,X1,Y1,Z1,X2,Y2,Z2,TT(12,12) + REAL*8 DX1,DY1,DZ1,DX2,DY2,DZ2 + REAL*8 DP,DP2 + INTEGER NTOT,N,NL,NB,N1,N2,X,XL,XR,PNN(0:5000) + INTEGER I,J,NN,RY,FXC,FXL,FXR,FXCF,FXCB,NAN(3,NOCON) + INTEGER FXCFL,FXCBL,FXCFR,FXCBR + INTEGER NANL(3,NOMA),NANR(3,NOMA),NTOL,NTOR + INTEGER NANF(3,NOMA),NANB(3,NOMA),NTOF,NTOB + INTEGER NTOFL,NTOFR,NTOBL,NTOBR + INTEGER NANFL(3,NOMA),NANBL(3,NOMA) + INTEGER NANFR(3,NOMA),NANBR(3,NOMA) + INTEGER dest,source,tag,stat(MPI_STATUS_SIZE),comm + INTEGER myid,ntasks,ierr + + DO I=1,6*NN + A(I)=0.0 + END DO + + DO 60 X=1,NTOT + N1=NAN(1,X) + N2=NAN(2,X) + X1=NRXF(1,N1) + Y1=NRXF(2,N1) + Z1=NRXF(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + + + DX1=UT(6*N1-5) + DY1=UT(6*N1-4) + DZ1=UT(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + + DUT(6*N1-5)=UT(6*N1-5)-UTM(6*N1-5) + DUT(6*N1-4)=UT(6*N1-4)-UTM(6*N1-4) + DUT(6*N1-3)=UT(6*N1-3)-UTM(6*N1-3) + DUT(6*N1-2)=UT(6*N1-2)-UTM(6*N1-2) + DUT(6*N1-1)=UT(6*N1-1)-UTM(6*N1-1) + DUT(6*N1-0)=UT(6*N1-0)-UTM(6*N1-0) + + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + + IF (EF(X).NE.0.0) THEN + CALL AMAT(EF(X),S,EF(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,X,RY,CT) + ELSE + CT(12*X-11)=0.0 + CT(12*X-10)=0.0 + CT(12*X-9)=0.0 + CT(12*X-8)=0.0 + CT(12*X-7)=0.0 + CT(12*X-6)=0.0 + CT(12*X-5)=0.0 + CT(12*X-4)=0.0 + CT(12*X-3)=0.0 + CT(12*X-2)=0.0 + CT(12*X-1)=0.0 + CT(12*X-0)=0.0 + ENDIF + +60 CONTINUE + + dest=myid+1 + source=myid-1 + tag=133 + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTML,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-1 + source=myid+1 + tag=135 + IF (MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN + source=myid-ntasks/YN + tag=137 + IF (myid.lt.(YN-1)*ntasks/YN) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN) + 1CALL MPI_Recv(UTMB,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN+1 + source=myid-ntasks/YN-1 + tag=139 + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTMBL,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN-1 + source=myid-ntasks/YN+1 + tag=141 + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMBR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN + source=myid+ntasks/YN + tag=143 + IF (myid.ge.ntasks/YN) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN) + 1CALL MPI_Recv(UTMF,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN+1 + source=myid+ntasks/YN-1 + tag=145 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTMFL,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN-1 + source=myid+ntasks/YN+1 + tag=147 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMFR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + +c------------------------------------------------------ + IF (MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOL + XL=NTOT+X + N1=NANL(1,X) + N2=NANL(2,X) + X1=NRXFL(1,N1) + Y1=NRXFL(2,N1) + Z1=NRXFL(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTL(6*N1-5) + DY1=UTL(6*N1-4) + DZ1=UTL(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTL(6*N1-5)-UTML(6*N1-5) + DUT(6*N1-4)=UTL(6*N1-4)-UTML(6*N1-4) + DUT(6*N1-3)=UTL(6*N1-3)-UTML(6*N1-3) + DUT(6*N1-2)=UTL(6*N1-2)-UTML(6*N1-2) + DUT(6*N1-1)=UTL(6*N1-1)-UTML(6*N1-1) + DUT(6*N1-0)=UTL(6*N1-0)-UTML(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFL(X).NE.0.0) THEN + CALL AMAT(EFL(X),S,EFL(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XL,RY,CT) + ELSE + CT(12*XL-11)=0.0 + CT(12*XL-10)=0.0 + CT(12*XL-9)=0.0 + CT(12*XL-8)=0.0 + CT(12*XL-7)=0.0 + CT(12*XL-6)=0.0 + CT(12*XL-5)=0.0 + CT(12*XL-4)=0.0 + CT(12*XL-3)=0.0 + CT(12*XL-2)=0.0 + CT(12*XL-1)=0.0 + CT(12*XL-0)=0.0 + ENDIF + ENDDO + ENDIF + + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOR + XR=NTOT+NTOL+X + N1=NANR(1,X) + N2=NANR(2,X) + X1=NRXFR(1,N1) + Y1=NRXFR(2,N1) + Z1=NRXFR(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTR(6*N1-5) + DY1=UTR(6*N1-4) + DZ1=UTR(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTR(6*N1-5)-UTMR(6*N1-5) + DUT(6*N1-4)=UTR(6*N1-4)-UTMR(6*N1-4) + DUT(6*N1-3)=UTR(6*N1-3)-UTMR(6*N1-3) + DUT(6*N1-2)=UTR(6*N1-2)-UTMR(6*N1-2) + DUT(6*N1-1)=UTR(6*N1-1)-UTMR(6*N1-1) + DUT(6*N1-0)=UTR(6*N1-0)-UTMR(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFR(X).NE.0.0) THEN + CALL AMAT(EFR(X),S,EFR(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XR,RY,CT) + ELSE + CT(12*XR-11)=0.0 + CT(12*XR-10)=0.0 + CT(12*XR-9)=0.0 + CT(12*XR-8)=0.0 + CT(12*XR-7)=0.0 + CT(12*XR-6)=0.0 + CT(12*XR-5)=0.0 + CT(12*XR-4)=0.0 + CT(12*XR-3)=0.0 + CT(12*XR-2)=0.0 + CT(12*XR-1)=0.0 + CT(12*XR-0)=0.0 + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + DO X=1,NTOF + XR=NTOT+NTOL+NTOR+X + N1=NANF(1,X) + N2=NANF(2,X) + X1=NRXFF(1,N1) + Y1=NRXFF(2,N1) + Z1=NRXFF(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTF(6*N1-5) + DY1=UTF(6*N1-4) + DZ1=UTF(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTF(6*N1-5)-UTMF(6*N1-5) + DUT(6*N1-4)=UTF(6*N1-4)-UTMF(6*N1-4) + DUT(6*N1-3)=UTF(6*N1-3)-UTMF(6*N1-3) + DUT(6*N1-2)=UTF(6*N1-2)-UTMF(6*N1-2) + DUT(6*N1-1)=UTF(6*N1-1)-UTMF(6*N1-1) + DUT(6*N1-0)=UTF(6*N1-0)-UTMF(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFF(X).NE.0.0) THEN + CALL AMAT(EFF(X),S,EFF(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XR,RY,CT) + ELSE + CT(12*XR-11)=0.0 + CT(12*XR-10)=0.0 + CT(12*XR-9)=0.0 + CT(12*XR-8)=0.0 + CT(12*XR-7)=0.0 + CT(12*XR-6)=0.0 + CT(12*XR-5)=0.0 + CT(12*XR-4)=0.0 + CT(12*XR-3)=0.0 + CT(12*XR-2)=0.0 + CT(12*XR-1)=0.0 + CT(12*XR-0)=0.0 + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOFL + XR=NTOT+NTOL+NTOR+NTOF+X + N1=NANFL(1,X) + N2=NANFL(2,X) + X1=NRXFFL(1,N1) + Y1=NRXFFL(2,N1) + Z1=NRXFFL(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTFL(6*N1-5) + DY1=UTFL(6*N1-4) + DZ1=UTFL(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTFL(6*N1-5)-UTMFL(6*N1-5) + DUT(6*N1-4)=UTFL(6*N1-4)-UTMFL(6*N1-4) + DUT(6*N1-3)=UTFL(6*N1-3)-UTMFL(6*N1-3) + DUT(6*N1-2)=UTFL(6*N1-2)-UTMFL(6*N1-2) + DUT(6*N1-1)=UTFL(6*N1-1)-UTMFL(6*N1-1) + DUT(6*N1-0)=UTFL(6*N1-0)-UTMFL(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFFL(X).NE.0.0) THEN + CALL AMAT(EFFL(X),S,EFFL(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XR,RY,CT) + ELSE + CT(12*XR-11)=0.0 + CT(12*XR-10)=0.0 + CT(12*XR-9)=0.0 + CT(12*XR-8)=0.0 + CT(12*XR-7)=0.0 + CT(12*XR-6)=0.0 + CT(12*XR-5)=0.0 + CT(12*XR-4)=0.0 + CT(12*XR-3)=0.0 + CT(12*XR-2)=0.0 + CT(12*XR-1)=0.0 + CT(12*XR-0)=0.0 + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOFR + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+X + N1=NANFR(1,X) + N2=NANFR(2,X) + X1=NRXFFR(1,N1) + Y1=NRXFFR(2,N1) + Z1=NRXFFR(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTFR(6*N1-5) + DY1=UTFR(6*N1-4) + DZ1=UTFR(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTFR(6*N1-5)-UTMFR(6*N1-5) + DUT(6*N1-4)=UTFR(6*N1-4)-UTMFR(6*N1-4) + DUT(6*N1-3)=UTFR(6*N1-3)-UTMFR(6*N1-3) + DUT(6*N1-2)=UTFR(6*N1-2)-UTMFR(6*N1-2) + DUT(6*N1-1)=UTFR(6*N1-1)-UTMFR(6*N1-1) + DUT(6*N1-0)=UTFR(6*N1-0)-UTMFR(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFFR(X).NE.0.0) THEN + CALL AMAT(EFFR(X),S,EFFR(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XR,RY,CT) + ELSE + CT(12*XR-11)=0.0 + CT(12*XR-10)=0.0 + CT(12*XR-9)=0.0 + CT(12*XR-8)=0.0 + CT(12*XR-7)=0.0 + CT(12*XR-6)=0.0 + CT(12*XR-5)=0.0 + CT(12*XR-4)=0.0 + CT(12*XR-3)=0.0 + CT(12*XR-2)=0.0 + CT(12*XR-1)=0.0 + CT(12*XR-0)=0.0 + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN) THEN + DO X=1,NTOB + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+NTOFR+X + N1=NANB(1,X) + N2=NANB(2,X) + X1=NRXFB(1,N1) + Y1=NRXFB(2,N1) + Z1=NRXFB(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTB(6*N1-5) + DY1=UTB(6*N1-4) + DZ1=UTB(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTB(6*N1-5)-UTMB(6*N1-5) + DUT(6*N1-4)=UTB(6*N1-4)-UTMB(6*N1-4) + DUT(6*N1-3)=UTB(6*N1-3)-UTMB(6*N1-3) + DUT(6*N1-2)=UTB(6*N1-2)-UTMB(6*N1-2) + DUT(6*N1-1)=UTB(6*N1-1)-UTMB(6*N1-1) + DUT(6*N1-0)=UTB(6*N1-0)-UTMB(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFB(X).NE.0.0) THEN + CALL AMAT(EFB(X),S,EFB(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XR,RY,CT) + ELSE + CT(12*XR-11)=0.0 + CT(12*XR-10)=0.0 + CT(12*XR-9)=0.0 + CT(12*XR-8)=0.0 + CT(12*XR-7)=0.0 + CT(12*XR-6)=0.0 + CT(12*XR-5)=0.0 + CT(12*XR-4)=0.0 + CT(12*XR-3)=0.0 + CT(12*XR-2)=0.0 + CT(12*XR-1)=0.0 + CT(12*XR-0)=0.0 + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOBL + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+NTOFR+NTOB+X + N1=NANBL(1,X) + N2=NANBL(2,X) + X1=NRXFBL(1,N1) + Y1=NRXFBL(2,N1) + Z1=NRXFBL(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTBL(6*N1-5) + DY1=UTBL(6*N1-4) + DZ1=UTBL(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTBL(6*N1-5)-UTMBL(6*N1-5) + DUT(6*N1-4)=UTBL(6*N1-4)-UTMBL(6*N1-4) + DUT(6*N1-3)=UTBL(6*N1-3)-UTMBL(6*N1-3) + DUT(6*N1-2)=UTBL(6*N1-2)-UTMBL(6*N1-2) + DUT(6*N1-1)=UTBL(6*N1-1)-UTMBL(6*N1-1) + DUT(6*N1-0)=UTBL(6*N1-0)-UTMBL(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFBL(X).NE.0.0) THEN + CALL AMAT(EFBL(X),S,EFBL(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XR,RY,CT) + ELSE + CT(12*XR-11)=0.0 + CT(12*XR-10)=0.0 + CT(12*XR-9)=0.0 + CT(12*XR-8)=0.0 + CT(12*XR-7)=0.0 + CT(12*XR-6)=0.0 + CT(12*XR-5)=0.0 + CT(12*XR-4)=0.0 + CT(12*XR-3)=0.0 + CT(12*XR-2)=0.0 + CT(12*XR-1)=0.0 + CT(12*XR-0)=0.0 + ENDIF + ENDDO + ENDIF + + IF (myid.gt.(ntasks-1)/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOBR + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+NTOFR+NTOB+NTOBL+X + N1=NANBR(1,X) + N2=NANBR(2,X) + X1=NRXFBR(1,N1) + Y1=NRXFBR(2,N1) + Z1=NRXFBR(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTBR(6*N1-5) + DY1=UTBR(6*N1-4) + DZ1=UTBR(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTBR(6*N1-5)-UTMBR(6*N1-5) + DUT(6*N1-4)=UTBR(6*N1-4)-UTMBR(6*N1-4) + DUT(6*N1-3)=UTBR(6*N1-3)-UTMBR(6*N1-3) + DUT(6*N1-2)=UTBR(6*N1-2)-UTMBR(6*N1-2) + DUT(6*N1-1)=UTBR(6*N1-1)-UTMBR(6*N1-1) + DUT(6*N1-0)=UTBR(6*N1-0)-UTMBR(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFBR(X).NE.0.0) THEN + CALL AMAT(EFBR(X),S,EFBR(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XR,RY,CT) + ELSE + CT(12*XR-11)=0.0 + CT(12*XR-10)=0.0 + CT(12*XR-9)=0.0 + CT(12*XR-8)=0.0 + CT(12*XR-7)=0.0 + CT(12*XR-6)=0.0 + CT(12*XR-5)=0.0 + CT(12*XR-4)=0.0 + CT(12*XR-3)=0.0 + CT(12*XR-2)=0.0 + CT(12*XR-1)=0.0 + CT(12*XR-0)=0.0 + ENDIF + ENDDO + ENDIF +c---------------------------------------------- + + DO X=1,NTOT + N1=NAN(1,X) + N2=NAN(2,X) + X1=NRXF(1,N1) + Y1=NRXF(2,N1) + Z1=NRXF(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UT(6*N1-5) + DY1=UT(6*N1-4) + DZ1=UT(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N1-5)= A(6*N1-5) + 1 + TT(1,1)*CT(12*X-11) + TT(1,2)*CT(12*X-10) + 1 + TT(1,3)*CT(12*X-9) + A(6*N1-4)= A(6*N1-4) + 1 + TT(2,1)*CT(12*X-11) + TT(2,2)*CT(12*X-10) + 1 + TT(2,3)*CT(12*X-9) + A(6*N1-3)= A(6*N1-3) + 1 + TT(3,1)*CT(12*X-11) + TT(3,2)*CT(12*X-10) + 1 + TT(3,3)*CT(12*X-9) + A(6*N1-2)= A(6*N1-2) + 1 + TT(4,4)*CT(12*X-8) + 1 + TT(4,5)*CT(12*X-7) + TT(4,6)*CT(12*X-6) + A(6*N1-1)= A(6*N1-1) + 1 + TT(5,4)*CT(12*X-8) + 1 + TT(5,5)*CT(12*X-7) + TT(5,6)*CT(12*X-6) + A(6*N1-0)= A(6*N1-0) + 1 + TT(6,4)*CT(12*X-8) + 1 + TT(6,5)*CT(12*X-7) + TT(6,6)*CT(12*X-6) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*X-5) + TT(7,8)*CT(12*X-4) + 1 + TT(7,9)*CT(12*X-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*X-5) + TT(8,8)*CT(12*X-4) + 1 + TT(8,9)*CT(12*X-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*X-5) + TT(9,8)*CT(12*X-4) + 1 + TT(9,9)*CT(12*X-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*X-2) + TT(10,11)*CT(12*X-1) + 1 + TT(10,12)*CT(12*X-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*X-2) + TT(11,11)*CT(12*X-1) + 1 + TT(11,12)*CT(12*X-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*X-2) + TT(12,11)*CT(12*X-1) + 1 + TT(12,12)*CT(12*X-0) + ENDDO + + IF (MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOL + XL=NTOT+X + N1=NANL(1,X) + N2=NANL(2,X) + X1=NRXFL(1,N1) + Y1=NRXFL(2,N1) + Z1=NRXFL(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTL(6*N1-5) + DY1=UTL(6*N1-4) + DZ1=UTL(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XL-5) + TT(7,8)*CT(12*XL-4) + 1 + TT(7,9)*CT(12*XL-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XL-5) + TT(8,8)*CT(12*XL-4) + 1 + TT(8,9)*CT(12*XL-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XL-5) + TT(9,8)*CT(12*XL-4) + 1 + TT(9,9)*CT(12*XL-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XL-2) + 1 + TT(10,11)*CT(12*XL-1) + TT(10,12)*CT(12*XL-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XL-2) + 1 + TT(11,11)*CT(12*XL-1) + TT(11,12)*CT(12*XL-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XL-2) + 1 + TT(12,11)*CT(12*XL-1) + TT(12,12)*CT(12*XL-0) + ENDDO + ENDIF + + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOR + XR=NTOT+NTOL+X + N1=NANR(1,X) + N2=NANR(2,X) + X1=NRXFR(1,N1) + Y1=NRXFR(2,N1) + Z1=NRXFR(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTR(6*N1-5) + DY1=UTR(6*N1-4) + DZ1=UTR(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XR-5) + TT(7,8)*CT(12*XR-4) + 1 + TT(7,9)*CT(12*XR-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XR-5) + TT(8,8)*CT(12*XR-4) + 1 + TT(8,9)*CT(12*XR-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XR-5) + TT(9,8)*CT(12*XR-4) + 1 + TT(9,9)*CT(12*XR-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XR-2) + 1 + TT(10,11)*CT(12*XR-1) + TT(10,12)*CT(12*XR-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XR-2) + 1 + TT(11,11)*CT(12*XR-1) + TT(11,12)*CT(12*XR-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XR-2) + 1 + TT(12,11)*CT(12*XR-1) + TT(12,12)*CT(12*XR-0) + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + DO X=1,NTOF + XR=NTOT+NTOL+NTOR+X + N1=NANF(1,X) + N2=NANF(2,X) + X1=NRXFF(1,N1) + Y1=NRXFF(2,N1) + Z1=NRXFF(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTF(6*N1-5) + DY1=UTF(6*N1-4) + DZ1=UTF(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XR-5) + TT(7,8)*CT(12*XR-4) + 1 + TT(7,9)*CT(12*XR-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XR-5) + TT(8,8)*CT(12*XR-4) + 1 + TT(8,9)*CT(12*XR-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XR-5) + TT(9,8)*CT(12*XR-4) + 1 + TT(9,9)*CT(12*XR-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XR-2) + 1 + TT(10,11)*CT(12*XR-1) + TT(10,12)*CT(12*XR-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XR-2) + 1 + TT(11,11)*CT(12*XR-1) + TT(11,12)*CT(12*XR-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XR-2) + 1 + TT(12,11)*CT(12*XR-1) + TT(12,12)*CT(12*XR-0) + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOFL + XR=NTOT+NTOL+NTOR+NTOF+X + N1=NANFL(1,X) + N2=NANFL(2,X) + X1=NRXFFL(1,N1) + Y1=NRXFFL(2,N1) + Z1=NRXFFL(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTFL(6*N1-5) + DY1=UTFL(6*N1-4) + DZ1=UTFL(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XR-5) + TT(7,8)*CT(12*XR-4) + 1 + TT(7,9)*CT(12*XR-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XR-5) + TT(8,8)*CT(12*XR-4) + 1 + TT(8,9)*CT(12*XR-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XR-5) + TT(9,8)*CT(12*XR-4) + 1 + TT(9,9)*CT(12*XR-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XR-2) + 1 + TT(10,11)*CT(12*XR-1) + TT(10,12)*CT(12*XR-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XR-2) + 1 + TT(11,11)*CT(12*XR-1) + TT(11,12)*CT(12*XR-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XR-2) + 1 + TT(12,11)*CT(12*XR-1) + TT(12,12)*CT(12*XR-0) + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOFR + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+X + N1=NANFR(1,X) + N2=NANFR(2,X) + X1=NRXFFR(1,N1) + Y1=NRXFFR(2,N1) + Z1=NRXFFR(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTFR(6*N1-5) + DY1=UTFR(6*N1-4) + DZ1=UTFR(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XR-5) + TT(7,8)*CT(12*XR-4) + 1 + TT(7,9)*CT(12*XR-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XR-5) + TT(8,8)*CT(12*XR-4) + 1 + TT(8,9)*CT(12*XR-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XR-5) + TT(9,8)*CT(12*XR-4) + 1 + TT(9,9)*CT(12*XR-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XR-2) + 1 + TT(10,11)*CT(12*XR-1) + TT(10,12)*CT(12*XR-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XR-2) + 1 + TT(11,11)*CT(12*XR-1) + TT(11,12)*CT(12*XR-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XR-2) + 1 + TT(12,11)*CT(12*XR-1) + TT(12,12)*CT(12*XR-0) + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN) THEN + DO X=1,NTOB + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+NTOFR+X + N1=NANB(1,X) + N2=NANB(2,X) + X1=NRXFB(1,N1) + Y1=NRXFB(2,N1) + Z1=NRXFB(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTB(6*N1-5) + DY1=UTB(6*N1-4) + DZ1=UTB(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XR-5) + TT(7,8)*CT(12*XR-4) + 1 + TT(7,9)*CT(12*XR-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XR-5) + TT(8,8)*CT(12*XR-4) + 1 + TT(8,9)*CT(12*XR-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XR-5) + TT(9,8)*CT(12*XR-4) + 1 + TT(9,9)*CT(12*XR-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XR-2) + 1 + TT(10,11)*CT(12*XR-1) + TT(10,12)*CT(12*XR-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XR-2) + 1 + TT(11,11)*CT(12*XR-1) + TT(11,12)*CT(12*XR-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XR-2) + 1 + TT(12,11)*CT(12*XR-1) + TT(12,12)*CT(12*XR-0) + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOBL + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+NTOFR+NTOB+X + N1=NANBL(1,X) + N2=NANBL(2,X) + X1=NRXFBL(1,N1) + Y1=NRXFBL(2,N1) + Z1=NRXFBL(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTBL(6*N1-5) + DY1=UTBL(6*N1-4) + DZ1=UTBL(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XR-5) + TT(7,8)*CT(12*XR-4) + 1 + TT(7,9)*CT(12*XR-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XR-5) + TT(8,8)*CT(12*XR-4) + 1 + TT(8,9)*CT(12*XR-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XR-5) + TT(9,8)*CT(12*XR-4) + 1 + TT(9,9)*CT(12*XR-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XR-2) + 1 + TT(10,11)*CT(12*XR-1) + TT(10,12)*CT(12*XR-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XR-2) + 1 + TT(11,11)*CT(12*XR-1) + TT(11,12)*CT(12*XR-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XR-2) + 1 + TT(12,11)*CT(12*XR-1) + TT(12,12)*CT(12*XR-0) + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOBR + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+NTOFR+NTOB+NTOBL+X + N1=NANBR(1,X) + N2=NANBR(2,X) + X1=NRXFBR(1,N1) + Y1=NRXFBR(2,N1) + Z1=NRXFBR(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTBR(6*N1-5) + DY1=UTBR(6*N1-4) + DZ1=UTBR(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XR-5) + TT(7,8)*CT(12*XR-4) + 1 + TT(7,9)*CT(12*XR-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XR-5) + TT(8,8)*CT(12*XR-4) + 1 + TT(8,9)*CT(12*XR-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XR-5) + TT(9,8)*CT(12*XR-4) + 1 + TT(9,9)*CT(12*XR-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XR-2) + 1 + TT(10,11)*CT(12*XR-1) + TT(10,12)*CT(12*XR-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XR-2) + 1 + TT(11,11)*CT(12*XR-1) + TT(11,12)*CT(12*XR-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XR-2) + 1 + TT(12,11)*CT(12*XR-1) + TT(12,12)*CT(12*XR-0) + ENDDO + ENDIF + +c------------------------------------------------------------------------ + + DO X=1,NN + C(6*X-5)= (MFIL(X)/DT**2)*UTM(6*X-5)-(2*MFIL(X)/DT**2)*UT(6*X-5) + C(6*X-4)= (MFIL(X)/DT**2)*UTM(6*X-4)-(2*MFIL(X)/DT**2)*UT(6*X-4) + C(6*X-3)= (MFIL(X)/DT**2)*UTM(6*X-3)-(2*MFIL(X)/DT**2)*UT(6*X-3) + C(6*X-2)= ((MFIL(X)*JS/M)/DT**2)* + 1 UTM(6*X-2)-(2*(MFIL(X)*JS/M)/DT**2)*UT(6*X-2) + C(6*X-1)= ((MFIL(X)*JS/M)/DT**2)* + 1 UTM(6*X-1)-(2*(MFIL(X)*JS/M)/DT**2)*UT(6*X-1) + C(6*X-0)= ((MFIL(X)*JS/M)/DT**2)* + 1 UTM(6*X-0)-(2*(MFIL(X)*JS/M)/DT**2)*UT(6*X-0) + ENDDO + + + DO X=1,NN + F(6*X-5)= -(VDP(X)/(DT*2))*UTM(6*X-5) + F(6*X-4)= -(VDP(X)/(DT*2))*UTM(6*X-4) + F(6*X-3)= -(VDP(X)/(DT*2))*UTM(6*X-3) + F(6*X-2)= -(VDP(X)/(DT*2))*UTM(6*X-2) + F(6*X-1)= -(VDP(X)/(DT*2))*UTM(6*X-1) + F(6*X-0)= -(VDP(X)/(DT*2))*UTM(6*X-0) + END DO + + DO X=1,6*NN + R(X)=-A(X)-C(X)-F(X) + EN(X)=EN(X)+A(X)*(UT(X)-UTM(X)) + END DO + + RETURN + END +!==================================== + SUBROUTINE EFFLOAD2(S,NTOT,NN,T,DT,M,JS,DMP,DMP2,UT,UTM,D,EN,RY, + 1 FXF,FXC,VDP,DPE,EF,EFL,EFR,NAN,NRXF,MFIL,CT,NANL,NANR,NTOL, + 1 NTOR,NRXFL,NRXFR,UTL,UTR,myid,ntasks,FXL,FXFL,FXR,FXFR,L, + 1 NTOF,NTOB,NRXFF,NRXFB,UTF,UTB,EFF,EFB, + 1 FXCF,FXFF,FXCB,FXFB,NANB,NANF,PNN,YN, + 1 NANFL,NANFR,NANBL,NANBR, + 1 NRXFFL,NRXFFR,NRXFBL,NRXFBR, + 1 UTFL,UTFR,UTBL,UTBR, + 1 EFFL,EFFR,EFBL,EFBR, + 1 NTOFL,NTOFR,NTOBL,NTOBR, + 1 FXCFL,FXFFL,FXCBL,FXFBL, + 1 FXCFR,FXFFR,FXCBR,FXFBR) + + IMPLICIT NONE + include 'mpif.h' + include 'param.dat' + REAL*8 MFIL(NOMA),NRXF(3,NOMA),VDP(NOMA) + REAL*8 NRXFL(3,NOMA),NRXFR(3,NOMA) + REAL*8 NRXFF(3,NOMA),NRXFB(3,NOMA) + REAL*8 NRXFFL(3,NOMA),NRXFBL(3,NOMA) + REAL*8 NRXFFR(3,NOMA),NRXFBR(3,NOMA) + REAL*8 UTF(NODM),UTB(NODM) + REAL*8 UTFL(NODM),UTBL(NODM) + REAL*8 UTFR(NODM),UTBR(NODM) + REAL*8 D(NODM) + REAL*8 UT(NODM),UTM(NODM),EF(NOCON),EFL(NOCON) + REAL*8 UTL(NODM),UTML(NODM),EFR(NOCON) + REAL*8 UTR(NODM),UTMR(NODM),LNN,UTMB(NODM),UTMF(NODM) + REAL*8 UTMBL(NODM),UTMFL(NODM),UTMBR(NODM),UTMFR(NODM) + REAL*8 DUT(NODM),CT(NODC),EN(NODM),R(NODM) + INTEGER FXF(2,NODC),FXFL(2,NODC),FXFR(2,NODC) + INTEGER FXFF(2,NODC),FXFB(2,NODC),YN + INTEGER FXFFL(2,NODC),FXFBL(2,NODC) + INTEGER FXFFR(2,NODC),FXFBR(2,NODC) + REAL*8 DPE,S,E,EFB(NOCON),EFF(NOCON) + REAL*8 EFBL(NOCON),EFFL(NOCON) + REAL*8 EFBR(NOCON),EFFR(NOCON) + REAL*8 T,DT,M,JS,L,ALF,DMP + REAL*8 G,X1,Y1,Z1,X2,Y2,Z2,TT(12,12) + REAL*8 DX1,DY1,DZ1,DX2,DY2,DZ2,DMP2 + REAL*8 DP,DP2 + INTEGER NTOT,N,NL,NB,N1,N2,X,XL,XR,PNN(0:5000) + INTEGER I,J,NN,RY,FXC,FXL,FXR,FXCF,FXCB,NAN(3,NOCON) + INTEGER FXCFL,FXCBL,FXCFR,FXCBR + INTEGER NANL(3,NOMA),NANR(3,NOMA),NTOL,NTOR + INTEGER NANF(3,NOMA),NANB(3,NOMA),NTOF,NTOB + INTEGER NTOFL,NTOFR,NTOBL,NTOBR + INTEGER NANFL(3,NOMA),NANBL(3,NOMA) + INTEGER NANFR(3,NOMA),NANBR(3,NOMA) + INTEGER dest,source,tag,stat(MPI_STATUS_SIZE),comm + INTEGER myid,ntasks,ierr + + DO I=1,6*NN + D(I)=0.0 + END DO + + + dest=myid+1 + source=myid-1 + tag=133 + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTML,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-1 + source=myid+1 + tag=135 + IF (MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN + source=myid-ntasks/YN + tag=137 + IF (myid.lt.(YN-1)*ntasks/YN) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN) + 1CALL MPI_Recv(UTMB,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN+1 + source=myid-ntasks/YN-1 + tag=139 + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTMBL,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN-1 + source=myid-ntasks/YN+1 + tag=141 + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMBR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN + source=myid+ntasks/YN + tag=143 + IF (myid.ge.ntasks/YN) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN) + 1CALL MPI_Recv(UTMF,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN+1 + source=myid+ntasks/YN-1 + tag=145 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTMFL,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN-1 + source=myid+ntasks/YN+1 + tag=147 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMFR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + DO X=1,NTOT + IF (EF(X).NE.0.0) THEN + N1=NAN(1,X) + N2=NAN(2,X) + D(6*N1-5)=D(6*N1-5)+(DMP/DT)*((UT(6*N1-5)-UT(6*N2-5)) + 1 -(UTM(6*N1-5)-UTM(6*N2-5))) + D(6*N1-4)=D(6*N1-4)+(DMP/DT)*((UT(6*N1-4)-UT(6*N2-4)) + 1 -(UTM(6*N1-4)-UTM(6*N2-4))) + D(6*N1-3)=D(6*N1-3)+(DMP/DT)*((UT(6*N1-3)-UT(6*N2-3)) + 1 -(UTM(6*N1-3)-UTM(6*N2-3))) + D(6*N1-2)=D(6*N1-2)+(DMP2/DT)*((UT(6*N1-2)-UT(6*N2-2)) + 1 -(UTM(6*N1-2)-UTM(6*N2-2))) + D(6*N1-1)=D(6*N1-1)+(DMP2/DT)*((UT(6*N1-1)-UT(6*N2-1)) + 1 -(UTM(6*N1-1)-UTM(6*N2-1))) + D(6*N1-0)=D(6*N1-0)+(DMP2/DT)*((UT(6*N1-0)-UT(6*N2-0)) + 1 -(UTM(6*N1-0)-UTM(6*N2-0))) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UT(6*N1-5)) + 1 -(UTM(6*N2-5)-UTM(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UT(6*N1-4)) + 1 -(UTM(6*N2-4)-UTM(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UT(6*N1-3)) + 1 -(UTM(6*N2-3)-UTM(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UT(6*N1-2)) + 1 -(UTM(6*N2-2)-UTM(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UT(6*N1-1)) + 1 -(UTM(6*N2-1)-UTM(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UT(6*N1-0)) + 1 -(UTM(6*N2-0)-UTM(6*N1-0))) + ENDIF + ENDDO + + IF (MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOL + IF (EFL(X).NE.0.0) THEN + N1=NANL(1,X) + N2=NANL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTML(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTML(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTML(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTML(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTML(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTML(6*N1-0))) + ENDIF + ENDDO + ENDIF + + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOR + IF (EFR(X).NE.0.0) THEN + N1=NANR(1,X) + N2=NANR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMR(6*N1-0))) + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + DO X=1,NTOF + IF (EFF(X).NE.0.0) THEN + N1=NANF(1,X) + N2=NANF(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTF(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMF(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTF(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMF(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTF(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMF(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTF(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMF(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTF(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMF(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTF(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMF(6*N1-0))) + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOFL + IF (EFFL(X).NE.0.0) THEN + N1=NANFL(1,X) + N2=NANFL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFL(6*N1-0))) + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOFR + IF (EFFR(X).NE.0.0) THEN + N1=NANFR(1,X) + N2=NANFR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFR(6*N1-0))) + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN) THEN + DO X=1,NTOB + IF (EFB(X).NE.0.0) THEN + N1=NANB(1,X) + N2=NANB(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTB(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMB(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTB(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMB(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTB(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMB(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTB(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMB(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTB(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMB(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTB(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMB(6*N1-0))) + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOBL + IF (EFBL(X).NE.0.0) THEN + N1=NANBL(1,X) + N2=NANBL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBL(6*N1-0))) + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOBR + IF (EFBR(X).NE.0.0) THEN + N1=NANBR(1,X) + N2=NANBR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBR(6*N1-0))) + ENDIF + ENDDO + ENDIF + +c----------------------------------------------------------------- + DO X=1,FXC + N1=FXF(1,X) + N2=FXF(2,X) + D(6*N1-5)=D(6*N1-5)+(DMP/DT)*((UT(6*N1-5)-UT(6*N2-5)) + 1 -(UTM(6*N1-5)-UTM(6*N2-5))) + D(6*N1-4)=D(6*N1-4)+(DMP/DT)*((UT(6*N1-4)-UT(6*N2-4)) + 1 -(UTM(6*N1-4)-UTM(6*N2-4))) + D(6*N1-3)=D(6*N1-3)+(DMP/DT)*((UT(6*N1-3)-UT(6*N2-3)) + 1 -(UTM(6*N1-3)-UTM(6*N2-3))) + D(6*N1-2)=D(6*N1-2)+(DMP2/DT)*((UT(6*N1-2)-UT(6*N2-2)) + 1 -(UTM(6*N1-2)-UTM(6*N2-2))) + D(6*N1-1)=D(6*N1-1)+(DMP2/DT)*((UT(6*N1-1)-UT(6*N2-1)) + 1 -(UTM(6*N1-1)-UTM(6*N2-1))) + D(6*N1-0)=D(6*N1-0)+(DMP2/DT)*((UT(6*N1-0)-UT(6*N2-0)) + 1 -(UTM(6*N1-0)-UTM(6*N2-0))) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UT(6*N1-5)) + 1 -(UTM(6*N2-5)-UTM(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UT(6*N1-4)) + 1 -(UTM(6*N2-4)-UTM(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UT(6*N1-3)) + 1 -(UTM(6*N2-3)-UTM(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UT(6*N1-2)) + 1 -(UTM(6*N2-2)-UTM(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UT(6*N1-1)) + 1 -(UTM(6*N2-1)-UTM(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UT(6*N1-0)) + 1 -(UTM(6*N2-0)-UTM(6*N1-0))) + ENDDO + + IF (MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,FXL + N1=FXFL(1,X) + N2=FXFL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTML(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTML(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTML(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTML(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTML(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTML(6*N1-0))) + ENDDO + ENDIF + + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,FXR + N1=FXFR(1,X) + N2=FXFR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMR(6*N1-0))) + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + DO X=1,FXCF + N1=FXFF(1,X) + N2=FXFF(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTF(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMF(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTF(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMF(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTF(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMF(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTF(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMF(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTF(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMF(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTF(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMF(6*N1-0))) + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,FXCFL + N1=FXFFL(1,X) + N2=FXFFL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFL(6*N1-0))) + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,FXCFR + N1=FXFFR(1,X) + N2=FXFFR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFR(6*N1-0))) + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN) THEN + DO X=1,FXCB + N1=FXFB(1,X) + N2=FXFB(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTB(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMB(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTB(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMB(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTB(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMB(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTB(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMB(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTB(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMB(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTB(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMB(6*N1-0))) + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,FXCBL + N1=FXFBL(1,X) + N2=FXFBL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBL(6*N1-0))) + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,FXCBR + N1=FXFBR(1,X) + N2=FXFBR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBR(6*N1-0))) + ENDDO + ENDIF + + + RETURN + END + +!============================================= + SUBROUTINE EFFLOAD3(S,NTOT,NN,T,DT,M,JS,DMP,DMP2,UT,UTM,D,EN,RY, + 1 FXF,FXC,VDP,DPE,EF,EFL,EFR,NAN,NRXF,MFIL,CT,NANL,NANR,NTOL, + 1 NTOR,NRXFL,NRXFR,UTL,UTR,myid,ntasks,FXL,FXFL,FXR,FXFR,L, + 1 NTOF,NTOB,NRXFF,NRXFB,UTF,UTB,EFF,EFB, + 1 FXCF,FXFF,FXCB,FXFB,NANB,NANF,PNN,YN, + 1 NANFL,NANFR,NANBL,NANBR, + 1 NRXFFL,NRXFFR,NRXFBL,NRXFBR, + 1 UTFL,UTFR,UTBL,UTBR, + 1 EFFL,EFFR,EFBL,EFBR, + 1 NTOFL,NTOFR,NTOBL,NTOBR, + 1 FXCFL,FXFFL,FXCBL,FXFBL, + 1 FXCFR,FXFFR,FXCBR,FXFBR) + + IMPLICIT NONE + include 'mpif.h' + include 'param.dat' + REAL*8 MFIL(NOMA),NRXF(3,NOMA),VDP(NOMA) + REAL*8 NRXFL(3,NOMA),NRXFR(3,NOMA) + REAL*8 NRXFF(3,NOMA),NRXFB(3,NOMA) + REAL*8 NRXFFL(3,NOMA),NRXFBL(3,NOMA) + REAL*8 NRXFFR(3,NOMA),NRXFBR(3,NOMA) + REAL*8 UTF(NODM),UTB(NODM) + REAL*8 UTFL(NODM),UTBL(NODM) + REAL*8 UTFR(NODM),UTBR(NODM) + REAL*8 D(NODM) + REAL*8 UT(NODM),UTM(NODM),EF(NOCON),EFL(NOCON) + REAL*8 UTL(NODM),UTML(NODM),EFR(NOCON) + REAL*8 UTR(NODM),UTMR(NODM),LNN,UTMB(NODM),UTMF(NODM) + REAL*8 UTMBL(NODM),UTMFL(NODM),UTMBR(NODM),UTMFR(NODM) + REAL*8 DUT(NODM),CT(NODC),EN(NODM),R(NODM) + INTEGER FXF(2,NODC),FXFL(2,NODC),FXFR(2,NODC) + INTEGER FXFF(2,NODC),FXFB(2,NODC),YN + INTEGER FXFFL(2,NODC),FXFBL(2,NODC) + INTEGER FXFFR(2,NODC),FXFBR(2,NODC) + REAL*8 DPE,S,E,EFB(NOCON),EFF(NOCON) + REAL*8 EFBL(NOCON),EFFL(NOCON) + REAL*8 EFBR(NOCON),EFFR(NOCON) + REAL*8 T,DT,M,JS,L,ALF,DMP + REAL*8 G,X1,Y1,Z1,X2,Y2,Z2,TT(12,12) + REAL*8 DX1,DY1,DZ1,DX2,DY2,DZ2,DMP2 + REAL*8 DP,DP2 + INTEGER NTOT,N,NL,NB,N1,N2,X,XL,XR,PNN(0:5000) + INTEGER I,J,NN,RY,FXC,FXL,FXR,FXCF,FXCB,NAN(3,NOCON) + INTEGER FXCFL,FXCBL,FXCFR,FXCBR + INTEGER NANL(3,NOMA),NANR(3,NOMA),NTOL,NTOR + INTEGER NANF(3,NOMA),NANB(3,NOMA),NTOF,NTOB + INTEGER NTOFL,NTOFR,NTOBL,NTOBR + INTEGER NANFL(3,NOMA),NANBL(3,NOMA) + INTEGER NANFR(3,NOMA),NANBR(3,NOMA) + INTEGER dest,source,tag,stat(MPI_STATUS_SIZE),comm + INTEGER myid,ntasks,ierr + +! DO I=1,6*NN +! D(I)=0.0 +! END DO + + + dest=myid+1 + source=myid-1 + tag=133 + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTML,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-1 + source=myid+1 + tag=135 + IF (MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN + source=myid-ntasks/YN + tag=137 + IF (myid.lt.(YN-1)*ntasks/YN) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN) + 1CALL MPI_Recv(UTMB,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN+1 + source=myid-ntasks/YN-1 + tag=139 + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTMBL,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN-1 + source=myid-ntasks/YN+1 + tag=141 + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMBR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN + source=myid+ntasks/YN + tag=143 + IF (myid.ge.ntasks/YN) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN) + 1CALL MPI_Recv(UTMF,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN+1 + source=myid+ntasks/YN-1 + tag=145 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTMFL,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN-1 + source=myid+ntasks/YN+1 + tag=147 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMFR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + DO X=1,NTOT + IF (EF(X).NE.0.0) THEN + N1=NAN(1,X) + N2=NAN(2,X) + D(6*N1-5)=D(6*N1-5)+(DMP/DT)*((UT(6*N1-5)-UT(6*N2-5)) + 1 -(UTM(6*N1-5)-UTM(6*N2-5))) + D(6*N1-4)=D(6*N1-4)+(DMP/DT)*((UT(6*N1-4)-UT(6*N2-4)) + 1 -(UTM(6*N1-4)-UTM(6*N2-4))) + D(6*N1-3)=D(6*N1-3)+(DMP/DT)*((UT(6*N1-3)-UT(6*N2-3)) + 1 -(UTM(6*N1-3)-UTM(6*N2-3))) + D(6*N1-2)=D(6*N1-2)+(DMP2/DT)*((UT(6*N1-2)-UT(6*N2-2)) + 1 -(UTM(6*N1-2)-UTM(6*N2-2))) + D(6*N1-1)=D(6*N1-1)+(DMP2/DT)*((UT(6*N1-1)-UT(6*N2-1)) + 1 -(UTM(6*N1-1)-UTM(6*N2-1))) + D(6*N1-0)=D(6*N1-0)+(DMP2/DT)*((UT(6*N1-0)-UT(6*N2-0)) + 1 -(UTM(6*N1-0)-UTM(6*N2-0))) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UT(6*N1-5)) + 1 -(UTM(6*N2-5)-UTM(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UT(6*N1-4)) + 1 -(UTM(6*N2-4)-UTM(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UT(6*N1-3)) + 1 -(UTM(6*N2-3)-UTM(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UT(6*N1-2)) + 1 -(UTM(6*N2-2)-UTM(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UT(6*N1-1)) + 1 -(UTM(6*N2-1)-UTM(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UT(6*N1-0)) + 1 -(UTM(6*N2-0)-UTM(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UT(6*N1-5)) + 1 -(UTM(6*N2-5)-UTM(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UT(6*N1-4)) + 1 -(UTM(6*N2-4)-UTM(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UT(6*N1-3)) + 1 -(UTM(6*N2-3)-UTM(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UT(6*N1-2)) + 1 -(UTM(6*N2-2)-UTM(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UT(6*N1-1)) + 1 -(UTM(6*N2-1)-UTM(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UT(6*N1-0)) + 1 -(UTM(6*N2-0)-UTM(6*N1-0)))**2 + ENDIF + ENDDO + + IF (MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOL + IF (EFL(X).NE.0.0) THEN + N1=NANL(1,X) + N2=NANL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTML(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTML(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTML(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTML(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTML(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTML(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTML(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTML(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTML(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTML(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTML(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTML(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOR + IF (EFR(X).NE.0.0) THEN + N1=NANR(1,X) + N2=NANR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMR(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMR(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMR(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMR(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMR(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMR(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMR(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + DO X=1,NTOF + IF (EFF(X).NE.0.0) THEN + N1=NANF(1,X) + N2=NANF(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTF(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMF(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTF(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMF(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTF(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMF(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTF(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMF(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTF(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMF(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTF(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMF(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTF(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMF(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTF(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMF(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTF(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMF(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTF(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMF(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTF(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMF(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTF(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMF(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOFL + IF (EFFL(X).NE.0.0) THEN + N1=NANFL(1,X) + N2=NANFL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFL(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTFL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFL(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTFL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFL(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTFL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFL(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTFL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFL(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTFL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFL(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTFL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFL(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOFR + IF (EFFR(X).NE.0.0) THEN + N1=NANFR(1,X) + N2=NANFR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFR(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTFR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFR(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTFR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFR(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTFR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFR(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTFR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFR(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTFR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFR(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTFR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFR(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN) THEN + DO X=1,NTOB + IF (EFB(X).NE.0.0) THEN + N1=NANB(1,X) + N2=NANB(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTB(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMB(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTB(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMB(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTB(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMB(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTB(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMB(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTB(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMB(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTB(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMB(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTB(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMB(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTB(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMB(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTB(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMB(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTB(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMB(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTB(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMB(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTB(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMB(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOBL + IF (EFBL(X).NE.0.0) THEN + N1=NANBL(1,X) + N2=NANBL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBL(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTBL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBL(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTBL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBL(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTBL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBL(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTBL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBL(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTBL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBL(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTBL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBL(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOBR + IF (EFBR(X).NE.0.0) THEN + N1=NANBR(1,X) + N2=NANBR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBR(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTBR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBR(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTBR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBR(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTBR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBR(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTBR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBR(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTBR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBR(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTBR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBR(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + +c----------------------------------------------------------------- + DO X=1,FXC + N1=FXF(1,X) + N2=FXF(2,X) + D(6*N1-5)=D(6*N1-5)+(DMP/DT)*((UT(6*N1-5)-UT(6*N2-5)) + 1 -(UTM(6*N1-5)-UTM(6*N2-5))) + D(6*N1-4)=D(6*N1-4)+(DMP/DT)*((UT(6*N1-4)-UT(6*N2-4)) + 1 -(UTM(6*N1-4)-UTM(6*N2-4))) + D(6*N1-3)=D(6*N1-3)+(DMP/DT)*((UT(6*N1-3)-UT(6*N2-3)) + 1 -(UTM(6*N1-3)-UTM(6*N2-3))) + D(6*N1-2)=D(6*N1-2)+(DMP2/DT)*((UT(6*N1-2)-UT(6*N2-2)) + 1 -(UTM(6*N1-2)-UTM(6*N2-2))) + D(6*N1-1)=D(6*N1-1)+(DMP2/DT)*((UT(6*N1-1)-UT(6*N2-1)) + 1 -(UTM(6*N1-1)-UTM(6*N2-1))) + D(6*N1-0)=D(6*N1-0)+(DMP2/DT)*((UT(6*N1-0)-UT(6*N2-0)) + 1 -(UTM(6*N1-0)-UTM(6*N2-0))) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UT(6*N1-5)) + 1 -(UTM(6*N2-5)-UTM(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UT(6*N1-4)) + 1 -(UTM(6*N2-4)-UTM(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UT(6*N1-3)) + 1 -(UTM(6*N2-3)-UTM(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UT(6*N1-2)) + 1 -(UTM(6*N2-2)-UTM(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UT(6*N1-1)) + 1 -(UTM(6*N2-1)-UTM(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UT(6*N1-0)) + 1 -(UTM(6*N2-0)-UTM(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UT(6*N1-5)) + 1 -(UTM(6*N2-5)-UTM(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UT(6*N1-4)) + 1 -(UTM(6*N2-4)-UTM(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UT(6*N1-3)) + 1 -(UTM(6*N2-3)-UTM(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UT(6*N1-2)) + 1 -(UTM(6*N2-2)-UTM(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UT(6*N1-1)) + 1 -(UTM(6*N2-1)-UTM(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UT(6*N1-0)) + 1 -(UTM(6*N2-0)-UTM(6*N1-0)))**2 + ENDDO + + IF (MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,FXL + N1=FXFL(1,X) + N2=FXFL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTML(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTML(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTML(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTML(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTML(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTML(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTML(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTML(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTML(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTML(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTML(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTML(6*N1-0)))**2 + ENDDO + ENDIF + + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,FXR + N1=FXFR(1,X) + N2=FXFR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMR(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMR(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMR(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMR(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMR(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMR(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMR(6*N1-0)))**2 + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + DO X=1,FXCF + N1=FXFF(1,X) + N2=FXFF(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTF(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMF(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTF(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMF(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTF(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMF(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTF(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMF(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTF(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMF(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTF(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMF(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTF(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMF(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTF(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMF(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTF(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMF(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTF(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMF(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTF(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMF(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTF(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMF(6*N1-0)))**2 + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,FXCFL + N1=FXFFL(1,X) + N2=FXFFL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFL(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTFL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFL(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTFL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFL(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTFL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFL(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTFL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFL(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTFL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFL(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTFL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFL(6*N1-0)))**2 + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,FXCFR + N1=FXFFR(1,X) + N2=FXFFR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFR(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTFR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFR(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTFR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFR(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTFR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFR(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTFR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFR(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTFR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFR(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTFR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFR(6*N1-0)))**2 + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN) THEN + DO X=1,FXCB + N1=FXFB(1,X) + N2=FXFB(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTB(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMB(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTB(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMB(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTB(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMB(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTB(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMB(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTB(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMB(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTB(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMB(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTB(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMB(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTB(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMB(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTB(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMB(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTB(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMB(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTB(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMB(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTB(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMB(6*N1-0)))**2 + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,FXCBL + N1=FXFBL(1,X) + N2=FXFBL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBL(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTBL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBL(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTBL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBL(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTBL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBL(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTBL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBL(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTBL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBL(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTBL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBL(6*N1-0)))**2 + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,FXCBR + N1=FXFBR(1,X) + N2=FXFBR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBR(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTBR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBR(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTBR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBR(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTBR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBR(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTBR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBR(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTBR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBR(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTBR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBR(6*N1-0)))**2 + ENDDO + ENDIF + + + RETURN + END + + + + + + + + + + + + + diff --git a/effload1.f b/effload1.f new file mode 100644 index 0000000..38d688d --- /dev/null +++ b/effload1.f @@ -0,0 +1,988 @@ + SUBROUTINE EFFLOAD1(S,NTOT,NN,T,DT,M,JS,UT,UTM,R,EN,RY, + 1 FXF,FXC,VDP,DPE,EF,EFL,EFR,NAN,NRXF,MFIL,CT,NANL,NANR,NTOL, + 1 NTOR,NRXFL,NRXFR,UTL,UTR,myid,ntasks,FXL,FXFL,FXR,FXFR,L, + 1 NTOF,NTOB,NRXFF,NRXFB,UTF,UTB,EFF,EFB, + 1 FXCF,FXFF,FXCB,FXFB,NANB,NANF,PNN,YN, + 1 NANFL,NANFR,NANBL,NANBR, + 1 NRXFFL,NRXFFR,NRXFBL,NRXFBR, + 1 UTFL,UTFR,UTBL,UTBR, + 1 EFFL,EFFR,EFBL,EFBR, + 1 NTOFL,NTOFR,NTOBL,NTOBR, + 1 FXCFL,FXFFL,FXCBL,FXFBL, + 1 FXCFR,FXFFR,FXCBR,FXFBR) + + IMPLICIT NONE + include 'mpif.h' + include 'param.dat' + REAL*8 MFIL(NOMA),NRXF(3,NOMA),VDP(NOMA) + REAL*8 NRXFL(3,NOMA),NRXFR(3,NOMA) + REAL*8 NRXFF(3,NOMA),NRXFB(3,NOMA) + REAL*8 NRXFFL(3,NOMA),NRXFBL(3,NOMA) + REAL*8 NRXFFR(3,NOMA),NRXFBR(3,NOMA) + REAL*8 UTF(NODM),UTB(NODM) + REAL*8 UTFL(NODM),UTBL(NODM) + REAL*8 UTFR(NODM),UTBR(NODM) + REAL*8 A(NODM),C(NODM),F(NODM) + REAL*8 UT(NODM),UTM(NODM),EF(NOCON),EFL(NOCON) + REAL*8 UTL(NODM),UTML(NODM),EFR(NOCON) + REAL*8 UTR(NODM),UTMR(NODM),LNN,UTMB(NODM),UTMF(NODM) + REAL*8 UTMBL(NODM),UTMFL(NODM),UTMBR(NODM),UTMFR(NODM) + REAL*8 DUT(NODM),CT(NODC),EN(NODM),R(NODM) + INTEGER FXF(2,NODC),FXFL(2,NODC),FXFR(2,NODC) + INTEGER FXFF(2,NODC),FXFB(2,NODC),YN + INTEGER FXFFL(2,NODC),FXFBL(2,NODC) + INTEGER FXFFR(2,NODC),FXFBR(2,NODC) + REAL*8 DPE,S,E,EFB(NOCON),EFF(NOCON) + REAL*8 EFBL(NOCON),EFFL(NOCON) + REAL*8 EFBR(NOCON),EFFR(NOCON) + REAL*8 T,DT,M,JS,L,ALF + REAL*8 G,X1,Y1,Z1,X2,Y2,Z2,TT(12,12) + REAL*8 DX1,DY1,DZ1,DX2,DY2,DZ2 + REAL*8 DP,DP2 + INTEGER NTOT,N,NL,NB,N1,N2,X,XL,XR,PNN(0:5000) + INTEGER I,J,NN,RY,FXC,FXL,FXR,FXCF,FXCB,NAN(3,NOCON) + INTEGER FXCFL,FXCBL,FXCFR,FXCBR + INTEGER NANL(3,NOMA),NANR(3,NOMA),NTOL,NTOR + INTEGER NANF(3,NOMA),NANB(3,NOMA),NTOF,NTOB + INTEGER NTOFL,NTOFR,NTOBL,NTOBR + INTEGER NANFL(3,NOMA),NANBL(3,NOMA) + INTEGER NANFR(3,NOMA),NANBR(3,NOMA) + INTEGER dest,source,tag,stat(MPI_STATUS_SIZE),comm + INTEGER myid,ntasks,ierr + + DO I=1,6*NN + A(I)=0.0 + END DO + + DO 60 X=1,NTOT + N1=NAN(1,X) + N2=NAN(2,X) + X1=NRXF(1,N1) + Y1=NRXF(2,N1) + Z1=NRXF(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + + + DX1=UT(6*N1-5) + DY1=UT(6*N1-4) + DZ1=UT(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + + DUT(6*N1-5)=UT(6*N1-5)-UTM(6*N1-5) + DUT(6*N1-4)=UT(6*N1-4)-UTM(6*N1-4) + DUT(6*N1-3)=UT(6*N1-3)-UTM(6*N1-3) + DUT(6*N1-2)=UT(6*N1-2)-UTM(6*N1-2) + DUT(6*N1-1)=UT(6*N1-1)-UTM(6*N1-1) + DUT(6*N1-0)=UT(6*N1-0)-UTM(6*N1-0) + + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + + IF (EF(X).NE.0.0) THEN + CALL AMAT(EF(X),S,EF(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,X,RY,CT) + ELSE + CT(12*X-11)=0.0 + CT(12*X-10)=0.0 + CT(12*X-9)=0.0 + CT(12*X-8)=0.0 + CT(12*X-7)=0.0 + CT(12*X-6)=0.0 + CT(12*X-5)=0.0 + CT(12*X-4)=0.0 + CT(12*X-3)=0.0 + CT(12*X-2)=0.0 + CT(12*X-1)=0.0 + CT(12*X-0)=0.0 + ENDIF + +60 CONTINUE + + dest=myid+1 + source=myid-1 + tag=133 + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTML,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-1 + source=myid+1 + tag=135 + IF (MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN + source=myid-ntasks/YN + tag=137 + IF (myid.lt.(YN-1)*ntasks/YN) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN) + 1CALL MPI_Recv(UTMB,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN+1 + source=myid-ntasks/YN-1 + tag=139 + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTMBL,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN-1 + source=myid-ntasks/YN+1 + tag=141 + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMBR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN + source=myid+ntasks/YN + tag=143 + IF (myid.ge.ntasks/YN) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN) + 1CALL MPI_Recv(UTMF,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN+1 + source=myid+ntasks/YN-1 + tag=145 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTMFL,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN-1 + source=myid+ntasks/YN+1 + tag=147 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMFR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + +c------------------------------------------------------ + IF (MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOL + XL=NTOT+X + N1=NANL(1,X) + N2=NANL(2,X) + X1=NRXFL(1,N1) + Y1=NRXFL(2,N1) + Z1=NRXFL(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTL(6*N1-5) + DY1=UTL(6*N1-4) + DZ1=UTL(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTL(6*N1-5)-UTML(6*N1-5) + DUT(6*N1-4)=UTL(6*N1-4)-UTML(6*N1-4) + DUT(6*N1-3)=UTL(6*N1-3)-UTML(6*N1-3) + DUT(6*N1-2)=UTL(6*N1-2)-UTML(6*N1-2) + DUT(6*N1-1)=UTL(6*N1-1)-UTML(6*N1-1) + DUT(6*N1-0)=UTL(6*N1-0)-UTML(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFL(X).NE.0.0) THEN + CALL AMAT(EFL(X),S,EFL(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XL,RY,CT) + ELSE + CT(12*XL-11)=0.0 + CT(12*XL-10)=0.0 + CT(12*XL-9)=0.0 + CT(12*XL-8)=0.0 + CT(12*XL-7)=0.0 + CT(12*XL-6)=0.0 + CT(12*XL-5)=0.0 + CT(12*XL-4)=0.0 + CT(12*XL-3)=0.0 + CT(12*XL-2)=0.0 + CT(12*XL-1)=0.0 + CT(12*XL-0)=0.0 + ENDIF + ENDDO + ENDIF + + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOR + XR=NTOT+NTOL+X + N1=NANR(1,X) + N2=NANR(2,X) + X1=NRXFR(1,N1) + Y1=NRXFR(2,N1) + Z1=NRXFR(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTR(6*N1-5) + DY1=UTR(6*N1-4) + DZ1=UTR(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTR(6*N1-5)-UTMR(6*N1-5) + DUT(6*N1-4)=UTR(6*N1-4)-UTMR(6*N1-4) + DUT(6*N1-3)=UTR(6*N1-3)-UTMR(6*N1-3) + DUT(6*N1-2)=UTR(6*N1-2)-UTMR(6*N1-2) + DUT(6*N1-1)=UTR(6*N1-1)-UTMR(6*N1-1) + DUT(6*N1-0)=UTR(6*N1-0)-UTMR(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFR(X).NE.0.0) THEN + CALL AMAT(EFR(X),S,EFR(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XR,RY,CT) + ELSE + CT(12*XR-11)=0.0 + CT(12*XR-10)=0.0 + CT(12*XR-9)=0.0 + CT(12*XR-8)=0.0 + CT(12*XR-7)=0.0 + CT(12*XR-6)=0.0 + CT(12*XR-5)=0.0 + CT(12*XR-4)=0.0 + CT(12*XR-3)=0.0 + CT(12*XR-2)=0.0 + CT(12*XR-1)=0.0 + CT(12*XR-0)=0.0 + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + DO X=1,NTOF + XR=NTOT+NTOL+NTOR+X + N1=NANF(1,X) + N2=NANF(2,X) + X1=NRXFF(1,N1) + Y1=NRXFF(2,N1) + Z1=NRXFF(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTF(6*N1-5) + DY1=UTF(6*N1-4) + DZ1=UTF(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTF(6*N1-5)-UTMF(6*N1-5) + DUT(6*N1-4)=UTF(6*N1-4)-UTMF(6*N1-4) + DUT(6*N1-3)=UTF(6*N1-3)-UTMF(6*N1-3) + DUT(6*N1-2)=UTF(6*N1-2)-UTMF(6*N1-2) + DUT(6*N1-1)=UTF(6*N1-1)-UTMF(6*N1-1) + DUT(6*N1-0)=UTF(6*N1-0)-UTMF(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFF(X).NE.0.0) THEN + CALL AMAT(EFF(X),S,EFF(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XR,RY,CT) + ELSE + CT(12*XR-11)=0.0 + CT(12*XR-10)=0.0 + CT(12*XR-9)=0.0 + CT(12*XR-8)=0.0 + CT(12*XR-7)=0.0 + CT(12*XR-6)=0.0 + CT(12*XR-5)=0.0 + CT(12*XR-4)=0.0 + CT(12*XR-3)=0.0 + CT(12*XR-2)=0.0 + CT(12*XR-1)=0.0 + CT(12*XR-0)=0.0 + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOFL + XR=NTOT+NTOL+NTOR+NTOF+X + N1=NANFL(1,X) + N2=NANFL(2,X) + X1=NRXFFL(1,N1) + Y1=NRXFFL(2,N1) + Z1=NRXFFL(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTFL(6*N1-5) + DY1=UTFL(6*N1-4) + DZ1=UTFL(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTFL(6*N1-5)-UTMFL(6*N1-5) + DUT(6*N1-4)=UTFL(6*N1-4)-UTMFL(6*N1-4) + DUT(6*N1-3)=UTFL(6*N1-3)-UTMFL(6*N1-3) + DUT(6*N1-2)=UTFL(6*N1-2)-UTMFL(6*N1-2) + DUT(6*N1-1)=UTFL(6*N1-1)-UTMFL(6*N1-1) + DUT(6*N1-0)=UTFL(6*N1-0)-UTMFL(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFFL(X).NE.0.0) THEN + CALL AMAT(EFFL(X),S,EFFL(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XR,RY,CT) + ELSE + CT(12*XR-11)=0.0 + CT(12*XR-10)=0.0 + CT(12*XR-9)=0.0 + CT(12*XR-8)=0.0 + CT(12*XR-7)=0.0 + CT(12*XR-6)=0.0 + CT(12*XR-5)=0.0 + CT(12*XR-4)=0.0 + CT(12*XR-3)=0.0 + CT(12*XR-2)=0.0 + CT(12*XR-1)=0.0 + CT(12*XR-0)=0.0 + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOFR + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+X + N1=NANFR(1,X) + N2=NANFR(2,X) + X1=NRXFFR(1,N1) + Y1=NRXFFR(2,N1) + Z1=NRXFFR(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTFR(6*N1-5) + DY1=UTFR(6*N1-4) + DZ1=UTFR(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTFR(6*N1-5)-UTMFR(6*N1-5) + DUT(6*N1-4)=UTFR(6*N1-4)-UTMFR(6*N1-4) + DUT(6*N1-3)=UTFR(6*N1-3)-UTMFR(6*N1-3) + DUT(6*N1-2)=UTFR(6*N1-2)-UTMFR(6*N1-2) + DUT(6*N1-1)=UTFR(6*N1-1)-UTMFR(6*N1-1) + DUT(6*N1-0)=UTFR(6*N1-0)-UTMFR(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFFR(X).NE.0.0) THEN + CALL AMAT(EFFR(X),S,EFFR(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XR,RY,CT) + ELSE + CT(12*XR-11)=0.0 + CT(12*XR-10)=0.0 + CT(12*XR-9)=0.0 + CT(12*XR-8)=0.0 + CT(12*XR-7)=0.0 + CT(12*XR-6)=0.0 + CT(12*XR-5)=0.0 + CT(12*XR-4)=0.0 + CT(12*XR-3)=0.0 + CT(12*XR-2)=0.0 + CT(12*XR-1)=0.0 + CT(12*XR-0)=0.0 + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN) THEN + DO X=1,NTOB + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+NTOFR+X + N1=NANB(1,X) + N2=NANB(2,X) + X1=NRXFB(1,N1) + Y1=NRXFB(2,N1) + Z1=NRXFB(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTB(6*N1-5) + DY1=UTB(6*N1-4) + DZ1=UTB(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTB(6*N1-5)-UTMB(6*N1-5) + DUT(6*N1-4)=UTB(6*N1-4)-UTMB(6*N1-4) + DUT(6*N1-3)=UTB(6*N1-3)-UTMB(6*N1-3) + DUT(6*N1-2)=UTB(6*N1-2)-UTMB(6*N1-2) + DUT(6*N1-1)=UTB(6*N1-1)-UTMB(6*N1-1) + DUT(6*N1-0)=UTB(6*N1-0)-UTMB(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFB(X).NE.0.0) THEN + CALL AMAT(EFB(X),S,EFB(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XR,RY,CT) + ELSE + CT(12*XR-11)=0.0 + CT(12*XR-10)=0.0 + CT(12*XR-9)=0.0 + CT(12*XR-8)=0.0 + CT(12*XR-7)=0.0 + CT(12*XR-6)=0.0 + CT(12*XR-5)=0.0 + CT(12*XR-4)=0.0 + CT(12*XR-3)=0.0 + CT(12*XR-2)=0.0 + CT(12*XR-1)=0.0 + CT(12*XR-0)=0.0 + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOBL + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+NTOFR+NTOB+X + N1=NANBL(1,X) + N2=NANBL(2,X) + X1=NRXFBL(1,N1) + Y1=NRXFBL(2,N1) + Z1=NRXFBL(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTBL(6*N1-5) + DY1=UTBL(6*N1-4) + DZ1=UTBL(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTBL(6*N1-5)-UTMBL(6*N1-5) + DUT(6*N1-4)=UTBL(6*N1-4)-UTMBL(6*N1-4) + DUT(6*N1-3)=UTBL(6*N1-3)-UTMBL(6*N1-3) + DUT(6*N1-2)=UTBL(6*N1-2)-UTMBL(6*N1-2) + DUT(6*N1-1)=UTBL(6*N1-1)-UTMBL(6*N1-1) + DUT(6*N1-0)=UTBL(6*N1-0)-UTMBL(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFBL(X).NE.0.0) THEN + CALL AMAT(EFBL(X),S,EFBL(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XR,RY,CT) + ELSE + CT(12*XR-11)=0.0 + CT(12*XR-10)=0.0 + CT(12*XR-9)=0.0 + CT(12*XR-8)=0.0 + CT(12*XR-7)=0.0 + CT(12*XR-6)=0.0 + CT(12*XR-5)=0.0 + CT(12*XR-4)=0.0 + CT(12*XR-3)=0.0 + CT(12*XR-2)=0.0 + CT(12*XR-1)=0.0 + CT(12*XR-0)=0.0 + ENDIF + ENDDO + ENDIF + + IF (myid.gt.(ntasks-1)/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOBR + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+NTOFR+NTOB+NTOBL+X + N1=NANBR(1,X) + N2=NANBR(2,X) + X1=NRXFBR(1,N1) + Y1=NRXFBR(2,N1) + Z1=NRXFBR(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTBR(6*N1-5) + DY1=UTBR(6*N1-4) + DZ1=UTBR(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + DUT(6*N1-5)=UTBR(6*N1-5)-UTMBR(6*N1-5) + DUT(6*N1-4)=UTBR(6*N1-4)-UTMBR(6*N1-4) + DUT(6*N1-3)=UTBR(6*N1-3)-UTMBR(6*N1-3) + DUT(6*N1-2)=UTBR(6*N1-2)-UTMBR(6*N1-2) + DUT(6*N1-1)=UTBR(6*N1-1)-UTMBR(6*N1-1) + DUT(6*N1-0)=UTBR(6*N1-0)-UTMBR(6*N1-0) + DUT(6*N2-5)=UT(6*N2-5)-UTM(6*N2-5) + DUT(6*N2-4)=UT(6*N2-4)-UTM(6*N2-4) + DUT(6*N2-3)=UT(6*N2-3)-UTM(6*N2-3) + DUT(6*N2-2)=UT(6*N2-2)-UTM(6*N2-2) + DUT(6*N2-1)=UT(6*N2-1)-UTM(6*N2-1) + DUT(6*N2-0)=UT(6*N2-0)-UTM(6*N2-0) + IF (EFBR(X).NE.0.0) THEN + CALL AMAT(EFBR(X),S,EFBR(X)/2.0,X1+DX1,Y1+DY1,Z1+DZ1, + 1 X2+DX2,Y2+DY2,Z2+DZ2,L,DUT,N1,N2,XR,RY,CT) + ELSE + CT(12*XR-11)=0.0 + CT(12*XR-10)=0.0 + CT(12*XR-9)=0.0 + CT(12*XR-8)=0.0 + CT(12*XR-7)=0.0 + CT(12*XR-6)=0.0 + CT(12*XR-5)=0.0 + CT(12*XR-4)=0.0 + CT(12*XR-3)=0.0 + CT(12*XR-2)=0.0 + CT(12*XR-1)=0.0 + CT(12*XR-0)=0.0 + ENDIF + ENDDO + ENDIF +c---------------------------------------------- + + DO X=1,NTOT + N1=NAN(1,X) + N2=NAN(2,X) + X1=NRXF(1,N1) + Y1=NRXF(2,N1) + Z1=NRXF(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UT(6*N1-5) + DY1=UT(6*N1-4) + DZ1=UT(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N1-5)= A(6*N1-5) + 1 + TT(1,1)*CT(12*X-11) + TT(1,2)*CT(12*X-10) + 1 + TT(1,3)*CT(12*X-9) + A(6*N1-4)= A(6*N1-4) + 1 + TT(2,1)*CT(12*X-11) + TT(2,2)*CT(12*X-10) + 1 + TT(2,3)*CT(12*X-9) + A(6*N1-3)= A(6*N1-3) + 1 + TT(3,1)*CT(12*X-11) + TT(3,2)*CT(12*X-10) + 1 + TT(3,3)*CT(12*X-9) + A(6*N1-2)= A(6*N1-2) + 1 + TT(4,4)*CT(12*X-8) + 1 + TT(4,5)*CT(12*X-7) + TT(4,6)*CT(12*X-6) + A(6*N1-1)= A(6*N1-1) + 1 + TT(5,4)*CT(12*X-8) + 1 + TT(5,5)*CT(12*X-7) + TT(5,6)*CT(12*X-6) + A(6*N1-0)= A(6*N1-0) + 1 + TT(6,4)*CT(12*X-8) + 1 + TT(6,5)*CT(12*X-7) + TT(6,6)*CT(12*X-6) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*X-5) + TT(7,8)*CT(12*X-4) + 1 + TT(7,9)*CT(12*X-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*X-5) + TT(8,8)*CT(12*X-4) + 1 + TT(8,9)*CT(12*X-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*X-5) + TT(9,8)*CT(12*X-4) + 1 + TT(9,9)*CT(12*X-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*X-2) + TT(10,11)*CT(12*X-1) + 1 + TT(10,12)*CT(12*X-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*X-2) + TT(11,11)*CT(12*X-1) + 1 + TT(11,12)*CT(12*X-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*X-2) + TT(12,11)*CT(12*X-1) + 1 + TT(12,12)*CT(12*X-0) + ENDDO + + IF (MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOL + XL=NTOT+X + N1=NANL(1,X) + N2=NANL(2,X) + X1=NRXFL(1,N1) + Y1=NRXFL(2,N1) + Z1=NRXFL(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTL(6*N1-5) + DY1=UTL(6*N1-4) + DZ1=UTL(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XL-5) + TT(7,8)*CT(12*XL-4) + 1 + TT(7,9)*CT(12*XL-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XL-5) + TT(8,8)*CT(12*XL-4) + 1 + TT(8,9)*CT(12*XL-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XL-5) + TT(9,8)*CT(12*XL-4) + 1 + TT(9,9)*CT(12*XL-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XL-2) + 1 + TT(10,11)*CT(12*XL-1) + TT(10,12)*CT(12*XL-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XL-2) + 1 + TT(11,11)*CT(12*XL-1) + TT(11,12)*CT(12*XL-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XL-2) + 1 + TT(12,11)*CT(12*XL-1) + TT(12,12)*CT(12*XL-0) + ENDDO + ENDIF + + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOR + XR=NTOT+NTOL+X + N1=NANR(1,X) + N2=NANR(2,X) + X1=NRXFR(1,N1) + Y1=NRXFR(2,N1) + Z1=NRXFR(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTR(6*N1-5) + DY1=UTR(6*N1-4) + DZ1=UTR(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XR-5) + TT(7,8)*CT(12*XR-4) + 1 + TT(7,9)*CT(12*XR-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XR-5) + TT(8,8)*CT(12*XR-4) + 1 + TT(8,9)*CT(12*XR-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XR-5) + TT(9,8)*CT(12*XR-4) + 1 + TT(9,9)*CT(12*XR-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XR-2) + 1 + TT(10,11)*CT(12*XR-1) + TT(10,12)*CT(12*XR-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XR-2) + 1 + TT(11,11)*CT(12*XR-1) + TT(11,12)*CT(12*XR-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XR-2) + 1 + TT(12,11)*CT(12*XR-1) + TT(12,12)*CT(12*XR-0) + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + DO X=1,NTOF + XR=NTOT+NTOL+NTOR+X + N1=NANF(1,X) + N2=NANF(2,X) + X1=NRXFF(1,N1) + Y1=NRXFF(2,N1) + Z1=NRXFF(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTF(6*N1-5) + DY1=UTF(6*N1-4) + DZ1=UTF(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XR-5) + TT(7,8)*CT(12*XR-4) + 1 + TT(7,9)*CT(12*XR-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XR-5) + TT(8,8)*CT(12*XR-4) + 1 + TT(8,9)*CT(12*XR-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XR-5) + TT(9,8)*CT(12*XR-4) + 1 + TT(9,9)*CT(12*XR-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XR-2) + 1 + TT(10,11)*CT(12*XR-1) + TT(10,12)*CT(12*XR-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XR-2) + 1 + TT(11,11)*CT(12*XR-1) + TT(11,12)*CT(12*XR-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XR-2) + 1 + TT(12,11)*CT(12*XR-1) + TT(12,12)*CT(12*XR-0) + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOFL + XR=NTOT+NTOL+NTOR+NTOF+X + N1=NANFL(1,X) + N2=NANFL(2,X) + X1=NRXFFL(1,N1) + Y1=NRXFFL(2,N1) + Z1=NRXFFL(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTFL(6*N1-5) + DY1=UTFL(6*N1-4) + DZ1=UTFL(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XR-5) + TT(7,8)*CT(12*XR-4) + 1 + TT(7,9)*CT(12*XR-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XR-5) + TT(8,8)*CT(12*XR-4) + 1 + TT(8,9)*CT(12*XR-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XR-5) + TT(9,8)*CT(12*XR-4) + 1 + TT(9,9)*CT(12*XR-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XR-2) + 1 + TT(10,11)*CT(12*XR-1) + TT(10,12)*CT(12*XR-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XR-2) + 1 + TT(11,11)*CT(12*XR-1) + TT(11,12)*CT(12*XR-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XR-2) + 1 + TT(12,11)*CT(12*XR-1) + TT(12,12)*CT(12*XR-0) + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOFR + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+X + N1=NANFR(1,X) + N2=NANFR(2,X) + X1=NRXFFR(1,N1) + Y1=NRXFFR(2,N1) + Z1=NRXFFR(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTFR(6*N1-5) + DY1=UTFR(6*N1-4) + DZ1=UTFR(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XR-5) + TT(7,8)*CT(12*XR-4) + 1 + TT(7,9)*CT(12*XR-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XR-5) + TT(8,8)*CT(12*XR-4) + 1 + TT(8,9)*CT(12*XR-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XR-5) + TT(9,8)*CT(12*XR-4) + 1 + TT(9,9)*CT(12*XR-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XR-2) + 1 + TT(10,11)*CT(12*XR-1) + TT(10,12)*CT(12*XR-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XR-2) + 1 + TT(11,11)*CT(12*XR-1) + TT(11,12)*CT(12*XR-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XR-2) + 1 + TT(12,11)*CT(12*XR-1) + TT(12,12)*CT(12*XR-0) + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN) THEN + DO X=1,NTOB + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+NTOFR+X + N1=NANB(1,X) + N2=NANB(2,X) + X1=NRXFB(1,N1) + Y1=NRXFB(2,N1) + Z1=NRXFB(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTB(6*N1-5) + DY1=UTB(6*N1-4) + DZ1=UTB(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XR-5) + TT(7,8)*CT(12*XR-4) + 1 + TT(7,9)*CT(12*XR-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XR-5) + TT(8,8)*CT(12*XR-4) + 1 + TT(8,9)*CT(12*XR-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XR-5) + TT(9,8)*CT(12*XR-4) + 1 + TT(9,9)*CT(12*XR-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XR-2) + 1 + TT(10,11)*CT(12*XR-1) + TT(10,12)*CT(12*XR-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XR-2) + 1 + TT(11,11)*CT(12*XR-1) + TT(11,12)*CT(12*XR-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XR-2) + 1 + TT(12,11)*CT(12*XR-1) + TT(12,12)*CT(12*XR-0) + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOBL + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+NTOFR+NTOB+X + N1=NANBL(1,X) + N2=NANBL(2,X) + X1=NRXFBL(1,N1) + Y1=NRXFBL(2,N1) + Z1=NRXFBL(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTBL(6*N1-5) + DY1=UTBL(6*N1-4) + DZ1=UTBL(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XR-5) + TT(7,8)*CT(12*XR-4) + 1 + TT(7,9)*CT(12*XR-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XR-5) + TT(8,8)*CT(12*XR-4) + 1 + TT(8,9)*CT(12*XR-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XR-5) + TT(9,8)*CT(12*XR-4) + 1 + TT(9,9)*CT(12*XR-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XR-2) + 1 + TT(10,11)*CT(12*XR-1) + TT(10,12)*CT(12*XR-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XR-2) + 1 + TT(11,11)*CT(12*XR-1) + TT(11,12)*CT(12*XR-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XR-2) + 1 + TT(12,11)*CT(12*XR-1) + TT(12,12)*CT(12*XR-0) + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOBR + XR=NTOT+NTOL+NTOR+NTOF+NTOFL+NTOFR+NTOB+NTOBL+X + N1=NANBR(1,X) + N2=NANBR(2,X) + X1=NRXFBR(1,N1) + Y1=NRXFBR(2,N1) + Z1=NRXFBR(3,N1) + X2=NRXF(1,N2) + Y2=NRXF(2,N2) + Z2=NRXF(3,N2) + DX1=UTBR(6*N1-5) + DY1=UTBR(6*N1-4) + DZ1=UTBR(6*N1-3) + DX2=UT(6*N2-5) + DY2=UT(6*N2-4) + DZ2=UT(6*N2-3) + CALL TTMAT(X1+DX1,Y1+DY1,Z1+DZ1,X2+DX2,Y2+DY2,Z2+DZ2,RY,TT) + A(6*N2-5)= A(6*N2-5) + 1 + TT(7,7)*CT(12*XR-5) + TT(7,8)*CT(12*XR-4) + 1 + TT(7,9)*CT(12*XR-3) + A(6*N2-4)= A(6*N2-4) + 1 + TT(8,7)*CT(12*XR-5) + TT(8,8)*CT(12*XR-4) + 1 + TT(8,9)*CT(12*XR-3) + A(6*N2-3)= A(6*N2-3) + 1 + TT(9,7)*CT(12*XR-5) + TT(9,8)*CT(12*XR-4) + 1 + TT(9,9)*CT(12*XR-3) + A(6*N2-2)= A(6*N2-2) + 1 + TT(10,10)*CT(12*XR-2) + 1 + TT(10,11)*CT(12*XR-1) + TT(10,12)*CT(12*XR-0) + A(6*N2-1)= A(6*N2-1) + 1 + TT(11,10)*CT(12*XR-2) + 1 + TT(11,11)*CT(12*XR-1) + TT(11,12)*CT(12*XR-0) + A(6*N2-0)= A(6*N2-0) + 1 + TT(12,10)*CT(12*XR-2) + 1 + TT(12,11)*CT(12*XR-1) + TT(12,12)*CT(12*XR-0) + ENDDO + ENDIF + +c------------------------------------------------------------------------ + + DO X=1,NN + C(6*X-5)= (MFIL(X)/DT**2)*UTM(6*X-5)-(2*MFIL(X)/DT**2)*UT(6*X-5) + C(6*X-4)= (MFIL(X)/DT**2)*UTM(6*X-4)-(2*MFIL(X)/DT**2)*UT(6*X-4) + C(6*X-3)= (MFIL(X)/DT**2)*UTM(6*X-3)-(2*MFIL(X)/DT**2)*UT(6*X-3) + C(6*X-2)= ((MFIL(X)*JS/M)/DT**2)* + 1 UTM(6*X-2)-(2*(MFIL(X)*JS/M)/DT**2)*UT(6*X-2) + C(6*X-1)= ((MFIL(X)*JS/M)/DT**2)* + 1 UTM(6*X-1)-(2*(MFIL(X)*JS/M)/DT**2)*UT(6*X-1) + C(6*X-0)= ((MFIL(X)*JS/M)/DT**2)* + 1 UTM(6*X-0)-(2*(MFIL(X)*JS/M)/DT**2)*UT(6*X-0) + ENDDO + + + DO X=1,NN + F(6*X-5)= -(VDP(X)/(DT*2))*UTM(6*X-5) + F(6*X-4)= -(VDP(X)/(DT*2))*UTM(6*X-4) + F(6*X-3)= -(VDP(X)/(DT*2))*UTM(6*X-3) + F(6*X-2)= -(VDP(X)/(DT*2))*UTM(6*X-2) + F(6*X-1)= -(VDP(X)/(DT*2))*UTM(6*X-1) + F(6*X-0)= -(VDP(X)/(DT*2))*UTM(6*X-0) + END DO + + DO X=1,6*NN + R(X)=-A(X)-C(X)-F(X) + EN(X)=EN(X)+A(X)*(UT(X)-UTM(X)) + END DO + + RETURN + END + + + + + diff --git a/effload2.f b/effload2.f new file mode 100644 index 0000000..2a70b49 --- /dev/null +++ b/effload2.f @@ -0,0 +1,531 @@ + SUBROUTINE EFFLOAD2(S,NTOT,NN,T,DT,M,JS,DMP,DMP2,UT,UTM,D,EN,RY, + 1 FXF,FXC,VDP,DPE,EF,EFL,EFR,NAN,NRXF,MFIL,CT,NANL,NANR,NTOL, + 1 NTOR,NRXFL,NRXFR,UTL,UTR,myid,ntasks,FXL,FXFL,FXR,FXFR,L, + 1 NTOF,NTOB,NRXFF,NRXFB,UTF,UTB,EFF,EFB, + 1 FXCF,FXFF,FXCB,FXFB,NANB,NANF,PNN,YN, + 1 NANFL,NANFR,NANBL,NANBR, + 1 NRXFFL,NRXFFR,NRXFBL,NRXFBR, + 1 UTFL,UTFR,UTBL,UTBR, + 1 EFFL,EFFR,EFBL,EFBR, + 1 NTOFL,NTOFR,NTOBL,NTOBR, + 1 FXCFL,FXFFL,FXCBL,FXFBL, + 1 FXCFR,FXFFR,FXCBR,FXFBR) + + IMPLICIT NONE + include 'mpif.h' + include 'param.dat' + REAL*8 MFIL(NOMA),NRXF(3,NOMA),VDP(NOMA) + REAL*8 NRXFL(3,NOMA),NRXFR(3,NOMA) + REAL*8 NRXFF(3,NOMA),NRXFB(3,NOMA) + REAL*8 NRXFFL(3,NOMA),NRXFBL(3,NOMA) + REAL*8 NRXFFR(3,NOMA),NRXFBR(3,NOMA) + REAL*8 UTF(NODM),UTB(NODM) + REAL*8 UTFL(NODM),UTBL(NODM) + REAL*8 UTFR(NODM),UTBR(NODM) + REAL*8 D(NODM) + REAL*8 UT(NODM),UTM(NODM),EF(NOCON),EFL(NOCON) + REAL*8 UTL(NODM),UTML(NODM),EFR(NOCON) + REAL*8 UTR(NODM),UTMR(NODM),LNN,UTMB(NODM),UTMF(NODM) + REAL*8 UTMBL(NODM),UTMFL(NODM),UTMBR(NODM),UTMFR(NODM) + REAL*8 DUT(NODM),CT(NODC),EN(NODM),R(NODM) + INTEGER FXF(2,NODC),FXFL(2,NODC),FXFR(2,NODC) + INTEGER FXFF(2,NODC),FXFB(2,NODC),YN + INTEGER FXFFL(2,NODC),FXFBL(2,NODC) + INTEGER FXFFR(2,NODC),FXFBR(2,NODC) + REAL*8 DPE,S,E,EFB(NOCON),EFF(NOCON) + REAL*8 EFBL(NOCON),EFFL(NOCON) + REAL*8 EFBR(NOCON),EFFR(NOCON) + REAL*8 T,DT,M,JS,L,ALF,DMP + REAL*8 G,X1,Y1,Z1,X2,Y2,Z2,TT(12,12) + REAL*8 DX1,DY1,DZ1,DX2,DY2,DZ2,DMP2 + REAL*8 DP,DP2 + INTEGER NTOT,N,NL,NB,N1,N2,X,XL,XR,PNN(0:5000) + INTEGER I,J,NN,RY,FXC,FXL,FXR,FXCF,FXCB,NAN(3,NOCON) + INTEGER FXCFL,FXCBL,FXCFR,FXCBR + INTEGER NANL(3,NOMA),NANR(3,NOMA),NTOL,NTOR + INTEGER NANF(3,NOMA),NANB(3,NOMA),NTOF,NTOB + INTEGER NTOFL,NTOFR,NTOBL,NTOBR + INTEGER NANFL(3,NOMA),NANBL(3,NOMA) + INTEGER NANFR(3,NOMA),NANBR(3,NOMA) + INTEGER dest,source,tag,stat(MPI_STATUS_SIZE),comm + INTEGER myid,ntasks,ierr + + DO I=1,6*NN + D(I)=0.0 + END DO + + + dest=myid+1 + source=myid-1 + tag=133 + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTML,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-1 + source=myid+1 + tag=135 + IF (MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN + source=myid-ntasks/YN + tag=137 + IF (myid.lt.(YN-1)*ntasks/YN) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN) + 1CALL MPI_Recv(UTMB,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN+1 + source=myid-ntasks/YN-1 + tag=139 + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTMBL,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN-1 + source=myid-ntasks/YN+1 + tag=141 + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMBR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN + source=myid+ntasks/YN + tag=143 + IF (myid.ge.ntasks/YN) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN) + 1CALL MPI_Recv(UTMF,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN+1 + source=myid+ntasks/YN-1 + tag=145 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTMFL,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN-1 + source=myid+ntasks/YN+1 + tag=147 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMFR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + DO X=1,NTOT + IF (EF(X).NE.0.0) THEN + N1=NAN(1,X) + N2=NAN(2,X) + D(6*N1-5)=D(6*N1-5)+(DMP/DT)*((UT(6*N1-5)-UT(6*N2-5)) + 1 -(UTM(6*N1-5)-UTM(6*N2-5))) + D(6*N1-4)=D(6*N1-4)+(DMP/DT)*((UT(6*N1-4)-UT(6*N2-4)) + 1 -(UTM(6*N1-4)-UTM(6*N2-4))) + D(6*N1-3)=D(6*N1-3)+(DMP/DT)*((UT(6*N1-3)-UT(6*N2-3)) + 1 -(UTM(6*N1-3)-UTM(6*N2-3))) + D(6*N1-2)=D(6*N1-2)+(DMP2/DT)*((UT(6*N1-2)-UT(6*N2-2)) + 1 -(UTM(6*N1-2)-UTM(6*N2-2))) + D(6*N1-1)=D(6*N1-1)+(DMP2/DT)*((UT(6*N1-1)-UT(6*N2-1)) + 1 -(UTM(6*N1-1)-UTM(6*N2-1))) + D(6*N1-0)=D(6*N1-0)+(DMP2/DT)*((UT(6*N1-0)-UT(6*N2-0)) + 1 -(UTM(6*N1-0)-UTM(6*N2-0))) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UT(6*N1-5)) + 1 -(UTM(6*N2-5)-UTM(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UT(6*N1-4)) + 1 -(UTM(6*N2-4)-UTM(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UT(6*N1-3)) + 1 -(UTM(6*N2-3)-UTM(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UT(6*N1-2)) + 1 -(UTM(6*N2-2)-UTM(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UT(6*N1-1)) + 1 -(UTM(6*N2-1)-UTM(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UT(6*N1-0)) + 1 -(UTM(6*N2-0)-UTM(6*N1-0))) + ENDIF + ENDDO + + IF (MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOL + IF (EFL(X).NE.0.0) THEN + N1=NANL(1,X) + N2=NANL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTML(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTML(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTML(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTML(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTML(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTML(6*N1-0))) + ENDIF + ENDDO + ENDIF + + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOR + IF (EFR(X).NE.0.0) THEN + N1=NANR(1,X) + N2=NANR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMR(6*N1-0))) + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + DO X=1,NTOF + IF (EFF(X).NE.0.0) THEN + N1=NANF(1,X) + N2=NANF(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTF(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMF(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTF(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMF(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTF(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMF(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTF(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMF(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTF(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMF(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTF(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMF(6*N1-0))) + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOFL + IF (EFFL(X).NE.0.0) THEN + N1=NANFL(1,X) + N2=NANFL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFL(6*N1-0))) + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOFR + IF (EFFR(X).NE.0.0) THEN + N1=NANFR(1,X) + N2=NANFR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFR(6*N1-0))) + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN) THEN + DO X=1,NTOB + IF (EFB(X).NE.0.0) THEN + N1=NANB(1,X) + N2=NANB(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTB(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMB(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTB(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMB(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTB(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMB(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTB(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMB(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTB(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMB(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTB(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMB(6*N1-0))) + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOBL + IF (EFBL(X).NE.0.0) THEN + N1=NANBL(1,X) + N2=NANBL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBL(6*N1-0))) + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOBR + IF (EFBR(X).NE.0.0) THEN + N1=NANBR(1,X) + N2=NANBR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBR(6*N1-0))) + ENDIF + ENDDO + ENDIF + +c----------------------------------------------------------------- + DO X=1,FXC + N1=FXF(1,X) + N2=FXF(2,X) + D(6*N1-5)=D(6*N1-5)+(DMP/DT)*((UT(6*N1-5)-UT(6*N2-5)) + 1 -(UTM(6*N1-5)-UTM(6*N2-5))) + D(6*N1-4)=D(6*N1-4)+(DMP/DT)*((UT(6*N1-4)-UT(6*N2-4)) + 1 -(UTM(6*N1-4)-UTM(6*N2-4))) + D(6*N1-3)=D(6*N1-3)+(DMP/DT)*((UT(6*N1-3)-UT(6*N2-3)) + 1 -(UTM(6*N1-3)-UTM(6*N2-3))) + D(6*N1-2)=D(6*N1-2)+(DMP2/DT)*((UT(6*N1-2)-UT(6*N2-2)) + 1 -(UTM(6*N1-2)-UTM(6*N2-2))) + D(6*N1-1)=D(6*N1-1)+(DMP2/DT)*((UT(6*N1-1)-UT(6*N2-1)) + 1 -(UTM(6*N1-1)-UTM(6*N2-1))) + D(6*N1-0)=D(6*N1-0)+(DMP2/DT)*((UT(6*N1-0)-UT(6*N2-0)) + 1 -(UTM(6*N1-0)-UTM(6*N2-0))) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UT(6*N1-5)) + 1 -(UTM(6*N2-5)-UTM(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UT(6*N1-4)) + 1 -(UTM(6*N2-4)-UTM(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UT(6*N1-3)) + 1 -(UTM(6*N2-3)-UTM(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UT(6*N1-2)) + 1 -(UTM(6*N2-2)-UTM(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UT(6*N1-1)) + 1 -(UTM(6*N2-1)-UTM(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UT(6*N1-0)) + 1 -(UTM(6*N2-0)-UTM(6*N1-0))) + ENDDO + + IF (MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,FXL + N1=FXFL(1,X) + N2=FXFL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTML(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTML(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTML(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTML(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTML(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTML(6*N1-0))) + ENDDO + ENDIF + + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,FXR + N1=FXFR(1,X) + N2=FXFR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMR(6*N1-0))) + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + DO X=1,FXCF + N1=FXFF(1,X) + N2=FXFF(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTF(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMF(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTF(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMF(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTF(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMF(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTF(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMF(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTF(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMF(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTF(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMF(6*N1-0))) + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,FXCFL + N1=FXFFL(1,X) + N2=FXFFL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFL(6*N1-0))) + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,FXCFR + N1=FXFFR(1,X) + N2=FXFFR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFR(6*N1-0))) + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN) THEN + DO X=1,FXCB + N1=FXFB(1,X) + N2=FXFB(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTB(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMB(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTB(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMB(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTB(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMB(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTB(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMB(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTB(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMB(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTB(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMB(6*N1-0))) + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,FXCBL + N1=FXFBL(1,X) + N2=FXFBL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBL(6*N1-0))) + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,FXCBR + N1=FXFBR(1,X) + N2=FXFBR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBR(6*N1-0))) + ENDDO + ENDIF + + + RETURN + END + + + + + diff --git a/effload3.f b/effload3.f new file mode 100644 index 0000000..140e572 --- /dev/null +++ b/effload3.f @@ -0,0 +1,747 @@ + SUBROUTINE EFFLOAD2(S,NTOT,NN,T,DT,M,JS,DMP,DMP2,UT,UTM,D,EN,RY, + 1 FXF,FXC,VDP,DPE,EF,EFL,EFR,NAN,NRXF,MFIL,CT,NANL,NANR,NTOL, + 1 NTOR,NRXFL,NRXFR,UTL,UTR,myid,ntasks,FXL,FXFL,FXR,FXFR,L, + 1 NTOF,NTOB,NRXFF,NRXFB,UTF,UTB,EFF,EFB, + 1 FXCF,FXFF,FXCB,FXFB,NANB,NANF,PNN,YN, + 1 NANFL,NANFR,NANBL,NANBR, + 1 NRXFFL,NRXFFR,NRXFBL,NRXFBR, + 1 UTFL,UTFR,UTBL,UTBR, + 1 EFFL,EFFR,EFBL,EFBR, + 1 NTOFL,NTOFR,NTOBL,NTOBR, + 1 FXCFL,FXFFL,FXCBL,FXFBL, + 1 FXCFR,FXFFR,FXCBR,FXFBR) + + IMPLICIT NONE + include 'mpif.h' + include 'param.dat' + REAL*8 MFIL(NOMA),NRXF(3,NOMA),VDP(NOMA) + REAL*8 NRXFL(3,NOMA),NRXFR(3,NOMA) + REAL*8 NRXFF(3,NOMA),NRXFB(3,NOMA) + REAL*8 NRXFFL(3,NOMA),NRXFBL(3,NOMA) + REAL*8 NRXFFR(3,NOMA),NRXFBR(3,NOMA) + REAL*8 UTF(NODM),UTB(NODM) + REAL*8 UTFL(NODM),UTBL(NODM) + REAL*8 UTFR(NODM),UTBR(NODM) + REAL*8 D(NODM) + REAL*8 UT(NODM),UTM(NODM),EF(NOCON),EFL(NOCON) + REAL*8 UTL(NODM),UTML(NODM),EFR(NOCON) + REAL*8 UTR(NODM),UTMR(NODM),LNN,UTMB(NODM),UTMF(NODM) + REAL*8 UTMBL(NODM),UTMFL(NODM),UTMBR(NODM),UTMFR(NODM) + REAL*8 DUT(NODM),CT(NODC),EN(NODM),R(NODM) + INTEGER FXF(2,NODC),FXFL(2,NODC),FXFR(2,NODC) + INTEGER FXFF(2,NODC),FXFB(2,NODC),YN + INTEGER FXFFL(2,NODC),FXFBL(2,NODC) + INTEGER FXFFR(2,NODC),FXFBR(2,NODC) + REAL*8 DPE,S,E,EFB(NOCON),EFF(NOCON) + REAL*8 EFBL(NOCON),EFFL(NOCON) + REAL*8 EFBR(NOCON),EFFR(NOCON) + REAL*8 T,DT,M,JS,L,ALF,DMP + REAL*8 G,X1,Y1,Z1,X2,Y2,Z2,TT(12,12) + REAL*8 DX1,DY1,DZ1,DX2,DY2,DZ2,DMP2 + REAL*8 DP,DP2 + INTEGER NTOT,N,NL,NB,N1,N2,X,XL,XR,PNN(0:5000) + INTEGER I,J,NN,RY,FXC,FXL,FXR,FXCF,FXCB,NAN(3,NOCON) + INTEGER FXCFL,FXCBL,FXCFR,FXCBR + INTEGER NANL(3,NOMA),NANR(3,NOMA),NTOL,NTOR + INTEGER NANF(3,NOMA),NANB(3,NOMA),NTOF,NTOB + INTEGER NTOFL,NTOFR,NTOBL,NTOBR + INTEGER NANFL(3,NOMA),NANBL(3,NOMA) + INTEGER NANFR(3,NOMA),NANBR(3,NOMA) + INTEGER dest,source,tag,stat(MPI_STATUS_SIZE),comm + INTEGER myid,ntasks,ierr + + DO I=1,6*NN + D(I)=0.0 + END DO + + + dest=myid+1 + source=myid-1 + tag=133 + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTML,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-1 + source=myid+1 + tag=135 + IF (MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN + source=myid-ntasks/YN + tag=137 + IF (myid.lt.(YN-1)*ntasks/YN) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN) + 1CALL MPI_Recv(UTMB,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN+1 + source=myid-ntasks/YN-1 + tag=139 + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTMBL,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN-1 + source=myid-ntasks/YN+1 + tag=141 + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMBR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN + source=myid+ntasks/YN + tag=143 + IF (myid.ge.ntasks/YN) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN) + 1CALL MPI_Recv(UTMF,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN+1 + source=myid+ntasks/YN-1 + tag=145 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Recv(UTMFL,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN-1 + source=myid+ntasks/YN+1 + tag=147 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) + 1CALL MPI_Send(UTM,6*NN,MPI_DOUBLE_PRECISION, + 1dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN + 1.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) + 1CALL MPI_Recv(UTMFR,6*PNN(source),MPI_DOUBLE_PRECISION, + 1source,tag,MPI_COMM_WORLD,stat,ierr) + + DO X=1,NTOT + IF (EF(X).NE.0.0) THEN + N1=NAN(1,X) + N2=NAN(2,X) + D(6*N1-5)=D(6*N1-5)+(DMP/DT)*((UT(6*N1-5)-UT(6*N2-5)) + 1 -(UTM(6*N1-5)-UTM(6*N2-5))) + D(6*N1-4)=D(6*N1-4)+(DMP/DT)*((UT(6*N1-4)-UT(6*N2-4)) + 1 -(UTM(6*N1-4)-UTM(6*N2-4))) + D(6*N1-3)=D(6*N1-3)+(DMP/DT)*((UT(6*N1-3)-UT(6*N2-3)) + 1 -(UTM(6*N1-3)-UTM(6*N2-3))) + D(6*N1-2)=D(6*N1-2)+(DMP2/DT)*((UT(6*N1-2)-UT(6*N2-2)) + 1 -(UTM(6*N1-2)-UTM(6*N2-2))) + D(6*N1-1)=D(6*N1-1)+(DMP2/DT)*((UT(6*N1-1)-UT(6*N2-1)) + 1 -(UTM(6*N1-1)-UTM(6*N2-1))) + D(6*N1-0)=D(6*N1-0)+(DMP2/DT)*((UT(6*N1-0)-UT(6*N2-0)) + 1 -(UTM(6*N1-0)-UTM(6*N2-0))) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UT(6*N1-5)) + 1 -(UTM(6*N2-5)-UTM(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UT(6*N1-4)) + 1 -(UTM(6*N2-4)-UTM(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UT(6*N1-3)) + 1 -(UTM(6*N2-3)-UTM(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UT(6*N1-2)) + 1 -(UTM(6*N2-2)-UTM(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UT(6*N1-1)) + 1 -(UTM(6*N2-1)-UTM(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UT(6*N1-0)) + 1 -(UTM(6*N2-0)-UTM(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UT(6*N1-5)) + 1 -(UTM(6*N2-5)-UTM(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UT(6*N1-4)) + 1 -(UTM(6*N2-4)-UTM(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UT(6*N1-3)) + 1 -(UTM(6*N2-3)-UTM(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UT(6*N1-2)) + 1 -(UTM(6*N2-2)-UTM(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UT(6*N1-1)) + 1 -(UTM(6*N2-1)-UTM(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UT(6*N1-0)) + 1 -(UTM(6*N2-0)-UTM(6*N1-0)))**2 + ENDIF + ENDDO + + IF (MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOL + IF (EFL(X).NE.0.0) THEN + N1=NANL(1,X) + N2=NANL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTML(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTML(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTML(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTML(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTML(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTML(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTML(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTML(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTML(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTML(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTML(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTML(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOR + IF (EFR(X).NE.0.0) THEN + N1=NANR(1,X) + N2=NANR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMR(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMR(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMR(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMR(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMR(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMR(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMR(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + DO X=1,NTOF + IF (EFF(X).NE.0.0) THEN + N1=NANF(1,X) + N2=NANF(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTF(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMF(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTF(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMF(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTF(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMF(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTF(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMF(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTF(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMF(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTF(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMF(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTF(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMF(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTF(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMF(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTF(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMF(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTF(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMF(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTF(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMF(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTF(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMF(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOFL + IF (EFFL(X).NE.0.0) THEN + N1=NANFL(1,X) + N2=NANFL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFL(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTFL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFL(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTFL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFL(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTFL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFL(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTFL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFL(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTFL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFL(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTFL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFL(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOFR + IF (EFFR(X).NE.0.0) THEN + N1=NANFR(1,X) + N2=NANFR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFR(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTFR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFR(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTFR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFR(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTFR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFR(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTFR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFR(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTFR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFR(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTFR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFR(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN) THEN + DO X=1,NTOB + IF (EFB(X).NE.0.0) THEN + N1=NANB(1,X) + N2=NANB(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTB(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMB(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTB(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMB(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTB(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMB(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTB(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMB(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTB(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMB(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTB(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMB(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTB(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMB(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTB(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMB(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTB(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMB(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTB(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMB(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTB(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMB(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTB(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMB(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,NTOBL + IF (EFBL(X).NE.0.0) THEN + N1=NANBL(1,X) + N2=NANBL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBL(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTBL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBL(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTBL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBL(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTBL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBL(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTBL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBL(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTBL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBL(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTBL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBL(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,NTOBR + IF (EFBR(X).NE.0.0) THEN + N1=NANBR(1,X) + N2=NANBR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBR(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTBR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBR(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTBR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBR(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTBR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBR(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTBR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBR(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTBR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBR(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTBR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBR(6*N1-0)))**2 + ENDIF + ENDDO + ENDIF + +c----------------------------------------------------------------- + DO X=1,FXC + N1=FXF(1,X) + N2=FXF(2,X) + D(6*N1-5)=D(6*N1-5)+(DMP/DT)*((UT(6*N1-5)-UT(6*N2-5)) + 1 -(UTM(6*N1-5)-UTM(6*N2-5))) + D(6*N1-4)=D(6*N1-4)+(DMP/DT)*((UT(6*N1-4)-UT(6*N2-4)) + 1 -(UTM(6*N1-4)-UTM(6*N2-4))) + D(6*N1-3)=D(6*N1-3)+(DMP/DT)*((UT(6*N1-3)-UT(6*N2-3)) + 1 -(UTM(6*N1-3)-UTM(6*N2-3))) + D(6*N1-2)=D(6*N1-2)+(DMP2/DT)*((UT(6*N1-2)-UT(6*N2-2)) + 1 -(UTM(6*N1-2)-UTM(6*N2-2))) + D(6*N1-1)=D(6*N1-1)+(DMP2/DT)*((UT(6*N1-1)-UT(6*N2-1)) + 1 -(UTM(6*N1-1)-UTM(6*N2-1))) + D(6*N1-0)=D(6*N1-0)+(DMP2/DT)*((UT(6*N1-0)-UT(6*N2-0)) + 1 -(UTM(6*N1-0)-UTM(6*N2-0))) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UT(6*N1-5)) + 1 -(UTM(6*N2-5)-UTM(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UT(6*N1-4)) + 1 -(UTM(6*N2-4)-UTM(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UT(6*N1-3)) + 1 -(UTM(6*N2-3)-UTM(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UT(6*N1-2)) + 1 -(UTM(6*N2-2)-UTM(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UT(6*N1-1)) + 1 -(UTM(6*N2-1)-UTM(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UT(6*N1-0)) + 1 -(UTM(6*N2-0)-UTM(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UT(6*N1-5)) + 1 -(UTM(6*N2-5)-UTM(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UT(6*N1-4)) + 1 -(UTM(6*N2-4)-UTM(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UT(6*N1-3)) + 1 -(UTM(6*N2-3)-UTM(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UT(6*N1-2)) + 1 -(UTM(6*N2-2)-UTM(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UT(6*N1-1)) + 1 -(UTM(6*N2-1)-UTM(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UT(6*N1-0)) + 1 -(UTM(6*N2-0)-UTM(6*N1-0)))**2 + ENDDO + + IF (MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,FXL + N1=FXFL(1,X) + N2=FXFL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTML(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTML(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTML(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTML(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTML(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTML(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTML(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTML(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTML(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTML(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTML(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTML(6*N1-0)))**2 + ENDDO + ENDIF + + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,FXR + N1=FXFR(1,X) + N2=FXFR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMR(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMR(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMR(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMR(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMR(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMR(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMR(6*N1-0)))**2 + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + DO X=1,FXCF + N1=FXFF(1,X) + N2=FXFF(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTF(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMF(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTF(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMF(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTF(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMF(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTF(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMF(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTF(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMF(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTF(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMF(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTF(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMF(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTF(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMF(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTF(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMF(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTF(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMF(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTF(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMF(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTF(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMF(6*N1-0)))**2 + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,FXCFL + N1=FXFFL(1,X) + N2=FXFFL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFL(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTFL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFL(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTFL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFL(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTFL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFL(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTFL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFL(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTFL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFL(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTFL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFL(6*N1-0)))**2 + ENDDO + ENDIF + + IF (myid.lt.(YN-1)*ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,FXCFR + N1=FXFFR(1,X) + N2=FXFFR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTFR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTFR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTFR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTFR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTFR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTFR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFR(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTFR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMFR(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTFR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMFR(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTFR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMFR(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTFR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMFR(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTFR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMFR(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTFR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMFR(6*N1-0)))**2 + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN) THEN + DO X=1,FXCB + N1=FXFB(1,X) + N2=FXFB(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTB(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMB(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTB(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMB(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTB(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMB(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTB(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMB(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTB(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMB(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTB(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMB(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTB(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMB(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTB(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMB(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTB(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMB(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTB(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMB(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTB(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMB(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTB(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMB(6*N1-0)))**2 + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO X=1,FXCBL + N1=FXFBL(1,X) + N2=FXFBL(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBL(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBL(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBL(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBL(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBL(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBL(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTBL(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBL(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTBL(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBL(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTBL(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBL(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTBL(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBL(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTBL(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBL(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTBL(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBL(6*N1-0)))**2 + ENDDO + ENDIF + + IF (myid.ge.ntasks/YN + 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO X=1,FXCBR + N1=FXFBR(1,X) + N2=FXFBR(2,X) + D(6*N2-5)=D(6*N2-5)+(DMP/DT)*((UT(6*N2-5)-UTBR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBR(6*N1-5))) + D(6*N2-4)=D(6*N2-4)+(DMP/DT)*((UT(6*N2-4)-UTBR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBR(6*N1-4))) + D(6*N2-3)=D(6*N2-3)+(DMP/DT)*((UT(6*N2-3)-UTBR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBR(6*N1-3))) + D(6*N2-2)=D(6*N2-2)+(DMP2/DT)*((UT(6*N2-2)-UTBR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBR(6*N1-2))) + D(6*N2-1)=D(6*N2-1)+(DMP2/DT)*((UT(6*N2-1)-UTBR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBR(6*N1-1))) + D(6*N2-0)=D(6*N2-0)+(DMP2/DT)*((UT(6*N2-0)-UTBR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBR(6*N1-0))) + DPE=DPE+(DMP/DT)*((UT(6*N2-5)-UTBR(6*N1-5)) + 1 -(UTM(6*N2-5)-UTMBR(6*N1-5)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-4)-UTBR(6*N1-4)) + 1 -(UTM(6*N2-4)-UTMBR(6*N1-4)))**2 + DPE=DPE+(DMP/DT)*((UT(6*N2-3)-UTBR(6*N1-3)) + 1 -(UTM(6*N2-3)-UTMBR(6*N1-3)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-2)-UTBR(6*N1-2)) + 1 -(UTM(6*N2-2)-UTMBR(6*N1-2)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-1)-UTBR(6*N1-1)) + 1 -(UTM(6*N2-1)-UTMBR(6*N1-1)))**2 + DPE=DPE+(DMP2/DT)*((UT(6*N2-0)-UTBR(6*N1-0)) + 1 -(UTM(6*N2-0)-UTMBR(6*N1-0)))**2 + ENDDO + ENDIF + + + RETURN + END + + + + + diff --git a/fcc.f90 b/fcc.f90 new file mode 100644 index 0000000..b63f091 --- /dev/null +++ b/fcc.f90 @@ -0,0 +1,119 @@ +Subroutine FIBG3(l,ip,ND,NDLC,NDRC,NDFC,NDBC,NDFRC,NDBRC,NDFLC,NDBLC,myid,maxx,maxy,maxz,minx,miny,minz,ntasks,SCL,YN) + +Implicit none +INCLUDE 'na90.dat' +Real*8 :: box,xo(3,10000000),b,maxx,maxy,maxz,minx,miny,minz,SCL +Integer :: l,ND,ip,i,NDLC,NDRC,NDFC,NDBC,YN,NDFRC,NDBRC,NDFLC,NDBLC +Integer :: myid,ntasks + +Open(510+myid, file='NODFIL2'//na(myid)) + +maxx=0.0 +maxy=0.0 +maxz=0.0 +minx=1.0e+08 +miny=1.0e+08 +minz=1.0e+08 + +box=2.0d0**(2.0d0/3.0d0)*Dfloat(l) ! box size equal to fcc ground state + +Call Initializefcc(box,l,xo,ip,myid,maxx,maxy,maxz,minx,miny,minz,ntasks,SCL,YN) + +Call DT(ip,xo,ND,NDLC,NDRC,NDFC,NDBC,NDFRC,NDBRC,NDFLC,NDBLC,myid,ntasks,SCL,YN) + +!write(*,*) 'NLINKS=',ND+NDLC+NDRC +!write(*,*) +!write(*,*) 'X',maxx +!write(*,*) 'Y',maxy +!write(*,*) 'Z',maxz + +CLOSE(510+myid) + +End Subroutine +!End Program fcc + +!---------------------------------------------------------------! +! Subroutine to set up fcc lattice +Subroutine Initializefcc(box,l,xo,ip,myid,maxx,maxy,maxz,minx,miny,minz,ntasks,SCL,YN) +Implicit None +Real*8 xo(3,10000000),b,x0(3,4),box,maxx,maxy,maxz,minx,miny,minz,SCL +Real*8 xi(3,10000000) +Integer i,j,k,k1,k2,l,ip,myid,ntasks,m,YN + +! Setting up the four atom positions in one box +b=SCL*box/DFloat(l) ! the size of the unit cell is the box length divided by l +x0(:,:)=b/2.0d0; x0(:,1)=0.0d0; x0(3,2)=0.0d0; x0(2,3)=0.0d0; x0(1,4)=0.0d0 + +ip=0 +m=MOD(myid,ntasks/YN) +Do i=1+10*m,10+10*m + Do j=(myid/(ntasks/YN))*10+1,(myid/(ntasks/YN)+1)*10 + Do k=1,l + Do k1=1,4 + If (((x0(2,k1)+Float(j-1)*b5.0)).or.myid.lt.(YN-1)*ntasks/YN) Then + ip=ip+1 + xi(1,ip) = x0(1,k1) + Float(i-1)*b + xi(2,ip) = x0(2,k1) + Float(j-1)*b + xi(3,ip) = x0(3,k1) + Float(k-1)*b + if (xi(1,ip).gt.maxx) maxx=xi(1,ip) + if (xi(2,ip).gt.maxy) maxy=xi(2,ip) + if (xi(3,ip).gt.maxz) maxz=xi(3,ip) + if (xi(1,ip).lt.minx) minx=xi(1,ip) + if (xi(2,ip).lt.miny) miny=xi(2,ip) + if (xi(3,ip).lt.minz) minz=xi(3,ip) + EndIF + EndDo + EndDo + EndDo +End Do + +ip=0 +m=MOD(myid,ntasks/YN) +Do i=1+10*m,10+10*m + Do j=(myid/(ntasks/YN))*10+1,(myid/(ntasks/YN)+1)*10 + Do k=1,l + Do k1=1,4 + If (((x0(2,k1)+Float(j-1)*b5.0)).or.myid.lt.(YN-1)*ntasks/YN) Then + ip=ip+1 + xo(1,ip) = x0(1,k1) + Float(i-1)*b + xo(2,ip) = x0(2,k1) + Float(j-1)*b + xo(3,ip) = x0(3,k1) + Float(k-1)*b + EndIF + EndDo + EndDo + EndDo +End Do + + 12 FORMAT(I8,' ',4F14.7) + +Do i=1,ip + Write(510+myid,12) i,xo(:,i),1.0 + End Do +write(*,*) 'NN=',ip,myid +End Subroutine +!----------------------------------------------------- + +Subroutine BIPINT(x,y,f11,f21,f12,f22,fint) +Implicit none +Real*8 :: x,y,f11,f12,f21,f22,fint +fint=f11*(1.0-x)*(1.0-y)+f21*x*(1.0-y)+f12*(1.0-x)*y+f22*x*y +End Subroutine + +!----------------------------------------------------- + +Subroutine BIPINTN(x,y,f11,f21,f12,f22,dix,diy,diz) +Implicit none +Real*8 :: x,y,f11,f12,f21,f22,dix,diy,diz +REAL*8 norm +dix=(-f11*(1.0-y)+f21*(1.0-y)-f12*y+f22*y)/40.0 +diy=(-f11*(1.0-x)-f21*x+f12*(1.0-x)+f22*x)/40.0 +diz=1.0 +norm=SQRT(dix**2.0+diy**2.0+1.0) +dix=-dix/norm +diy=-diy/norm +diz=diz/norm +!if (dix.gt.0.3) dix=0.3 +!if (diy.gt.0.3) diy=0.3 +!if (dix.lt.-0.3) dix=-0.3 +!if (diy.lt.-0.3) diy=-0.3 +End Subroutine diff --git a/glas.f90 b/glas.f90 new file mode 100644 index 0000000..0b233bc --- /dev/null +++ b/glas.f90 @@ -0,0 +1,187 @@ +Subroutine FIBG3(l,ip,ND,NDLC,NDRC,NDFC,NDBC,NDFRC,NDBRC,NDFLC,NDBLC,myid,maxx,maxy,maxz,minx,miny,minz,ntasks,SCL,YN,grid,melta,wl,UC) + +Implicit none +INCLUDE 'na90.dat' +!Real*8,ALLOCATABLE :: surf(:,:),bed(:,:) +Real*8 surf(-100:2000,-100:2000),bed(-100:2000,-100:2000),melt(-100:2000,-100:2000) +Real*8 :: x,y,s1,b1,b2,u1,grid,m1,melta,wl,UC,z1 +Real*8 :: box,xo(3,1000000),b,maxx,maxy,maxz,minx,miny,minz,SCL +Integer :: l,ND,ip,i,j,NDLC,NDRC,NDFC,NDBC,YN,NDFRC,NDBRC,NDFLC,NDBLC +Integer :: myid,ntasks,N1,N2,xk,yk + +!Open(300,file='mass.dat',STATUS='OLD') +Open(510+myid,file='NODFIL2'//na(myid)) + + 12 FORMAT(2I8,' ',2F14.7) + 13 FORMAT(4F14.7) + 14 FORMAT(3F14.7) + + +!ALLOCATE (surf(-100:1000,-100:1000)) +!ALLOCATE (bed(-100:1000,-100:1000)) + +DO i=-100,2000 +DO j=-100,2000 +surf(i,j)=-100.0 +ENDDO +ENDDO + +DO i=-100,2000 +DO j=-100,2000 +bed(i,j)=1000.0 +ENDDO +ENDDO + + +Open(400,file='mass3.dat',STATUS='OLD') +READ(400,*) N2 +DO I=1,N2 +!READ(400,*) x,y,s1,b1,b2,m1 +READ(400,*) x,y,s1,b1,b2,z1 +y=y-7200.0 +xk=INT(x/grid) +yk=INT(y/grid) +! if (b1.ne.0.0) then +! if (xk.ge.-100.and.yk.ge.-100) bed(xk,yk)=b1+250.0*sin(0.005*y)**8*cos(0.015*y)**2 +! else +if (xk.ge.-100.and.yk.ge.-100) bed(xk,yk)=b1 +! endif +if (xk.ge.-100.and.yk.ge.-100) surf(xk,yk)=s1 +if (xk.ge.-100.and.yk.ge.-100) melt(xk,yk)=0.0 +ENDDO +close(400) + +!DO I=1,N1 +!READ(300,*) x,y,s1,b1 +!xk=INT(x/5.0) +!yk=INT(y/5.0) +!surf(xk,yk)=s1 +!ENDDO + +maxx=0.0 +maxy=0.0 +maxz=0.0 +minx=1.0e+08 +miny=1.0e+08 +minz=1.0e+08 + +box=2.0d0**(2.0d0/3.0d0)*Dfloat(l) ! box size equal to fcc ground state + +Call Initializefcc(box,l,xo,ip,myid,maxx,maxy,maxz,minx,miny,minz,ntasks,SCL,YN,surf,bed,melt,grid,wl,UC) + +Call DT(ip,xo,ND,NDLC,NDRC,NDFC,NDBC,NDFRC,NDBRC,NDFLC,NDBLC,myid,ntasks,SCL,YN) + +!DEALLOCATE (surf) +!DEALLOCATE (bed) + +CLOSE(510+myid) +CLOSE(400) + +End Subroutine + +!---------------------------------------------------------------! + + +Subroutine Initializefcc(box,l,xo,ip,myid,maxx,maxy,maxz,minx,miny,minz,ntasks,SCL,YN,surf,bed,melt,grid,wl,UC) +Implicit None +INCLUDE 'na90.dat' +!Real*8,ALLOCATABLE :: surf(:,:),bed(:,:) +Real*8 surf(-100:2000,-100:2000),bed(-100:2000,-100:2000),melt(-100:2000,-100:2000) +Real*8 xo(3,1000000),b,x0(3,4),box,maxx,maxy,maxz,minx,miny,minz,SCL +!Real*8 z,surf(-100:3000,-100:3000),bed(-100:3000,-100:3000) +Real*8 z,x,y,sint,bint,mint,grid,wl,lc,UC,UCV +Integer i,j,k,k1,k2,l,ip,myid,ntasks,m,YN,xk,yk +! Setting up the four atom positions in one box + +!Open(1510+myid,file='tt'//na(myid)) +11 FORMAT(2I8,' ',2F14.7) +13 FORMAT(4F14.7) + +b=SCL*box/DFloat(l) ! the size of the unit cell is the box length divided by l +x0(:,:)=b/2.0d0; x0(:,1)=0.0d0; x0(3,2)=0.0d0; x0(2,3)=0.0d0; x0(1,4)=0.0d0 + +ip=0 +m=MOD(myid,ntasks/YN) +Do i=1+8*m,8+8*m + Do j=(myid/(ntasks/YN))*8+1,(myid/(ntasks/YN)+1)*8 + Do k=-2,l + Do k1=1,4 + x=(x0(1,k1) + Float(i-1)*b)/grid + y=(x0(2,k1) + Float(j-1)*b)/grid + xk=INT((x0(1,k1) + Float(i-1)*b)/grid) + yk=INT((x0(2,k1) + Float(j-1)*b)/grid) + Call BIPINT(x-xk,y-yk,bed(xk,yk),bed(xk,yk+1),bed(xk+1,yk),bed(xk+1,yk+1),bint) + Call BIPINT(x-xk,y-yk,surf(xk,yk),surf(xk,yk+1),surf(xk+1,yk),surf(xk+1,yk+1),sint) + Call BIPINT(x-xk,y-yk,melt(xk,yk),melt(xk,yk+1),melt(xk+1,yk),melt(xk+1,yk+1),mint) +! bint=bed(xk,yk)+(x-xk)*(bed(xk+1,yk)-bed(xk,yk))+(y-yk)*(bed(xk,yk+1)-bed(xk,yk)) +! sint=surf(xk,yk)+(x-xk)*(surf(xk+1,yk)-surf(xk,yk))+(y-yk)*(surf(xk,yk+1)-surf(xk,yk)) + z=x0(3,k1) + Float(k-1)*b + y=x0(2,k1) + Float(j-1)*b + x=x0(1,k1) + Float(i-1)*b +! write(1510+myid,13) 40.0*x,40.0*y,bint,sint +! If (bed(xk,yk).ne.0.0.and.bed(xk,yk+1).ne.0.0.and.bed(xk+1,yk).ne.0.0.and.bed(xk+1,yk+1).ne.0.0) then +! If ((z.ge.bint+mint.or.z.ge.wl).and.z.le.sint.and.(sint-bint).gt.SCL) Then + If (z.ge.bint+mint.and.z.lt.sint) then +! lc=4420.0+1.5e-04*(x-3300.0)**2+0.42*exp((x-3700.0)/2.0e+02) +! UCV=lc-1500.0*exp(-(x-3500.0)**2/50000.0) +! If (y.lt.lc-UC.or.y.gt.lc.or.z.gt.bint+3.0*SQRT(y-(lc-UC)).or.z.ge.WL-20.0) then +! If (y.lt.lc-UC.or.z.gt.bint+3.0*SQRT(y-(lc-UC)).or.z.ge.WL-40.0) then +! If (y.lt.UCV.or.(z.gt.bint+3.0*sqrt(y-UCV)).or.z.ge.WL-40.0) then + ip=ip+1 + xo(1,ip) = x0(1,k1) + Float(i-1)*b + xo(2,ip) = x0(2,k1) + Float(j-1)*b + xo(3,ip) = x0(3,k1) + Float(k-1)*b + if (xo(1,ip).gt.maxx) maxx=xo(1,ip) + if (xo(2,ip).gt.maxy) maxy=xo(2,ip) + if (xo(3,ip).gt.maxz) maxz=xo(3,ip) + if (xo(1,ip).lt.minx) minx=xo(1,ip) + if (xo(2,ip).lt.miny) miny=xo(2,ip) + if (xo(3,ip).lt.minz) minz=xo(3,ip) +! EndIF +! EndIF + EndIF +! EndIF + EndDo + EndDo + EndDo +End Do + + 12 FORMAT(I8,' ',4F14.7) + +Do i=1,ip + Write(510+myid,12) i,xo(:,i),1.0 + End Do +write(*,*) 'NN=',ip,myid + +!DEALLOCATE (surf) +!DEALLOCATE (bed) + +End Subroutine + +!----------------------------------------------------- + +Subroutine BIPINT(x,y,f11,f12,f21,f22,fint) +Implicit none +Real*8 :: x,y,f11,f12,f21,f22,fint +fint=f11*(1.0-x)*(1.0-y)+f21*x*(1.0-y)+f12*(1.0-x)*y+f22*x*y +End Subroutine + +!----------------------------------------------------- + +Subroutine BIPINTN(x,y,f11,f12,f21,f22,dix,diy,diz,grid) +Implicit none +Real*8 :: x,y,f11,f12,f21,f22,dix,diy,diz,grid +REAL*8 norm +dix=(-f11*(1.0-y)+f21*(1.0-y)-f12*y+f22*y)/grid +diy=(-f11*(1.0-x)-f21*x+f12*(1.0-x)+f22*x)/grid +diz=1.0 +norm=SQRT(dix**2.0+diy**2.0+1.0) +dix=-dix/norm +diy=-diy/norm +diz=diz/norm +!if (dix.gt.0.2) dix=0.2 +!if (diy.gt.0.2) diy=0.2 +!if (dix.lt.-0.2) dix=-0.2 +!if (diy.lt.-0.2) diy=-0.2 +End Subroutine + diff --git a/kmat.f b/kmat.f new file mode 100644 index 0000000..6c6b231 --- /dev/null +++ b/kmat.f @@ -0,0 +1,71 @@ + SUBROUTINE KMAT(E,G,W,L,RY,RK) + + REAL*8 RK(12,12) + REAL*8 E,G,W,L,W4,W2,L2,L3 + INTEGER RY +c COMMON /KM/ RK + + W4=W**4 + W2=W**2 + L2=L**2 + L3=L**3 + +c IF (RY.EQ.1) THEN +c DO 20 J=1,12 +c DO 10 I=1,12 +c RK(I,J)=0.0 +c 10 CONTINUE +c 20 CONTINUE +c ENDIF + + RK(1,1)=E*W2/L + RK(2,2)=E*W4/(L3) + RK(3,3)=E*W4/(L3) + RK(4,4)=G*W4/(6*L) + RK(5,5)=E*W4/(3*L) + RK(6,6)=E*W4/(3*L) + RK(7,7)=E*W2/L + RK(8,8)=E*W4/(L3) + RK(9,9)=E*W4/(L3) + RK(10,10)=G*W4/(6*L) + RK(11,11)=E*W4/(3*L) + RK(12,12)=E*W4/(3*L) + + RK(1,7)=-E*W2/L + RK(7,1)=RK(1,7) + + RK(2,6)=E*W4/(2*L2) + RK(2,8)=-E*W4/(L3) + RK(2,12)=E*W4/(2*L2) + RK(6,2)=RK(2,6) + RK(8,2)=RK(2,8) + RK(12,2)=RK(2,12) + + RK(3,5)=-E*W4/(2*L2) + RK(3,9)=-E*W4/(L3) + RK(3,11)=-E*W4/(2*L2) + RK(5,3)=RK(3,5) + RK(9,3)=RK(3,9) + RK(11,3)=RK(3,11) + + RK(4,10)=-G*W4/(6*L) + RK(10,4)=RK(4,10) + + RK(5,9)=E*W4/(2*L2) + RK(5,11)=E*W4/(6*L) + RK(9,5)=RK(5,9) + RK(11,5)=RK(5,11) + + RK(6,8)=-E*W4/(2*L2) + RK(6,12)=E*W4/(6*L) + RK(8,6)=RK(6,8) + RK(12,6)=RK(6,12) + + RK(8,12)=-E*W4/(2*L2) + RK(12,8)=RK(8,12) + + RK(9,11)=E*W4/(2*L2) + RK(11,9)=RK(9,11) + + RETURN + END diff --git a/ranmar.f b/ranmar.f new file mode 100644 index 0000000..d11c9a3 --- /dev/null +++ b/ranmar.f @@ -0,0 +1,146 @@ +C ===================================================================== + SUBROUTINE RANMAR(RVEC,LENV) +C ===================================================================== +C +C This version is identical to that in CPC software library +C +C Universal random number generator proposed by Marsaglia and Zaman +C in report FSU-SCRI-87-50 +C modified by F. James, 1988 and 1989, to generate a vector +C of pseudorandom numbers RVEC of length LENV, and to put in +C the COMMON block everything needed to specify currrent state, +C and to add input and output entry points RMARIN, RMARUT. +C!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +C!!! Calling sequences for RANMAR: ++ +C!!! CALL RANMAR (RVEC, LEN) returns a vector RVEC of LEN ++ +C!!! 32-bit random floating point numbers between ++ +C!!! zero and one. ++ +C!!! CALL RMARIN(I1,N1,N2) initializes the generator from one ++ +C!!! 32-bit integer I1, and number counts N1,N2 ++ +C!!! (for initializing, set N1=N2=0, but to restart ++ +C!!! a previously generated sequence, use values ++ +C!!! output by RMARUT) ++ +C!!! CALL RMARUT(I1,N1,N2) outputs the value of the original ++ +C!!! seed and the two number counts, to be used ++ +C!!! for restarting by initializing to I1 and ++ +C!!! skipping N1*100000000+N2 numbers. ++ +C!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + DIMENSION RVEC(*) + COMMON/RASET1/U(97),C,I97,J97 + PARAMETER (MODCNS=1000000000) + SAVE CD, CM, TWOM24, NTOT, NTOT2, IJKL + DATA NTOT,NTOT2,IJKL/-1,0,0/ +C + IF (NTOT .GE. 0) GO TO 50 +C +C Default initialization. User has called RANMAR without RMARIN. + IJKL = 54217137 + NTOT = 0 + NTOT2 = 0 + KALLED = 0 + GO TO 1 +C + ENTRY RMARIN(IJKLIN, NTOTIN,NTOT2N) +C Initializing routine for RANMAR, may be called before +C generating pseudorandom numbers with RANMAR. The input +C values should be in the ranges: 0<=IJKLIN<=900 OOO OOO +C 0<=NTOTIN<=999 999 999 +C 0<=NTOT2N<<999 999 999! +C To get the standard values in Marsaglia's paper, IJKLIN=54217137 +C NTOTIN,NTOT2N=0 + IJKL = IJKLIN + NTOT = MAX(NTOTIN,0) + NTOT2= MAX(NTOT2N,0) + KALLED = 1 +C always come here to initialize + 1 CONTINUE + IJ = IJKL/30082 + KL = IJKL - 30082*IJ + I = MOD(IJ/177, 177) + 2 + J = MOD(IJ, 177) + 2 + K = MOD(KL/169, 178) + 1 + L = MOD(KL, 169) +C WRITE(6,'(A,I10,2X,2I10)') ' RANMAR INITIALIZED:',IJKL,NTOT,NTOT2 +CCC PRINT '(A,4I10)', ' I,J,K,L= ',I,J,K,L + DO 2 II= 1, 97 + S = 0. + T = .5 + DO 3 JJ= 1, 24 + M = MOD(MOD(I*J,179)*K, 179) + I = J + J = K + K = M + L = MOD(53*L+1, 169) + IF (MOD(L*M,64) .GE. 32) S = S+T + 3 T = 0.5*T + 2 U(II) = S + TWOM24 = 1.0 + DO 4 I24= 1, 24 + 4 TWOM24 = 0.5*TWOM24 + C = 362436.*TWOM24 + CD = 7654321.*TWOM24 + CM = 16777213.*TWOM24 + I97 = 97 + J97 = 33 +C Complete initialization by skipping +C (NTOT2*MODCNS + NTOT) random numbers + DO 45 LOOP2= 1, NTOT2+1 + NOW = MODCNS + IF (LOOP2 .EQ. NTOT2+1) NOW=NTOT + IF (NOW .GT. 0) THEN + WRITE(6,'(A,I15)') ' RMARIN SKIPPING OVER ',NOW + DO 40 IDUM = 1, NTOT + UNI = U(I97)-U(J97) + IF (UNI .LT. 0.) UNI=UNI+1. + U(I97) = UNI + I97 = I97-1 + IF (I97 .EQ. 0) I97=97 + J97 = J97-1 + IF (J97 .EQ. 0) J97=97 + C = C - CD + IF (C .LT. 0.) C=C+CM + 40 CONTINUE + ENDIF + 45 CONTINUE + IF (KALLED .EQ. 1) RETURN +C +C Normal entry to generate LENV random numbers + 50 CONTINUE + DO 100 IVEC= 1, LENV + UNI = U(I97)-U(J97) + IF (UNI .LT. 0.) UNI=UNI+1. + U(I97) = UNI + I97 = I97-1 + IF (I97 .EQ. 0) I97=97 + J97 = J97-1 + IF (J97 .EQ. 0) J97=97 + C = C - CD + IF (C .LT. 0.) C=C+CM + UNI = UNI-C + IF (UNI .LT. 0.) UNI=UNI+1. + RVEC(IVEC) = UNI +C Replace exact zeros by uniform distr. *2**-24 + IF (UNI .EQ. 0.) THEN + ZUNI = TWOM24*U(2) +C An exact zero here is very unlikely, but let's be safe. + IF (ZUNI .EQ. 0.) ZUNI= TWOM24*TWOM24 + RVEC(IVEC) = ZUNI + ENDIF + 100 CONTINUE + NTOT = NTOT + LENV + IF (NTOT .GE. MODCNS) THEN + NTOT2 = NTOT2 + 1 + NTOT = NTOT - MODCNS + ENDIF + RETURN +C Entry to output current status + ENTRY RMARUT(IJKLUT,NTOTUT,NTOT2T) + IJKLUT = IJKL + NTOTUT = NTOT + NTOT2T = NTOT2 + RETURN + END + + + + diff --git a/rbed.f b/rbed.f new file mode 100644 index 0000000..af7e0ce --- /dev/null +++ b/rbed.f @@ -0,0 +1,59 @@ + PROGRAM STAND + + Real surf(-100:2000,-100:2000),bed(-100:2000,-100:2000) + + REAL X1,Y1,Z1,X2,Y2,Z2,MINX,MINY,MINZ + REAL MAXX,MAXY,MAXZ,PI,F,MFIL(5,1000000) + REAL SZ1,SZ2,SF,X,Y,S1,S2,B,Z,SIT + INTEGER N,T,I,L,IT,J,SCC,SC,IX1,IY1,N2,xk,yk + + 2 FORMAT (A) + 12 FORMAT(6F22.3) + + DO i=-100,2000 + DO j=-100,2000 + bed(i,j)=0.0 + ENDDO + ENDDO + + + Open(400,file='mass3.dat',STATUS='OLD') + Open(500,file='tbed.csv',STATUS='UNKNOWN') + + READ(400,*) N2 + DO I=1,N2 + READ(400,*) x,y,s1,b1,b2,z1 + xk=INT(x/20.0) + yk=INT(y/20.0) + bed(xk,yk)=b2 + ENDDO + close(400) + + + DO i=0,500 + DO j=0,1000 + WRITE(500,*) i*20.0-2000.0,j*20.0-7000.0,bed(i,j) + ENDDO + ENDDO + + STOP + END + + + + + + + + + + + + + + + + + + + diff --git a/rc.f90 b/rc.f90 new file mode 100644 index 0000000..7ba8a9b --- /dev/null +++ b/rc.f90 @@ -0,0 +1,160 @@ + PROGRAM RC + + IMPLICIT NONE + INCLUDE 'param.dat' + INCLUDE 'na90.dat' + INTEGER I,N1,N2,NN,NTOT,NTOR,PTB(0:1000),PNN(0:1000),NTOTW(0:1000) + INTEGER CCN(5000000),CLUST(5000000),CN(5000000),SPN(0:10000) + INTEGER MAXI,MAXCN,my,ntasks + REAL*8 STC,MN,TT,E + REAL*8 X1,Y1,Z1,X2,Y2,Z2 + INTEGER J,TTC,PTR(0:1000),M1,M2,YN,IS,SNN + + + OPEN(UNIT=112,FILE='frag',STATUS='UNKNOWN') + OPEN(UNIT=511,FILE='maxi',STATUS='UNKNOWN') + OPEN(UNIT=512,FILE='Icebergs',STATUS='UNKNOWN') + OPEN(UNIT=311,FILE='crkd',STATUS='UNKNOWN') + + 3 FORMAT(2F11.6,' ',2I6,' ',F11.6) + 4 FORMAT(3F15.6) + + WRITE(*,*) 'ntasks,YN?' + READ(*,*) ntasks,YN + + DO my=0,ntasks-1 + READ(311,*) NTOTW(my),PNN(my),PTR(my),PTB(my) + END DO + + + IS=0 + DO my=0,ntasks-1 + SPN(my)=IS + DO I=1,PNN(my) + IS=IS+1 + CLUST(IS)=IS + CN(IS)=0 + CCN(IS)=0 + END DO + END DO + + SNN=0 + DO my=0,ntasks-1 + WRITE(*,*) 'myid1=',my + OPEN(UNIT=117,FILE='FS'//na(my),STATUS='UNKNOWN') + DO I=1,NTOTW(my) + READ(117,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + N1=N1+SNN + N2=N2+SNN + IF (E.GT.0.0) THEN + M1=CLUST(N1) + M2=CLUST(N2) + MN=MIN(CLUST(N1),CLUST(N2)) + DO J=1+SNN,PNN(my)+SNN + IF (CLUST(J).EQ.M1.OR.CLUST(J).EQ.M2) CLUST(J)=MN + END DO + CLUST(N1)=MN + CLUST(N2)=MN + END IF + END DO + CLOSE(117) + SNN=SNN+PNN(my) + END DO + + DO my=0,ntasks-1 + WRITE(*,*) 'myid2=',my + OPEN(UNIT=117,FILE='FSR'//na(my),STATUS='UNKNOWN') + DO I=1,PTR(my) + READ(117,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + N1=N1+SPN(my+1) + N2=N2+SPN(my) + IF (E.GT.0.0) THEN + M1=CLUST(N1) + M2=CLUST(N2) + MN=MIN(CLUST(N1),CLUST(N2)) + DO J=1,IS + IF (CLUST(J).EQ.M1.OR.CLUST(J).EQ.M2) CLUST(J)=MN + END DO + CLUST(N1)=MN + CLUST(N2)=MN + END IF + END DO + CLOSE(117) + END DO + + DO my=0,ntasks-1 + WRITE(*,*) 'myid3=',my + OPEN(UNIT=117,FILE='FSB'//na(my),STATUS='UNKNOWN') + DO I=1,PTB(my) + READ(117,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + N1=N1+SPN(my-ntasks/YN) + N2=N2+SPN(my) + IF (E.GT.0.0) THEN + M1=CLUST(N1) + M2=CLUST(N2) + MN=MIN(CLUST(N1),CLUST(N2)) + DO J=1,IS + IF (CLUST(J).EQ.M1.OR.CLUST(J).EQ.M2) CLUST(J)=MN + END DO + CLUST(N1)=MN + CLUST(N2)=MN + END IF + END DO + CLOSE(117) + END DO + + DO I=1,IS + CN(CLUST(I))=CN(CLUST(I))+1 + END DO + + MAXCN=0 + DO I=1,IS + CCN(CN(I))=CCN(CN(I))+1 + IF (CN(I).GT.MAXCN) THEN + MAXCN=CN(I) + MAXI=I + ENDIF + END DO + + SNN=0 + DO my=0,ntasks-1 + WRITE(*,*) 'myid4=',my + OPEN(UNIT=117,FILE='NODFIL2'//na(my),STATUS='UNKNOWN') + DO I=1,PNN(my) + READ(117,*) N1,X1,Y1,Z1,E + N1=N1+SNN + IF (CLUST(N1).EQ.MAXI) THEN + WRITE(511,4) X1,Y1,Z1 + ELSE + WRITE(512,4) X1,Y1,Z1 + ENDIF + ENDDO + CLOSE(117) + SNN=SNN+PNN(my) + ENDDO + + + DO I=1,IS + IF (CCN(I).NE.0) WRITE(112,*) I,CCN(I) + END DO + + + TTC=0 + STC=0.0 + DO I=1,IS + TTC=TTC+CCN(I) + STC=STC+I*CCN(I) + END DO + STC=STC/(1.0*TTC) + WRITE(*,*) 'STC=',STC + + CLOSE(112) + CLOSE(511) + + STOP + END + + + + + diff --git a/rc2.f90 b/rc2.f90 new file mode 100644 index 0000000..c244672 --- /dev/null +++ b/rc2.f90 @@ -0,0 +1,155 @@ + PROGRAM RC + + IMPLICIT NONE + INCLUDE 'param.dat' + INCLUDE 'na90.dat' + INTEGER I,N1,N2,NN,NTOT,NTOR,PTB(0:1000),PNN(0:1000),NTOTW(0:1000) + INTEGER CCN(50000000),CLUST(50000000),CN(50000000),SPN(10000) + INTEGER MAXI,MAXCN + REAL*8 STC,MN,TT,E + REAL*8 X1,Y1,Z1,X2,Y2,Z2 + INTEGER J,TTC,ntasks,my,PTR(0:1000),M1,M2,YN,IS,SNN + + OPEN(UNIT=112,FILE='frag',STATUS='UNKNOWN') + OPEN(UNIT=211,FILE='maxi',STATUS='UNKNOWN') + OPEN(UNIT=311,FILE='crkd',STATUS='UNKNOWN') + + 3 FORMAT(2F11.6,' ',2I6,' ',F11.6) + 4 FORMAT(3F15.6) + + WRITE(*,*) 'ntasks,YN?' + READ(*,*) ntasks,YN + + DO my=0,ntasks-1 + READ(311,*) NTOTW(my),PNN(my),PTR(my),PTB(my) + END DO + + + IS=0 + DO my=0,ntasks-1 + SPN(my)=IS + DO I=1,PNN(my) + IS=IS+1 + CLUST(IS)=IS + CN(IS)=0 + CCN(IS)=0 + END DO + END DO + + + SNN=0 + DO my=0,ntasks-1 + WRITE(*,*) 'myid1=',my + OPEN(UNIT=117,FILE='FS'//na(my),STATUS='UNKNOWN') + DO I=1,NTOTW(my) + READ(117,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + N1=N1+SNN + N2=N2+SNN + IF (E.GT.0.0) THEN + M1=CLUST(N1) + M2=CLUST(N2) + MN=MIN(CLUST(N1),CLUST(N2)) + DO J=1+SNN,PNN(my)+SNN + IF (CLUST(J).EQ.M1.OR.CLUST(J).EQ.M2) CLUST(J)=MN + END DO + CLUST(N1)=MN + CLUST(N2)=MN + END IF + END DO + CLOSE(117) + SNN=SNN+PNN(my) + END DO + + DO my=0,ntasks-1 + WRITE(*,*) 'myid2=',my + OPEN(UNIT=117,FILE='FSR'//na(my),STATUS='UNKNOWN') + DO I=1,PTR(my) + READ(117,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + N1=N1+SPN(my+1) + N2=N2+SPN(my) + IF (E.GT.0.0) THEN + M1=CLUST(N1) + M2=CLUST(N2) + MN=MIN(CLUST(N1),CLUST(N2)) + DO J=1,IS + IF (CLUST(J).EQ.M1.OR.CLUST(J).EQ.M2) CLUST(J)=MN + END DO + CLUST(N1)=MN + CLUST(N2)=MN + END IF + END DO + CLOSE(117) + END DO + + DO my=0,ntasks-1 + WRITE(*,*) 'myid3=',my + OPEN(UNIT=117,FILE='FSB'//na(my),STATUS='UNKNOWN') + DO I=1,PTB(my) + READ(117,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + N1=N1+SPN(my-ntasks/YN) + N2=N2+SPN(my) + IF (E.GT.0.0) THEN + M1=CLUST(N1) + M2=CLUST(N2) + MN=MIN(CLUST(N1),CLUST(N2)) + DO J=1,IS + IF (CLUST(J).EQ.M1.OR.CLUST(J).EQ.M2) CLUST(J)=MN + END DO + CLUST(N1)=MN + CLUST(N2)=MN + END IF + END DO + CLOSE(117) + END DO + + DO I=1,IS + CN(CLUST(I))=CN(CLUST(I))+1 + END DO + + MAXCN=0 + DO I=1,IS + CCN(CN(I))=CCN(CN(I))+1 + IF (CN(I).GT.MAXCN) THEN + MAXCN=CN(I) + MAXI=I + ENDIF + END DO + + SNN=0 + DO my=0,ntasks-1 + WRITE(*,*) 'myid4=',my + OPEN(UNIT=117,FILE='NODFIL2'//na(my),STATUS='UNKNOWN') + DO I=1,PNN(my) + READ(117,*) N1,X1,Y1,Z1,E + N1=N1+SNN + IF (CLUST(N1).EQ.MAXI) WRITE(211,4) X1,Y1,Z1 + ENDDO + CLOSE(117) + SNN=SNN+PNN(my) + ENDDO + + + DO I=1,IS + IF (CCN(I).NE.0) WRITE(112,*) I,CCN(I) + END DO + + + TTC=0 + STC=0.0 + DO I=1,IS + TTC=TTC+CCN(I) + STC=STC+I*CCN(I) + END DO + STC=STC/(1.0*TTC) + WRITE(*,*) 'STC=',STC + + CLOSE(112) + CLOSE(211) + + STOP + END + + + + + diff --git a/rdem.f90 b/rdem.f90 new file mode 100644 index 0000000..dfe34e6 --- /dev/null +++ b/rdem.f90 @@ -0,0 +1,65 @@ + PROGRAM STAND + + include 'na90.dat' + REAL AFIL(40,2000),NFIL(40,2000),DX,DY,DZ,LJ,DR,DT + REAL FDY(2,10000),MAX(0:10000,0:10000) + REAL X,Y,Z1,Z,V + INTEGER N,NC,T,I,L,IT,J,IX,IY + CHARACTER*20 INFI + + 2 FORMAT (A) + 12 FORMAT(3F18.7) + + WRITE(*,*) 'INFI?' + READ(*,2) INFI + + WRITE(*,*) 'N?' + READ(*,*) N + + OPEN(UNIT=220,FILE=INFI,STATUS='OLD') + OPEN(UNIT=230,FILE='dem.csv',STATUS='UNKNOWN') + +! DO I=1,2023006 +! READ(220,*) X,Y,Z +! PART(1,I)=X +! PART(2,I)=Y +! PART(3,I)=Z +! ENDDO + + + DO I=0,7000 + DO J=0,7000 + MAX(I,J)=0.0 + ENDDO + ENDDO + + DO I=1,N + READ(220,*) X,Y,Z + IX=INT(X/41.0) + IY=INT(Y/41.0) + IF (Z.GT.MAX(IX,IY)) MAX(IX,IY)=Z + ENDDO + + DO I=0,7000 + DO J=0,7000 + IF (MAX(I,J).GT.10.0) WRITE(230,12) I*41.0,J*41.0,MAX(I,J) + ENDDO + ENDDO + + STOP + END + + + + + + + + + + + + + + + diff --git a/rfr.f90 b/rfr.f90 new file mode 100644 index 0000000..5caacd7 --- /dev/null +++ b/rfr.f90 @@ -0,0 +1,173 @@ + PROGRAM RC + + IMPLICIT NONE + INCLUDE 'param.dat' + INCLUDE 'na90.dat' + INTEGER I,N1,N2,NN,NTOT,NTOR,PTB(0:1000),PNN(0:1000),NTOTW(0:1000) + INTEGER CCN(5000000),CLUST(5000000),CN(5000000),SPN(0:10000) + INTEGER MAXI,MAXCN + REAL*8 STC,MN,TT,E,STR + REAL*8 X1,Y1,Z1,X2,Y2,Z2 + INTEGER J,TTC,ntasks,my,PTR(0:1000),M1,M2,YN,IS,SNN + + + OPEN(UNIT=112,FILE='frag',STATUS='UNKNOWN') + OPEN(UNIT=511,FILE='maxi',STATUS='UNKNOWN') + OPEN(UNIT=512,FILE='maxi1',STATUS='UNKNOWN') + OPEN(UNIT=513,FILE='maxi2',STATUS='UNKNOWN') + OPEN(UNIT=514,FILE='maxi4',STATUS='UNKNOWN') + OPEN(UNIT=515,FILE='maxi8',STATUS='UNKNOWN') + OPEN(UNIT=516,FILE='maxi16',STATUS='UNKNOWN') + OPEN(UNIT=517,FILE='maxi32',STATUS='UNKNOWN') + OPEN(UNIT=518,FILE='maxi64',STATUS='UNKNOWN') + OPEN(UNIT=311,FILE='crkd',STATUS='UNKNOWN') + + 3 FORMAT(2F11.6,' ',2I6,' ',F11.6) + 4 FORMAT(3F15.6) + + WRITE(*,*) 'ntasks,YN?' + READ(*,*) ntasks,YN + + DO my=0,ntasks-1 + READ(311,*) NTOTW(my),PNN(my),PTR(my),PTB(my) + END DO + + + IS=0 + DO my=0,ntasks-1 + SPN(my)=IS + DO I=1,PNN(my) + IS=IS+1 + CLUST(IS)=IS + CN(IS)=0 + CCN(IS)=0 + END DO + END DO + + SNN=0 + DO my=0,ntasks-1 + WRITE(*,*) 'myid1=',my + OPEN(UNIT=117,FILE='FS'//na(my),STATUS='UNKNOWN') + DO I=1,NTOTW(my) + READ(117,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + N1=N1+SNN + N2=N2+SNN + IF (E.NE.0.0) THEN +! IF (E.EQ.0.0.AND.STR.GT.0.002) THEN + M1=CLUST(N1) + M2=CLUST(N2) + MN=MIN(CLUST(N1),CLUST(N2)) + DO J=1+SNN,PNN(my)+SNN + IF (CLUST(J).EQ.M1.OR.CLUST(J).EQ.M2) CLUST(J)=MN + END DO + CLUST(N1)=MN + CLUST(N2)=MN + END IF + END DO + CLOSE(117) + SNN=SNN+PNN(my) + END DO + + DO my=0,ntasks-1 + WRITE(*,*) 'myid2=',my + OPEN(UNIT=117,FILE='FSR'//na(my),STATUS='UNKNOWN') + DO I=1,PTR(my) + READ(117,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + N1=N1+SPN(my+1) + N2=N2+SPN(my) + IF (E.EQ.0.0) THEN + M1=CLUST(N1) + M2=CLUST(N2) + MN=MIN(CLUST(N1),CLUST(N2)) + DO J=1,IS + IF (CLUST(J).EQ.M1.OR.CLUST(J).EQ.M2) CLUST(J)=MN + END DO + CLUST(N1)=MN + CLUST(N2)=MN + END IF + END DO + CLOSE(117) + END DO + + DO my=0,ntasks-1 + WRITE(*,*) 'myid3=',my + OPEN(UNIT=117,FILE='FSB'//na(my),STATUS='UNKNOWN') + DO I=1,PTB(my) + READ(117,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + N1=N1+SPN(my-ntasks/YN) + N2=N2+SPN(my) + IF (E.EQ.0.0) THEN + M1=CLUST(N1) + M2=CLUST(N2) + MN=MIN(CLUST(N1),CLUST(N2)) + DO J=1,IS + IF (CLUST(J).EQ.M1.OR.CLUST(J).EQ.M2) CLUST(J)=MN + END DO + CLUST(N1)=MN + CLUST(N2)=MN + END IF + END DO + CLOSE(117) + END DO + + DO I=1,IS + CN(CLUST(I))=CN(CLUST(I))+1 + END DO + + MAXCN=0 + DO I=1,IS + CCN(CN(I))=CCN(CN(I))+1 + IF (CN(I).GT.MAXCN) THEN + MAXCN=CN(I) + MAXI=I + ENDIF + END DO + + SNN=0 + DO my=0,ntasks-1 + WRITE(*,*) 'myid4=',my + OPEN(UNIT=117,FILE='NODFIL2'//na(my),STATUS='UNKNOWN') + DO I=1,PNN(my) + READ(117,*) N1,X1,Y1,Z1,E + N1=N1+SNN + IF (CLUST(N1).EQ.MAXI) WRITE(511,4) X1,Y1,Z1 + + IF (CN(CLUST(N1)).GT.0.AND.CN(CLUST(N1)).LE.1) WRITE(512,4) X1,Y1,Z1 + IF (CN(CLUST(N1)).GT.1.AND.CN(CLUST(N1)).LE.2) WRITE(513,4) X1,Y1,Z1 + IF (CN(CLUST(N1)).GT.2.AND.CN(CLUST(N1)).LE.4) WRITE(514,4) X1,Y1,Z1 + IF (CN(CLUST(N1)).GT.4.AND.CN(CLUST(N1)).LE.8) WRITE(515,4) X1,Y1,Z1 + IF (CN(CLUST(N1)).GT.8.AND.CN(CLUST(N1)).LE.16) WRITE(516,4) X1,Y1,Z1 + IF (CN(CLUST(N1)).GT.16.AND.CN(CLUST(N1)).LE.32) WRITE(517,4) X1,Y1,Z1 + IF (CN(CLUST(N1)).GT.32.AND.CN(CLUST(N1)).LT.CN(MAXI)) WRITE(518,4) X1,Y1,Z1 + + ENDDO + CLOSE(117) + SNN=SNN+PNN(my) + ENDDO + + + DO I=1,IS + IF (CCN(I).NE.0) WRITE(112,*) I,CCN(I) + END DO + + + TTC=0 + STC=0.0 + DO I=1,IS + TTC=TTC+CCN(I) + STC=STC+I*CCN(I) + END DO + STC=STC/(1.0*TTC) + WRITE(*,*) 'STC=',STC + + CLOSE(112) + CLOSE(511) + CLOSE(311) + + STOP + END + + + + + diff --git a/rfrag.f b/rfrag.f new file mode 100644 index 0000000..13d3103 --- /dev/null +++ b/rfrag.f @@ -0,0 +1,54 @@ + PROGRAM STAND + + REAL X1,Y1,Z1,X2,Y2,Z2,F,MINX,MINY,MINZ + REAL MAXX,MAXY,MAXZ,PI,F + REAL SZ1,SZ2,SF,X,Y,SCL,CCAL1,CCAL2 + INTEGER N,T,I,NN + CHARACTER*20 infil + + 2 FORMAT (A) + 12 FORMAT(2I8,4F18.7) + + WRITE(*,*) 'Infil?' + READ(*,2) infil + + OPEN(UNIT=800,FILE=infil,STATUS='UNKNOWN') + + WRITE(*,*) 'N?' + READ(*,*) N + + WRITE(*,*) 'SCL?' + READ(*,*) SCL + + CCAL1=0.0 + CCAL2=0.0 + DO T=1,N-1 + READ(800,*) I,NN + CCAL1=CCAL1+I*NN*SCL**3.0 + ENDDO + READ(800,*) I,NN + CCAL2=CCAL1+I*NN*SCL**3.0 + + WRITE(*,*) 'Calv=',CCAL1, CCAL1/CCAL2 + + STOP + END + + + + + + + + + + + + + + + + + + + diff --git a/rh.f b/rh.f new file mode 100644 index 0000000..fae6f9b --- /dev/null +++ b/rh.f @@ -0,0 +1,121 @@ + PROGRAM STAND + + REAL X1,Y1,Z1,X2,Y2,Z2,F,MINX,MINY,MINZ,MAX + REAL STR1,SSTR1 + REAL MAXX,MAXY,MAXZ,PI + REAL SZ1,SZ2,SF,X,Y,SX1,SY1,VG(-6000:6000,-6000:6000) + INTEGER N,T,I,L,IT,J,SCC,SC,NG(-6000:6000,-6000:6000) + CHARACTER*20 INFI1,INFI2 + + 2 FORMAT (A) + 12 FORMAT(3F18.7) + + WRITE(*,*) 'INFI1' + READ(*,2) INFI1 + WRITE(*,*) 'INFI2' + READ(*,2) INFI2 + WRITE(*,*) 'N' + READ(*,*) N + N=N/2 + WRITE(*,*) 'MAX' + READ(*,*) MAX + + OPEN(UNIT=700,FILE='str.csv',STATUS='UNKNOWN') + OPEN(UNIT=710,FILE='str2.dat',STATUS='UNKNOWN') + OPEN(UNIT=812,FILE='NG.dat',STATUS='UNKNOWN') + OPEN(UNIT=800,FILE=INFI1,STATUS='UNKNOWN') + OPEN(UNIT=900,FILE=INFI2,STATUS='UNKNOWN') + + + DO J=-6000,6000 + DO I=-6000,6000 + VG(I,J)=0.0 + NG(I,J)=0 + ENDDO + ENDDO + + DO T=1,N + READ(800,*) X1,Y1,Z1 + READ(800,*) STR1 + READ(900,*) SX1,SY1,SZ1 + READ(900,*) SSTR1 + VEL=ABS(STR1-SSTR1) +! WRITE(700,12) X1,Y1,VEL +! IX=INT((X1+SX1)/50.0) +! IY=INT((Y1+SY1)/50.0) + IX=INT((Y1+SY1)/60.0) + IY=INT((Z1+SZ1)/60.0) +! IF ((X1+SX1)/2.0.GT.4500.0) THEN + + VG(IX,IY)=VG(IX,IY)+VEL + NG(IX,IY)=NG(IX,IY)+1 + + VG(IX,IY+1)=VG(IX,IY+1)+VEL + NG(IX,IY+1)=NG(IX,IY+1)+1 + + VG(IX,IY-1)=VG(IX,IY-1)+VEL + NG(IX,IY-1)=NG(IX,IY-1)+1 +!-------------------------------------- + VG(IX+1,IY)=VG(IX+1,IY)+VEL + NG(IX+1,IY)=NG(IX+1,IY)+1 + + VG(IX+1,IY+1)=VG(IX+1,IY+1)+VEL + NG(IX+1,IY+1)=NG(IX+1,IY+1)+1 + + VG(IX+1,IY-1)=VG(IX+1,IY-1)+VEL + NG(IX+1,IY-1)=NG(IX+1,IY-1)+1 +!--------------------------------------- + VG(IX-1,IY)=VG(IX-1,IY)+VEL + NG(IX-1,IY)=NG(IX-1,IY)+1 + + VG(IX-1,IY+1)=VG(IX-1,IY+1)+VEL + NG(IX-1,IY+1)=NG(IX-1,IY+1)+1 + + VG(IX-1,IY-1)=VG(IX-1,IY-1)+VEL + NG(IX-1,IY-1)=NG(IX-1,IY-1)+1 + + IF (VEL.GT.MAX) THEN + WRITE(710,12) (X1+SX1)/2.0,(Y1+SY1)/2.0,(Z1+SZ1)/2.0 + ENDIF + +! ENDIF + ENDDO + + DO I=0,400 + DO J=0,100 + IF (NG(I,J).GE.1) THEN +! write(812,*) NG(I,J) + IF (VG(I,J)/(1.0*NG(I,J)).LT.MAX) THEN + WRITE(700,12) I*30.0,J*30.0,VG(I,J)/(1.0*NG(I,J)) + ELSE + WRITE(700,12) I*30.0,J*30.0,MAX + ENDIF + ELSE + WRITE(700,12) I*30.0,J*30.0,0.5*MAX + ENDIF + ENDDO + WRITE(700,12) + ENDDO + + + STOP + END + + + + + + + + + + + + + + + + + + + diff --git a/rh2.f b/rh2.f new file mode 100644 index 0000000..3f4f460 --- /dev/null +++ b/rh2.f @@ -0,0 +1,102 @@ + PROGRAM STAND + + REAL X1,Y1,Z1,X2,Y2,Z2,MINX,MINY,MINZ,MAX,TVC + REAL MAXX,MAXY,MAXZ,PI,F,MFIL(5,1000000),AVV,AVC + REAL SZ1,SZ2,SF,X,Y,SX1,SY1,VG(0:1000,0:1000) + INTEGER N,T,I,L,IT,J,SCC,SC,NG(0:1000,0:1000),TVN + CHARACTER*20 INFI1,INFI2 + + 2 FORMAT (A) + 12 FORMAT(3F18.7) + + WRITE(*,*) 'INFI1' + READ(*,2) INFI1 + WRITE(*,*) 'INFI2' + READ(*,2) INFI2 + WRITE(*,*) 'N' + READ(*,*) N + WRITE(*,*) 'MAX' + READ(*,*) MAX +! MAX=MAX*1.0e-04 + + OPEN(UNIT=700,FILE='vel.dat',STATUS='UNKNOWN') + OPEN(UNIT=800,FILE=INFI1,STATUS='UNKNOWN') + OPEN(UNIT=900,FILE=INFI2,STATUS='UNKNOWN') + + + DO J=0,1000 + DO I=0,1000 + VG(I,J)=0.0 + NG(I,J)=0 + ENDDO + ENDDO + + AVV=0.0 + AVC=0.0 + DO T=1,N + READ(800,*) X1,Y1,Z1 + READ(900,*) SX1,SY1,SZ1 + VEL=SQRT((Y1-SY1)**2+(Z1-SZ1)**2) +! WRITE(700,12) X1,Y1,VEL +! IX=INT((X1+SX1)/200.0) +! IY=INT((Y1+SY1)/200.0) + IX=INT((Y1+SY1)/100.0) + IY=INT((Z1+SZ1)/100.0) +! IF ((Z1+SZ1)/2.0.GT.1762.0) THEN + VG(IX,IY)=VG(IX,IY)+VEL + NG(IX,IY)=NG(IX,IY)+1 + AVV=AVV+VEL + AVC=AVC+1.0 +! ENDIF + ENDDO + + WRITE(*,*) 'VEL=',AVV/AVC*3600.0*2.4 + WRITE(*,*) 'DIST=',AVV/AVC + TVC=0.0 + TVN=0 + DO I=0,200 + DO J=0,100 + IF (NG(I,J).NE.0) THEN + IF (VG(I,J)/(1.0*NG(I,J)).LT.MAX) THEN +! WRITE(700,12) I*100.0,J*100.0,1.0e+04*VG(I,J)/(1.0*NG(I,J)) + WRITE(700,12) I*50.0,J*50.0,VG(I,J)/(1.0*NG(I,J)) +! TVC=TVC+1.0e+04*VG(I,J)/(1.0*NG(I,J)) + TVC=TVC+VG(I,J)/(1.0*NG(I,J)) + TVN=TVN+1 + ELSE +! WRITE(700,12) I*100.0,J*100.0,1.0e+04*MAX + WRITE(700,12) I*50.0,J*50.0,MAX +! TVC=TVC+1.0e+04*MAX + TVC=TVC+MAX + TVN=TVN+1 + ENDIF + ELSE + WRITE(700,12) I*50.0,J*50.0,0.5*MAX + ENDIF + ENDDO + WRITE(700,12) + ENDDO + + + WRITE(*,*) TVC/(1.0*TVN) + STOP + END + + + + + + + + + + + + + + + + + + + diff --git a/rhh.f b/rhh.f new file mode 100644 index 0000000..5a7906d --- /dev/null +++ b/rhh.f @@ -0,0 +1,97 @@ + PROGRAM STAND + + REAL X1,Y1,Z1,X2,Y2,Z2,F,MINX,MINY,MINZ,MAX + REAL STR1,SSTR1 + REAL MAXX,MAXY,MAXZ,PI,ZG(0:1000,0:1000) + REAL SZ1,SZ2,SF,X,Y,SX1,SY1,VG(0:1000,0:1000) + INTEGER N,T,I,L,IT,J,SCC,SC,NG(0:1000,0:1000) + CHARACTER*20 INFI1,INFI2 + + 2 FORMAT (A) + 12 FORMAT(3F18.7) + 13 FORMAT(4F18.7) + + WRITE(*,*) 'INFI1' + READ(*,2) INFI1 + WRITE(*,*) 'INFI2' + READ(*,2) INFI2 + WRITE(*,*) 'N' + READ(*,*) N + N=N/2 + WRITE(*,*) 'MAX' + READ(*,*) MAX + + OPEN(UNIT=700,FILE='str.dat',STATUS='UNKNOWN') + OPEN(UNIT=710,FILE='str2.dat',STATUS='UNKNOWN') + OPEN(UNIT=812,FILE='NG.dat',STATUS='UNKNOWN') + OPEN(UNIT=800,FILE=INFI1,STATUS='UNKNOWN') + OPEN(UNIT=900,FILE=INFI2,STATUS='UNKNOWN') + + + DO J=0,1000 + DO I=0,1000 + VG(I,J)=0.0 + ZG(I,J)=0.0 + NG(I,J)=0 + ENDDO + ENDDO + + DO T=1,N + READ(800,*) X1,Y1,Z1 + READ(800,*) STR1 + READ(900,*) SX1,SY1,SZ1 + READ(900,*) SSTR1 + VEL=ABS(STR1-SSTR1) +! WRITE(700,12) X1,Y1,VEL + IX=INT((X1+SX1)/80.0) + IY=INT((Y1+SY1)/80.0) +! IF ((Z1+SZ1)/2.0.GT.1262.0) THEN + IF ((Z1+SZ1)/2.0.GT.ZG(IX,IY)) ZG(IX,IY)=(Z1+SZ1)/2.0 + VG(IX,IY)=VG(IX,IY)+VEL + NG(IX,IY)=NG(IX,IY)+1 + + IF (VEL.GT.MAX/2.0) THEN + WRITE(710,12) (X1+SX1)/2.0,(Y1+SY1)/2.0,VEL + ENDIF + +! ENDIF + ENDDO + + DO I=0,600 + DO J=0,600 + IF (NG(I,J).GE.3) THEN +! write(812,*) NG(I,J) + IF (VG(I,J)/(1.0*NG(I,J)).LT.MAX) THEN + WRITE(700,13) I*40.0,J*40.0,ZG(I,J),VG(I,J)/(1.0*NG(I,J)) + ELSE + WRITE(700,13) I*40.0,J*40.0,ZG(I,J),MAX + ENDIF + ELSE + WRITE(700,13) I*40.0,J*40.0,0.0,MAX + ENDIF + ENDDO +! WRITE(700,12) + ENDDO + + + STOP + END + + + + + + + + + + + + + + + + + + + diff --git a/rt.f90 b/rt.f90 new file mode 100644 index 0000000..f7e2bdd --- /dev/null +++ b/rt.f90 @@ -0,0 +1,44 @@ + PROGRAM STAND + + REAL*8 AFIL(40,2000),NFIL(40,2000),DX,DY,DZ,LJ,DR,DT + REAL*8 FDY(2,10000) + REAL*8 X,Y,B1,B2,S2,OB1 + INTEGER NC,T,I,L,IT,J + CHARACTER*8 junk + + 2 FORMAT (A) + 12 FORMAT(3F18.7) + + OPEN(UNIT=220,FILE='mass3.dat',STATUS='UNKNOWN') + OPEN(UNIT=250,FILE='grad.dat',STATUS='UNKNOWN') + + READ(220,*) NC + OB1=0.0 + DO I=1,NC + READ(220,*) X,Y,S1,B1,B2 + IF (ABS(B1-S1).GT.1.0) WRITE(250,12) X,Y,B1-OB1 + OB1=B1 + ENDDO + + + STOP + END + + + + + + + + + + + + + + + + + + + diff --git a/tmat.f b/tmat.f new file mode 100644 index 0000000..37a0bbb --- /dev/null +++ b/tmat.f @@ -0,0 +1,67 @@ + SUBROUTINE TMAT(X1,Y1,Z1,X2,Y2,Z2,RY,T) + + REAL*8 T(12,12),DX,DY,DZ,DX2,DY2,DZ2 + REAL*8 X1,Y1,Z1,X2,Y2,Z2,L,LP + INTEGER RY +c COMMON /BT/ T + + + DX=(X2-X1) + DY=(Y2-Y1) + DZ=(Z2-Z1) + DX2=(X2-X1)**2 + DY2=(Y2-Y1)**2 + DZ2=(Z2-Z1)**2 + L=SQRT(DX2+DY2+DZ2) + LP=SQRT(DX2+DY2) + +c IF (RY.EQ.1) THEN +c DO 20 J=1,12 +c DO 10 I=1,12 +c T(I,J)=0.0 +c 10 CONTINUE +c 20 CONTINUE +c ENDIF + + T(1,1)=DX/L + T(1,2)=DY/L + T(1,3)=DZ/L + T(2,1)=-DY/LP + T(2,2)=DX/LP + T(2,3)=0.0 + T(3,1)=-(DZ*DX)/(L*LP) + T(3,2)=-(DZ*DY)/(L*LP) + T(3,3)=(DX2+DY2)/(L*LP) + + T(4,4)=DX/L + T(4,5)=DY/L + T(4,6)=DZ/L + T(5,4)=-DY/LP + T(5,5)=DX/LP + T(5,6)=0.0 + T(6,4)=-(DZ*DX)/(L*LP) + T(6,5)=-(DZ*DY)/(L*LP) + T(6,6)=(DX2+DY2)/(L*LP) + + T(7,7)=DX/L + T(7,8)=DY/L + T(7,9)=DZ/L + T(8,7)=-DY/LP + T(8,8)=DX/LP + T(8,9)=0.0 + T(9,7)=-(DZ*DX)/(L*LP) + T(9,8)=-(DZ*DY)/(L*LP) + T(9,9)=(DX2+DY2)/(L*LP) + + T(10,10)=DX/L + T(10,11)=DY/L + T(10,12)=DZ/L + T(11,10)=-DY/LP + T(11,11)=DX/LP + T(11,12)=0.0 + T(12,10)=-(DZ*DX)/(L*LP) + T(12,11)=-(DZ*DY)/(L*LP) + T(12,12)=(DX2+DY2)/(L*LP) + + RETURN + END diff --git a/tred.f b/tred.f new file mode 100644 index 0000000..a2b5b8a --- /dev/null +++ b/tred.f @@ -0,0 +1,97 @@ + PROGRAM STAND + + REAL AFIL(40,2000),NFIL(40,2000),DX,DY,DZ,LJ,DR,DT + REAL FDY(2,10000) + INTEGER N,T,I,L,IT,J + CHARACTER*20 INFI + + 2 FORMAT (A) + 12 FORMAT(4F13.7) + + OPEN(UNIT=220,FILE='bed.dat',STATUS='OLD') + OPEN(UNIT=210,FILE='surface.dat',STATUS='OLD') + OPEN(UNIT=600,FILE='mass2.dat',STATUS='UNKNOWN') + +! DO T=1,1115 +! READ(210,*) DY,DZ +! FDY(1,T)=0.0 +! FDY(2,T)=DY +! ENDDO + + DO T=1,1093 + READ(220,*) DY,DZ + FDY(1,T)=DZ+262.0 + ENDDO + + +! CLOSE(210) +! OPEN(UNIT=210,FILE='surface.dat',STATUS='OLD') + + + DO T=1,1093 + READ(210,*) DY,DZ + IF (DY.GE.9800.0) THEN + DO J=-20,150 + WRITE(600,12) J*10.0,DY-10000.0,DZ+262,FDY(1,T) + ENDDO + END IF + END DO + + DO T=1094,1114 + READ(210,*) DY,DZ + IF (DY.GE.10000.0) THEN + DO J=-20,150 + WRITE(600,12) J*10.0,DY-10000.0,DZ+262,FDY(1,1093-(T-1093)) + ENDDO + END IF + END DO + + DO T=1,50 + DO J=-20,150 + WRITE(600,12) J*10.0,11130.0-10000.0+10.0*T, + 1 FDY(1,1093-(T+(1114-1093))), + 1 FDY(1,1093-(T+(1114-1093))) + ENDDO + END DO + + + CLOSE (210) + CLOSE (220) + CLOSE (600) + + +! OPEN(UNIT=600,FILE='velocity.dat',STATUS='UNKNOWN') +! OPEN(UNIT=700,FILE='vel.dat',STATUS='UNKNOWN') + +! DO T=1,71360 +! READ(600,*) DY,DZ,VX,VY +! IF (DY.GE.10350.0.AND.VX.GT.50.0) THEN +! IF (VX.GT.300) THEN +! WRITE(700,*) DY-10350,DZ+120,VX +! ELSE +! WRITE(700,*) DY-10350,DZ+120,300.0 +! END IF +! END IF +! END DO + + STOP + END + + + + + + + + + + + + + + + + + + + diff --git a/ttmat.f b/ttmat.f new file mode 100644 index 0000000..82d665b --- /dev/null +++ b/ttmat.f @@ -0,0 +1,66 @@ + SUBROUTINE TTMAT(X1,Y1,Z1,X2,Y2,Z2,RY,TT) + + REAL*8 TT(12,12),DX,DY,DZ,DX2,DY2,DZ2 + REAL*8 X1,Y1,Z1,X2,Y2,Z2,L,LP + INTEGER RY +c COMMON /BTT/ TT + + DX=(X2-X1) + DY=(Y2-Y1) + DZ=(Z2-Z1) + DX2=(X2-X1)**2 + DY2=(Y2-Y1)**2 + DZ2=(Z2-Z1)**2 + L=SQRT(DX2+DY2+DZ2) + LP=SQRT(DX2+DY2) + +c IF (RY.EQ.1) THEN +c DO 20 J=1,12 +c DO 10 I=1,12 +c TT(I,J)=0.0 +c 10 CONTINUE +c 20 CONTINUE +c ENDIF + + TT(1,1)=DX/L + TT(2,1)=DY/L + TT(3,1)=DZ/L + TT(1,2)=-DY/LP + TT(2,2)=DX/LP + TT(3,2)=0.0 + TT(1,3)=-(DZ*DX)/(L*LP) + TT(2,3)=-(DZ*DY)/(L*LP) + TT(3,3)=(DX2+DY2)/(L*LP) + + TT(4,4)=DX/L + TT(5,4)=DY/L + TT(6,4)=DZ/L + TT(4,5)=-DY/LP + TT(5,5)=DX/LP + TT(6,5)=0.0 + TT(4,6)=-(DZ*DX)/(L*LP) + TT(5,6)=-(DZ*DY)/(L*LP) + TT(6,6)=(DX2+DY2)/(L*LP) + + TT(7,7)=DX/L + TT(8,7)=DY/L + TT(9,7)=DZ/L + TT(7,8)=-DY/LP + TT(8,8)=DX/LP + TT(9,8)=0.0 + TT(7,9)=-(DZ*DX)/(L*LP) + TT(8,9)=-(DZ*DY)/(L*LP) + TT(9,9)=(DX2+DY2)/(L*LP) + + TT(10,10)=DX/L + TT(11,10)=DY/L + TT(12,10)=DZ/L + TT(10,11)=-DY/LP + TT(11,11)=DX/LP + TT(12,11)=0.0 + TT(10,12)=-(DZ*DX)/(L*LP) + TT(11,12)=-(DZ*DY)/(L*LP) + TT(12,12)=(DX2+DY2)/(L*LP) + + RETURN + END diff --git a/wave2.f90 b/wave2.f90 new file mode 100644 index 0000000..272acad --- /dev/null +++ b/wave2.f90 @@ -0,0 +1,1546 @@ + PROGRAM WAVE + + IMPLICIT NONE + INCLUDE 'mpif.h' + INCLUDE 'param.dat' + INCLUDE 'na90.dat' + REAL*8 EMM(NOMA),BOYZ(NOMA),BOYY(NOMA),WSY(NOMA) + REAL*8 EN(NODM),WE(NOMA),VDP(NOMA),WSX(NOMA),BED(-100:2000,-100:2000) + REAL*8 SUF(-100:2000,-100:2000),VELO(NOMA) + REAL*8 MFIL(NOMA),NRXF(3,NOMA),EF(NOCON),EFC(NOMA),EFL(NOCON) + REAL*8 NRXFL(3,NOMA),NRXFR(3,NOMA),EFR(NOCON) + REAL*8 NRXFB(3,NOMA),NRXFF(3,NOMA),EFF(NOCON),EFB(NOCON) + REAL*8 NRXFBL(3,NOMA),UTBL(NODM),EFFR(NOCON),EFBR(NOCON) + REAL*8 NRXFBR(3,NOMA),UTBR(NODM),EFFL(NOCON),EFBL(NOCON) + REAL*8 NRXFFL(3,NOMA),UTFL(NODM),FBED(-100:2000,-100:2000) + REAL*8 NRXFFR(3,NOMA),UTFR(NODM),DIX,DIY,DIZ,FRIC,UC + REAL*8 UTM(NODM),UT(NODM),UTP(NODM),UTPP(NODM),R(NODM),D(NODM) + REAL*8 UTR(NODM),UTL(NODM),UTW(NODM),NRXFW(3,NOMA) + REAL*8 UTB(NODM),UTF(NODM),ENM0,ENMS0,POR,GRID + REAL*8 CT(NODC),FRX(NOMA),FRY(NOMA),FRZ(NOMA) + INTEGER CCN(NOMA),CCNW(NOMA),CB(NOMA),CCB(NOMA,3) + INTEGER NAN(3,NOCON),NDL(2,NODC),NDLL(2,NODC),NDLR(2,NODC) + INTEGER NDLF(2,NODC),NDLB(2,NODC),NANW(3,NOCON) + INTEGER FXF(2,NODC),NANL(3,NOMA),NANR(3,NOMA) + INTEGER NANF(3,NOMA),NANB(3,NOMA),REST,RY0 + INTEGER NANFL(3,NOMA),NANBL(3,NOMA),PTB(0:5000),PTR(0:5000) + INTEGER NANFR(3,NOMA),NANBR(3,NOMA),NM2 + INTEGER FXFL(2,NODC),FXFR(2,NODC),FXL,FXR,FXCF,FXCB + INTEGER FXFF(2,NODC),FXFB(2,NODC),FXCFL,FXCBL,FXCFR,FXCBR + INTEGER FXFFL(2,NODC),FXFBL(2,NODC) + INTEGER FXFFR(2,NODC),FXFBR(2,NODC) + REAL*8 M,MN,JS,DT,T,X,Y,CL,CN,E,GSUM,GSUM0 + REAL*8 DMPEN,PSUM,KIN,KIN2,PRESS,MELT,MAXDT + INTEGER I,N,NL,NTOT,NN,STEPS,IX,IM,MS,N1,N2,RY + INTEGER PN,NTOL,NTOR,NTOF,NTOB,NRY,PNN(0:5000),NTOTW(0:5000) + INTEGER NTOFR,NTOBR,NTOFL,NTOBL,XK,YK,ZK + REAL*8 L,ALF,MLOAD,DMP,VEL,G,S1,S2,M1,B1,B2 + REAL*8 S,LOAD,DMP2,BCE,STR,I1,I2,ZB,ZS + REAL*8 T2,T1,TS1,TT1,TT2,ENM,WEN,ERSUM + INTEGER NNO,NS,SI,NNT,BCCS + INTEGER YNOD,LS,KK,STEPS0,YN + INTEGER DST,ZNOD,J,XY,ND,O + INTEGER P,BCC,FXC,NCL,NDR,NDF,NDB + INTEGER NDFL,NDBL,NDFR,NDBR + INTEGER NDLFL(2,NODC),NDLBL(2,NODC) + INTEGER NDLFR(2,NODC),NDLBR(2,NODC) + REAL*8 KINS,KINS2,ENMS,MGHS,DMPENS,PSUMS + REAL*8 WENS,GSUMS,DPES,BCES + REAL*8 XE,DEX,DEY,RDE,MML,XI,ZI,YI + REAL*8 Z,AVE,ROUGH,FG,SCA,MGH,MGH0,DPE + REAL*8 KX(12,12),KY(12,12),KZ(12,12),K(12,12) + REAL*8 DDX,DDY,DDZ,DX,DY,DZ,DL,DTX,DTY,DTZ + REAL*8 X1,Y1,Z1,X2,Y2,Z2,DXL,DYL,DZL,DDL,RLS + REAL*8 MAXX,MAXY,MAXZ,MINY,MINX,MINZ + REAL*8 V1,V2,V3,MAXV,EF0,GL,WL,SLIN,PI,SUB + REAL*8 SSB,CSB,SQB,LNN,SCL + REAL RAN(NOCON) + INTEGER dest,source,tag,stat(MPI_STATUS_SIZE) + INTEGER rc,myid,ntasks,ierr,SEED,SEEDI + + + CALL MPI_INIT(rc) + IF (rc /= MPI_SUCCESS) THEN + WRITE(*,*) 'MPI initialisation failed' + STOP + END IF + CALL MPI_COMM_RANK(MPI_COMM_WORLD, myid, rc) + CALL MPI_COMM_SIZE(MPI_COMM_WORLD, ntasks, rc) + + + 6 FORMAT(F11.6,' ',I8,' ',2F11.6) + 7 FORMAT(7F13.7) + 8 FORMAT (A) + 9 FORMAT(I4,' ',2F11.6) + 10 FORMAT(5F28.1) + 11 FORMAT(2I8,' ',7F22.9) + 12 FORMAT(4F16.6) + 13 FORMAT(6F22.12) + 14 FORMAT(7I8) + 15 FORMAT(5F20.7) + 16 FORMAT(F11.6,' ',I4) + 17 FORMAT(10I9) + 18 FORMAT(6F16.6) + 19 FORMAT(3F24.4,' ',I8) + + IF (myid.EQ.0) THEN + OPEN(UNIT=610,FILE='dtop00',STATUS='UNKNOWN',POSITION='APPEND') + OPEN(UNIT=611,FILE='dtop01',STATUS='UNKNOWN',POSITION='APPEND') + OPEN(UNIT=612,FILE='dtopr',STATUS='UNKNOWN',POSITION='APPEND') + OPEN(UNIT=613,FILE='kins2',STATUS='UNKNOWN',POSITION='APPEND') +! OPEN(UNIT=614,FILE='lbound',STATUS='UNKNOWN') +! OPEN(UNIT=615,FILE='rbound',STATUS='UNKNOWN') + OPEN(UNIT=616,FILE='DTmax',STATUS='UNKNOWN') +! OPEN(UNIT=110,FILE='fib00',STATUS='UNKNOWN') +! OPEN(UNIT=800+myid,FILE='tbed'//na(myid),STATUS='UNKNOWN') +! OPEN(UNIT=1700+myid,FILE='bccs'//na(myid),STATUS='UNKNOWN') + ENDIF + + OPEN(UNIT=111,FILE='inp.dat',STATUS='OLD') + +! READ(111,*) MN +! READ(111,*) JS + READ(111,*) PRESS + READ(111,*) MELT + READ(111,*) UC + READ(111,*) DT + READ(111,*) S + READ(111,*) EF0 + READ(111,*) LS + READ(111,*) SUB + READ(111,*) WL + READ(111,*) GL + READ(111,*) SLIN + READ(111,*) STEPS0 + READ(111,*) MLOAD + READ(111,*) FRIC + READ(111,*) REST + READ(111,*) SCL + READ(111,*) YN + READ(111,*) GRID + READ(111,*) POR + READ(111,*) SEEDI + + S=S*SCL + MN=SCL**3.0*910 + JS=SCL**2.0*MN/6.0 + LNN=SCL*1.1225 + MLOAD=SCL*MLOAD + + SEED=SEEDI+873*myid + CALL RMARIN(SEED,0,0) + CALL RANMAR(RAN,NOCON) + + PI=ACOS(-1.0) + DMP=2.0E+04*SCL**2.0 + DMP2=1.0E+04*SCL**2.0 + MAXDT=0.0 + FXC=0 + FXR=0 + FXL=0 + FXCF=0 + FXCB=0 + FXCFL=0 + FXCFR=0 + FXCBL=0 + FXCBR=0 + + DO I=1,NOMA + FXF(1,I)=0 + CCN(I)=0 + EFC(I)=SCL*EF0 + END DO + + DO I=1,NODM + EN(I)=0.0 + END DO + + IF (REST.EQ.0) THEN + BCC=0 + BCE=0.0 + DPE=0.0 + DMPEN=0.0 + PSUM=0.0 + END IF + + DO J=1,NOMA + NRXFL(1,J)=-1000.0 + NRXFL(2,J)=-1000.0 + NRXFL(3,J)=-1000.0 + NRXFR(1,J)=-1000.0 + NRXFR(2,J)=-1000.0 + NRXFR(3,J)=-1000.0 + NRXFF(1,J)=-1000.0 + NRXFF(2,J)=-1000.0 + NRXFF(3,J)=-1000.0 + NRXFB(1,J)=-1000.0 + NRXFB(2,J)=-1000.0 + NRXFB(3,J)=-1000.0 + NRXFBL(1,J)=-1000.0 + NRXFBL(2,J)=-1000.0 + NRXFBL(3,J)=-1000.0 + NRXFBR(1,J)=-1000.0 + NRXFBR(2,J)=-1000.0 + NRXFBR(3,J)=-1000.0 + NRXFFL(1,J)=-1000.0 + NRXFFL(2,J)=-1000.0 + NRXFFL(3,J)=-1000.0 + NRXFFR(1,J)=-1000.0 + NRXFFR(2,J)=-1000.0 + NRXFFR(3,J)=-1000.0 + END DO + + SSB=SIN(SUB*PI/2.0) + CSB=COS(SUB*PI/2.0) + SQB=SQRT(1.0+SIN(SUB*PI/2.0)**2) + RLS=LS + + IF (REST.EQ.0) THEN + + RY0=1 + + + CALL FIBG3(LS,NN,NTOT,NTOL,NTOR,NTOF,NTOB,NTOFR,NTOBR,NTOFL,NTOBL,& + myid,MAXX,MAXY,MAXZ,MINX,MINY,MINZ,ntasks,SCL,YN,GRID,MELT,WL,UC) + + write(*,17) myid,NTOL,NTOT,NTOR,NTOF,NTOB,NTOFL,NTOFR,NTOBL,NTOBR + CALL MPI_BARRIER(MPI_COMM_WORLD,ierr) + + CALL MPI_ALLGATHER(NN,1,MPI_INTEGER,& + PNN,1,MPI_INTEGER,MPI_COMM_WORLD,ierr) + + CALL MPI_ALLGATHER(NTOR,1,MPI_INTEGER,& + PTR,1,MPI_INTEGER,MPI_COMM_WORLD,ierr) + + CALL MPI_ALLGATHER(NTOB,1,MPI_INTEGER,& + PTB,1,MPI_INTEGER,MPI_COMM_WORLD,ierr) + + CALL MPI_ALLGATHER(NTOT,1,MPI_INTEGER,& + NTOTW,1,MPI_INTEGER,MPI_COMM_WORLD,ierr) + + + + DO I=1,NTOT+NTOL+NTOR+NTOF+NTOB+NTOFL+NTOFR+NTOBL+NTOBR + CT(12*I-11)=0.0 + CT(12*I-10)=0.0 + CT(12*I-9)=0.0 + CT(12*I-8)=0.0 + CT(12*I-7)=0.0 + CT(12*I-6)=0.0 + CT(12*I-5)=0.0 + CT(12*I-4)=0.0 + CT(12*I-3)=0.0 + CT(12*I-2)=0.0 + CT(12*I-1)=0.0 + CT(12*I-0)=0.0 + END DO + + T=0 + ENM=0.0 + WEN=0.0 + ENM0=0 + + DO J=1,NN + VDP(J)=0.0 + UT(6*J-5)=0.0 + UT(6*J-4)=0.0 + UT(6*J-3)=0.0 + UT(6*J-2)=0.0 + UT(6*J-1)=0.0 + UT(6*J-0)=0.0 + UTM(6*J-5)=0.0 + UTM(6*J-4)=0.0 + UTM(6*J-3)=0.0 + UTM(6*J-2)=0.0 + UTM(6*J-1)=0.0 + UTM(6*J-0)=0.0 + END DO + + ELSE + + OPEN(UNIT=117+myid,FILE='REST0'//na(myid),STATUS='OLD') + READ(117+myid,*) NN,NTOT,NTOL,NTOR,NTOF,NTOB,BCC + READ(117+myid,*) NTOFL,NTOFR,NTOBL,NTOBR + READ(117+myid,*) MAXX,MAXY,MAXZ,DMPEN,ENM0 + READ(117+myid,*) DPE,BCE,MGH0,GSUM0,PSUM,T,RY0 + CLOSE(117+myid) + + CALL MPI_ALLGATHER(NN,1,MPI_INTEGER,& + PNN,1,MPI_INTEGER,MPI_COMM_WORLD,ierr) + + CALL MPI_ALLGATHER(NTOR,1,MPI_INTEGER,& + PTR,1,MPI_INTEGER,MPI_COMM_WORLD,ierr) + + CALL MPI_ALLGATHER(NTOB,1,MPI_INTEGER,& + PTB,1,MPI_INTEGER,MPI_COMM_WORLD,ierr) + + CALL MPI_ALLGATHER(NTOT,1,MPI_INTEGER,& + NTOTW,1,MPI_INTEGER,MPI_COMM_WORLD,ierr) + + OPEN(UNIT=117+myid,FILE='REST1'//na(myid),STATUS='OLD') + DO I=1,NTOT+NTOL+NTOR+NTOF+NTOB+NTOFL+NTOFR+NTOBL+NTOBR + READ(117+myid,*) CT(12*I-11),CT(12*I-10),CT(12*I-9),& + CT(12*I-8),CT(12*I-7),CT(12*I-6) + READ(117+myid,*) CT(12*I-5),CT(12*I-4),CT(12*I-3),& + CT(12*I-2),CT(12*I-1),CT(12*I-0) + END DO + CLOSE (117+myid) + + OPEN(UNIT=117+myid,FILE='REST2'//na(myid),STATUS='OLD') + DO I=1,NN + READ(117+myid,*) UT(6*I-5),UT(6*I-4),UT(6*I-3),& + UT(6*I-2),UT(6*I-1),UT(6*I-0) + READ(117+myid,*) UTM(6*I-5),UTM(6*I-4),UTM(6*I-3),& + UTM(6*I-2),UTM(6*I-1),UTM(6*I-0) + END DO + CLOSE (117+myid) + + END IF + + DO I=-100,2000 + DO J=-100,2000 + BED(I,J)=-1000.0 + ENDDO + ENDDO + + OPEN(UNIT=400,file='mass3.dat',STATUS='UNKNOWN') + READ(400,*) NM2 + DO I=1,NM2 + READ(400,*) X,Y,S1,B2,B1,Z1 + Y=Y-7200.0 + XK=INT(X/GRID) + YK=INT(Y/GRID) + IF (XK.GE.-100.AND.YK.GE.-100) BED(XK,YK)=B1 + IF (XK.GE.-100.AND.YK.GE.-100) SUF(XK,YK)=S1 + IF (XK.GE.-100.AND.YK.GE.-100) FBED(XK,YK)=FRIC*SCL*SCL*Z1 + + IF (YK.EQ.0.AND.XK.GE.-100) THEN + DO J=0,20 + BED(XK,-J)=B1 + SUF(XK,-J)=S1 + FBED(XK,-J)=FRIC*SCL*SCL*Z1 + ENDDO + ENDIF + + IF (XK.EQ.0.AND.YK.GE.-100) THEN + DO J=0,20 + BED(-J,YK)=B1 + SUF(-J,YK)=S1 + FBED(-J,YK)=FRIC*SCL*SCL*Z1 + ENDDO + ENDIF + + ENDDO + CLOSE(400) + + OPEN(UNIT=117+myid,FILE='NODFIL2'//na(myid),STATUS='UNKNOWN') + DO I=1,NN + READ(117+myid,*) IX,X,Y,Z,M + NRXF(1,IX)=X + NRXF(2,IX)=Y + NRXF(3,IX)=Z + MFIL(IX)=MN + X=NRXF(1,IX)+UT(6*IX-5) + Y=NRXF(2,IX)+UT(6*IX-4) + Z=NRXF(3,IX)+UT(6*IX-3) + I1=X/GRID-INT(X/GRID) + I2=Y/GRID-INT(Y/GRID) + CALL BIPINT(I1,I2,BED(INT(X/GRID),INT(Y/GRID)),BED(INT(X/GRID)+1,INT(Y/GRID)),& + BED(INT(X/GRID),INT(Y/GRID)+1),BED(INT(X/GRID)+1,INT(Y/GRID)+1),ZB) + + IF (ABS(ZB-Z).LT.SCL*1.0) THEN + CALL BIPINT(I1,I2,FBED(INT(X/GRID),INT(Y/GRID)),FBED(INT(X/GRID)+1,INT(Y/GRID)),& + FBED(INT(X/GRID),INT(Y/GRID)+1),FBED(INT(X/GRID)+1,INT(Y/GRID)+1),VDP(IX)) +! IF (VDP(IX).GT.SCL*SCL*2.0e+07) VDP(IX)=SCL*SCL*2.0e+07 + ELSE +! IF (Z.LT.WL) THEN + VELO(IX)=SQRT(((UT(6*IX-5)-UTM(6*IX-5))/DT)**2.0+& + ((UT(6*IX-4)-UTM(6*IX-4))/DT)**2.0+((UT(6*IX-3)-UTM(6*I-3))/DT)**2.0) + VDP(IX)=SCL*SCL*1.0e+01*VELO(IX) +! VDP(IX)=SCL*SCL*1.0e+01 +! ELSE +! VDP(IX)=SCL*SCL*1.0e+00 +! ENDIF + ENDIF + + + END DO + CLOSE (117+myid) + + OPEN(UNIT=117+myid,FILE='FS'//na(myid),STATUS='UNKNOWN') + DO I=1,NTOT + READ(117+myid,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + NAN(1,I)=N1 + NAN(2,I)=N2 + I1=X1/GRID-INT(X1/GRID) + I2=Y1/GRID-INT(Y1/GRID) + CALL BIPINT(I1,I2,BED(INT(X/GRID),INT(Y/GRID)),BED(INT(X/GRID)+1,INT(Y/GRID)),& + BED(INT(X/GRID),INT(Y/GRID)+1),BED(INT(X/GRID)+1,INT(Y/GRID)+1),ZB) + CALL BIPINT(I1,I2,SUF(INT(X1/GRID),INT(Y1/GRID)),SUF(INT(X1/GRID)+1,INT(Y1/GRID)),& + SUF(INT(X1/GRID),INT(Y1/GRID)+1),SUF(INT(X1/GRID)+1,INT(Y1/GRID)+1),ZS) + IF (REST.EQ.0) THEN + IF (RAN(I).LT.1.0-POR.AND.(ABS(Z1-ZS).LT.SLIN.OR.ABS(Z1-ZB).LT.0.0)) THEN + EF(I)=EF0 + ELSE + EF(I)=0.1 + ENDIF + ELSE + EF(I)=E + ENDIF + END DO + CLOSE (117+myid) + + IF (MOD(myid,ntasks/YN).ne.0) THEN + OPEN(UNIT=117+myid,FILE='FSL'//na(myid),STATUS='UNKNOWN') + DO I=1,NTOL + READ(117+myid,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + NANL(1,I)=N1 + NANL(2,I)=N2 + NRXFL(1,N1)=X1 + NRXFL(2,N1)=Y1 + NRXFL(3,N1)=Z1 + END DO + CLOSE (117+myid) + ENDIF + + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + OPEN(UNIT=117+myid,FILE='FSR'//na(myid),STATUS='UNKNOWN') + DO I=1,NTOR + READ(117+myid,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + NANR(1,I)=N1 + NANR(2,I)=N2 + NRXFR(1,N1)=X1 + NRXFR(2,N1)=Y1 + NRXFR(3,N1)=Z1 + I1=X1/GRID-INT(X1/GRID) + I2=Y1/GRID-INT(Y1/GRID) + CALL BIPINT(I1,I2,BED(INT(X/GRID),INT(Y/GRID)),BED(INT(X/GRID)+1,INT(Y/GRID)),& + BED(INT(X/GRID),INT(Y/GRID)+1),BED(INT(X/GRID)+1,INT(Y/GRID)+1),ZB) + CALL BIPINT(I1,I2,SUF(INT(X1/GRID),INT(Y1/GRID)),SUF(INT(X1/GRID)+1,INT(Y1/GRID)),& + SUF(INT(X1/GRID),INT(Y1/GRID)+1),SUF(INT(X1/GRID)+1,INT(Y1/GRID)+1),ZS) + IF (REST.EQ.0) THEN + IF (RAN(I).LT.1.0-POR.AND.(ABS(Z1-ZS).LT.SLIN.OR.ABS(Z1-ZB).LT.0.0)) THEN + EFR(I)=EF0 + ELSE + EFR(I)=0.1 + ENDIF + ELSE + EFR(I)=E + ENDIF + END DO + CLOSE (117+myid) + ENDIF + + dest=myid+1 + source=myid-1 + tag=131 + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Send(EFR,NTOR,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Recv(EFL,NTOL,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + IF (myid.lt.(YN-1)*ntasks/YN) THEN + OPEN(UNIT=117+myid,FILE='FSF'//na(myid),STATUS='UNKNOWN') + DO I=1,NTOF + READ(117+myid,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + NANF(1,I)=N1 + NANF(2,I)=N2 + NRXFF(1,N1)=X1 + NRXFF(2,N1)=Y1 + NRXFF(3,N1)=Z1 + I1=X1/GRID-INT(X1/GRID) + I2=Y1/GRID-INT(Y1/GRID) + CALL BIPINT(I1,I2,BED(INT(X/GRID),INT(Y/GRID)),BED(INT(X/GRID)+1,INT(Y/GRID)),& + BED(INT(X/GRID),INT(Y/GRID)+1),BED(INT(X/GRID)+1,INT(Y/GRID)+1),ZB) + CALL BIPINT(I1,I2,SUF(INT(X1/GRID),INT(Y1/GRID)),SUF(INT(X1/GRID)+1,INT(Y1/GRID)),& + SUF(INT(X1/GRID),INT(Y1/GRID)+1),SUF(INT(X1/GRID)+1,INT(Y1/GRID)+1),ZS) + IF (REST.EQ.0) THEN + IF (RAN(I).LT.1.0-POR.AND.(ABS(Z1-ZS).LT.SLIN.OR.ABS(Z1-ZB).LT.0.0)) THEN + EFF(I)=EF0 + ELSE + EFF(I)=0.1 + ENDIF + ELSE + EFF(I)=E + ENDIF + END DO + CLOSE (117+myid) + ENDIF + + dest=myid+ntasks/YN + source=myid-ntasks/YN + tag=132 + IF (myid.lt.(YN-1)*ntasks/YN)& + CALL MPI_Send(EFF,NTOF,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN)& + CALL MPI_Recv(EFB,NTOB,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + OPEN(UNIT=117+myid,FILE='FSFL'//na(myid),STATUS='UNKNOWN') + DO I=1,NTOFL + READ(117+myid,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + NANFL(1,I)=N1 + NANFL(2,I)=N2 + NRXFFL(1,N1)=X1 + NRXFFL(2,N1)=Y1 + NRXFFL(3,N1)=Z1 + I1=X1/GRID-INT(X1/GRID) + I2=Y1/GRID-INT(Y1/GRID) + CALL BIPINT(I1,I2,BED(INT(X/GRID),INT(Y/GRID)),BED(INT(X/GRID)+1,INT(Y/GRID)),& + BED(INT(X/GRID),INT(Y/GRID)+1),BED(INT(X/GRID)+1,INT(Y/GRID)+1),ZB) + CALL BIPINT(I1,I2,SUF(INT(X1/GRID),INT(Y1/GRID)),SUF(INT(X1/GRID)+1,INT(Y1/GRID)),& + SUF(INT(X1/GRID),INT(Y1/GRID)+1),SUF(INT(X1/GRID)+1,INT(Y1/GRID)+1),ZS) + IF (REST.EQ.0) THEN + IF (RAN(I).LT.1.0-POR.AND.(ABS(Z1-ZS).LT.SLIN.OR.ABS(Z1-ZB).LT.0.0)) THEN + EFFL(I)=EF0 + ELSE + EFFL(I)=0.1 + ENDIF + ELSE + EFFL(I)=E + ENDIF + END DO + CLOSE (117+myid) + ENDIF + + dest=myid+ntasks/YN-1 + source=myid-ntasks/YN+1 + tag=133 + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Send(EFFL,NTOFL,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Recv(EFBR,NTOBR,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + + IF (myid.lt.(YN-1)*ntasks/YN& + .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + OPEN(UNIT=117+myid,FILE='FSFR'//na(myid),STATUS='UNKNOWN') + DO I=1,NTOFR + READ(117+myid,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + NANFR(1,I)=N1 + NANFR(2,I)=N2 + NRXFFR(1,N1)=X1 + NRXFFR(2,N1)=Y1 + NRXFFR(3,N1)=Z1 + I1=X1/GRID-INT(X1/GRID) + I2=Y1/GRID-INT(Y1/GRID) + CALL BIPINT(I1,I2,BED(INT(X/GRID),INT(Y/GRID)),BED(INT(X/GRID)+1,INT(Y/GRID)),& + BED(INT(X/GRID),INT(Y/GRID)+1),BED(INT(X/GRID)+1,INT(Y/GRID)+1),ZB) + CALL BIPINT(I1,I2,SUF(INT(X1/GRID),INT(Y1/GRID)),SUF(INT(X1/GRID)+1,INT(Y1/GRID)),& + SUF(INT(X1/GRID),INT(Y1/GRID)+1),SUF(INT(X1/GRID)+1,INT(Y1/GRID)+1),ZS) + IF (REST.EQ.0) THEN + IF (RAN(I).LT.1.0-POR.AND.(ABS(Z1-ZS).LT.SLIN.OR.ABS(Z1-ZB).LT.0.0)) THEN + EFFR(I)=EF0 + ELSE + EFFR(I)=0.1 + ENDIF + ELSE + EFFR(I)=E + ENDIF + END DO + CLOSE (117+myid) + ENDIF + + + dest=myid+ntasks/YN+1 + source=myid-ntasks/YN-1 + tag=134 + IF (myid.lt.(YN-1)*ntasks/YN& + .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Send(EFFR,NTOFR,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Recv(EFBL,NTOBL,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + IF (myid.ge.ntasks/YN) THEN + OPEN(UNIT=117+myid,FILE='FSB'//na(myid),STATUS='UNKNOWN') + DO I=1,NTOB + READ(117+myid,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + NANB(1,I)=N1 + NANB(2,I)=N2 + NRXFB(1,N1)=X1 + NRXFB(2,N1)=Y1 + NRXFB(3,N1)=Z1 + END DO + CLOSE (117+myid) + ENDIF + + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + OPEN(UNIT=117+myid,FILE='FSBL'//na(myid),STATUS='UNKNOWN') + DO I=1,NTOBL + READ(117+myid,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + NANBL(1,I)=N1 + NANBL(2,I)=N2 + NRXFBL(1,N1)=X1 + NRXFBL(2,N1)=Y1 + NRXFBL(3,N1)=Z1 + END DO + CLOSE (117+myid) + ENDIF + + IF (myid.ge.ntasks/YN& + .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + OPEN(UNIT=117+myid,FILE='FSBR'//na(myid),STATUS='UNKNOWN') + DO I=1,NTOBR + READ(117+myid,*) N1,N2,X1,Y1,Z1,X2,Y2,Z2,E + NANBR(1,I)=N1 + NANBR(2,I)=N2 + NRXFBR(1,N1)=X1 + NRXFBR(2,N1)=Y1 + NRXFBR(3,N1)=Z1 + END DO + CLOSE (117+myid) + ENDIF + + CALL CPU_TIME(T1) + TS1=0.0 + + + DO 100 RY=RY0,RY0+STEPS0 + + CALL CPU_TIME(TT1) + + dest=myid+1 + source=myid-1 + + + tag=142 + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Send(UT,6*NN,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Recv(UTL,6*PNN(source),MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-1 + source=myid+1 + + tag=144 + IF (MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Send(UT,6*NN,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Recv(UTR,6*PNN(source),MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN + source=myid-ntasks/YN + + tag=145 + IF (myid.lt.(YN-1)*ntasks/YN)& + CALL MPI_Send(UT,6*NN,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN)& + CALL MPI_Recv(UTB,6*PNN(source),MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN + source=myid+ntasks/YN + + tag=146 + IF (myid.ge.ntasks/YN)& + CALL MPI_Send(UT,6*NN,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN)& + CALL MPI_Recv(UTF,6*PNN(source),MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN-1 + source=myid+ntasks/YN+1 + + tag=147 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Send(UT,6*NN,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN& + .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Recv(UTFR,6*PNN(source),MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid-ntasks/YN+1 + source=myid+ntasks/YN-1 + + tag=148 + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Send(UT,6*NN,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Recv(UTFL,6*PNN(source),MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN-1 + source=myid-ntasks/YN+1 + + tag=149 + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Send(UT,6*NN,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Recv(UTBR,6*PNN(source),MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + dest=myid+ntasks/YN+1 + source=myid-ntasks/YN-1 + + tag=150 + IF (myid.lt.(YN-1)*ntasks/YN& + .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Send(UT,6*NN,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Recv(UTBL,6*PNN(source),MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + + + IF (MOD(RY,250).EQ.1.OR.RY.EQ.RY0) THEN + CALL DIST(NN,UT,ND,NCL,NDR,NRXF,NDL,& + NDLL,NDLR,NRXFL,NRXFR,UTL,UTR,NRXFF,& + NRXFB,UTB,UTF,NDLF,NDLB,NDF,NDB,myid,ntasks,SCL,PNN,YN,& + NRXFBL,NRXFBR,NRXFFL,NRXFFR,NDLFL,NDLFR,NDLBR,NDLBL,& + NDFL,NDFR,NDBR,NDBL,UTBL,UTBR,UTFL,UTFR) + END IF + +! write(*,17) RY,myid,ND,NCL,NDR,NDF,NDB,NDBL,NDBL,NDFR + + CALL CIRC(ND,NN,NRXF,UT,FRX,FRY,FRZ,& + T,RY,DT,WE,EFC,FXF,FXC,NDR,NCL,NDL,& + NDLL,NDLR,NRXFL,NRXFR,UTL,UTR,myid,ntasks,FXFL,FXFR,FXL,FXR,& + FXCF,FXFF,UTF,NRXFF,NDLF,NDF,& + FXCB,FXFB,UTB,NRXFB,NDLB,NDB,LNN,YN,& + NDFL,NDFR,NDBL,NDBR,& + FXCFR,FXCFL,FXCBR,FXCBL,& + NDLFL,NDLFR,NDLBL,NDLBR,& + UTFL,UTFR,UTBL,UTBR,& + NRXFBL,NRXFBR,NRXFFL,NRXFFR,& + FXFFR,FXFFL,FXFBR,FXFBL,SCL) + +! write(*,17) RY,myid,FXC,FXL,FXCB,FXCF,FXCFR,FXCFL,FXCBR,FXCBL + + CALL EFFLOAD1(S,NTOT,NN,T,DT,MN,JS,UT,UTM,R,EN,RY,& + FXF,FXC,VDP,DPE,EF,EFL,EFR,NAN,NRXF,MFIL,CT,NANL,NANR,NTOL,NTOR,& + NRXFL,NRXFR,UTL,UTR,myid,ntasks,FXL,FXFL,FXR,FXFR,LNN,& + NTOF,NTOB,NRXFF,NRXFB,UTF,UTB,EFF,EFB,& + FXCF,FXFF,FXCB,FXFB,NANB,NANF,PNN,YN,& + NANFL,NANFR,NANBL,NANBR,& + NRXFFL,NRXFFR,NRXFBL,NRXFBR,& + UTFL,UTFR,UTBL,UTBR,& + EFFL,EFFR,EFBL,EFBR,& + NTOFL,NTOFR,NTOBL,NTOBR,& + FXCFL,FXFFL,FXCBL,FXFBL,& + FXCFR,FXFFR,FXCBR,FXFBR) + + + CALL MPI_BARRIER(MPI_COMM_WORLD,ierr) + + CALL CPU_TIME(TT2) + TS1=TS1+(TT2-TT1) + + WEN=0.0 + KIN=0.0 + KIN2=0.0 + MGH=0.0 + GSUM=0.0 + ENM=0.0 + + DO 27 I=1,NN + X=NRXF(1,I)+UT(6*I-5) + Y=NRXF(2,I)+UT(6*I-4) + Z=NRXF(3,I)+UT(6*I-3) + + WSY(I)=0.0 + +! IF (Y.LT.1000.0.AND.(X.GT.8000.0.AND.X.LT.34000.0)) THEN +! IF (Z.GT.WL+Y*SSB) THEN +! WSY(I)=PRESS*1.0e+01*SCL**3*(MAXZ-NRXF(3,I)) +! PSUM=PSUM+WSY(I)*(UT(6*I-4)-UTM(6*I-4)) +! ELSE +! WSY(I)=PRESS*(1.0e+01*SCL**3*(MAXZ-NRXF(3,I))-1.1e+01*SCL**3*(WL+Y*SSB-NRXF(3,I))) +! PSUM=PSUM+WSY(I)*(UT(6*I-4)-UTM(6*I-4)) +! ENDIF +! ENDIF + + WSX(I)=0.0 + + I1=X/GRID-INT(X/GRID) + I2=Y/GRID-INT(Y/GRID) + + CALL BIPINT(I1,I2,BED(INT(X/GRID),INT(Y/GRID)),BED(INT(X/GRID)+1,INT(Y/GRID)),& + BED(INT(X/GRID),INT(Y/GRID)+1),BED(INT(X/GRID)+1,INT(Y/GRID)+1),ZB) + CALL BIPINT(I1,I2,SUF(INT(X/GRID),INT(Y/GRID)),SUF(INT(X/GRID)+1,INT(Y/GRID)),& + SUF(INT(X/GRID),INT(Y/GRID)+1),SUF(INT(X/GRID)+1,INT(Y/GRID)+1),ZS) + + IF (ABS(ZB-Z).LT.SCL*1.0) THEN + CALL BIPINT(I1,I2,FBED(INT(X/GRID),INT(Y/GRID)),FBED(INT(X/GRID)+1,INT(Y/GRID)),& + FBED(INT(X/GRID),INT(Y/GRID)+1),FBED(INT(X/GRID)+1,INT(Y/GRID)+1),VDP(I)) +! IF (VDP(I).GT.SCL*SCL*2.0e+07) VDP(I)=SCL*SCL*2.0e+07 + ELSE +! IF (Z.LT.WL) THEN + VELO(I)=SQRT(((UT(6*I-5)-UTM(6*I-5))/DT)**2.0+& + ((UT(6*I-4)-UTM(6*I-4))/DT)**2.0+((UT(6*I-3)-UTM(6*I-3))/DT)**2.0) + VDP(I)=SCL*SCL*1.0e+01*VELO(I) +! VDP(I)=SCL*SCL*1.0e+01 +! ELSE +! VDP(I)=SCL*SCL*1.0e+00 +! ENDIF + ENDIF + + CALL BIPINTN(I1,I2,BED(INT(X/GRID),INT(Y/GRID)),BED(INT(X/GRID)+1,INT(Y/GRID)),& + BED(INT(X/GRID),INT(Y/GRID)+1),BED(INT(X/GRID)+1,INT(Y/GRID)+1),DIX,DIY,DIZ,GRID) + +! IF (Z.LT.ZB+SCL/2.0) THEN +! FRX(I)=FRX(I)+DIX*1e+08*(ZB-Z) +! FRY(I)=FRY(I)+DIY*1e+08*(ZB-Z) +! FRZ(I)=FRZ(I)+DIZ*1e+08*(ZB-Z) + +! FRZ(I)=FRZ(I)+2e+07*(ZB+SCL/2.0-Z) +! GSUM=GSUM+1.0e+07*(ZB+SCL/2.0-Z)**2 + +! IF (RY.EQ.1) write(800+myid,18) X,Y,Z,DIX,DIY,DIZ +! ENDIF + +! IF (Y.GT.2.0*SCL.AND.Y.LT.4.0*SCL) THEN +! FRY(I)=FRY(I)+1e+03*(SCL-UT(6*I-4)) +! ENDIF + + IF (Z.LT.WL+Y*SSB) THEN + BOYZ(I)=1.29*MFIL(I)*CSB + ELSE + BOYZ(I)=-9.8*MFIL(I)*CSB + ENDIF + + IF (Z.LT.WL+Y*SSB) THEN + BOYY(I)=-1.29*MFIL(I)*SSB + ELSE + BOYY(I)=9.8*MFIL(I)*SSB + ENDIF + + + 27 CONTINUE + + CALL EFFLOAD2(S,NTOT,NN,T,DT,MN,JS,DMP,DMP2,UT,UTM,D,EN,RY,& + FXF,FXC,VDP,DPE,EF,EFL,EFR,NAN,NRXF,MFIL,CT,NANL,NANR,NTOL,NTOR,& + NRXFL,NRXFR,UTL,UTR,myid,ntasks,FXL,FXFL,FXR,FXFR,LNN,& + NTOF,NTOB,NRXFF,NRXFB,UTF,UTB,EFF,EFB,& + FXCF,FXFF,FXCB,FXFB,NANB,NANF,PNN,YN,& + NANFL,NANFR,NANBL,NANBR,& + NRXFFL,NRXFFR,NRXFBL,NRXFBR,& + UTFL,UTFR,UTBL,UTBR,& + EFFL,EFFR,EFBL,EFBR,& + NTOFL,NTOFR,NTOBL,NTOBR,& + FXCFL,FXFFL,FXCBL,FXFBL,& + FXCFR,FXFFR,FXCBR,FXFBR) + + DO 28 I=1,NN + UTPP(6*I-5)=(R(6*I-5)-2.0*D(6*I-5)+FRX(I)+WSX(I))/((MFIL(I)/DT**2)+VDP(I)/(2.*DT)) + UTPP(6*I-4)=(R(6*I-4)-2.0*D(6*I-4)+FRY(I)+BOYY(I)+WSY(I))/((MFIL(I)/DT**2)+VDP(I)/(2.*DT)) + UTPP(6*I-3)=(R(6*I-3)-2.0*D(6*I-3)+FRZ(I)+BOYZ(I))/((MFIL(I)/DT**2)+VDP(I)/(2.*DT)) + UTPP(6*I-2)=(R(6*I-2)-2.0*D(6*I-2))/((MFIL(I)*JS/MN)/DT**2+VDP(I)/(2.*DT)) + UTPP(6*I-1)=(R(6*I-1)-2.0*D(6*I-1))/((MFIL(I)*JS/MN)/DT**2+VDP(I)/(2.*DT)) + UTPP(6*I-0)=(R(6*I-0)-2.0*D(6*I-0))/((MFIL(I)*JS/MN)/DT**2+VDP(I)/(2.*DT)) + 28 CONTINUE + + + CALL EFFLOAD3(S,NTOT,NN,T,DT,MN,JS,DMP,DMP2,UTPP,UT,D,EN,RY,& + FXF,FXC,VDP,DPE,EF,EFL,EFR,NAN,NRXF,MFIL,CT,NANL,NANR,NTOL,NTOR,& + NRXFL,NRXFR,UTL,UTR,myid,ntasks,FXL,FXFL,FXR,FXFR,LNN,& + NTOF,NTOB,NRXFF,NRXFB,UTF,UTB,EFF,EFB,& + FXCF,FXFF,FXCB,FXFB,NANB,NANF,PNN,YN,& + NANFL,NANFR,NANBL,NANBR,& + NRXFFL,NRXFFR,NRXFBL,NRXFBR,& + UTFL,UTFR,UTBL,UTBR,& + EFFL,EFFR,EFBL,EFBR,& + NTOFL,NTOFR,NTOBL,NTOBR,& + FXCFL,FXFFL,FXCBL,FXFBL,& + FXCFR,FXFFR,FXCBR,FXFBR) + + DO 29 I=1,NN + X=NRXF(1,I)+UT(6*I-5) + Y=NRXF(2,I)+UT(6*I-4) + Z=NRXF(3,I)+UT(6*I-3) + + KIN=KIN+0.5*MN*((UT(6*I-5)-UTM(6*I-5))/DT)**2 + KIN=KIN+0.5*MN*((UT(6*I-4)-UTM(6*I-4))/DT)**2 + KIN=KIN+0.5*MN*((UT(6*I-3)-UTM(6*I-3))/DT)**2 + KIN2=KIN2+0.5*JS*((UT(6*I-2)-UTM(6*I-2))/DT)**2 + KIN2=KIN2+0.5*JS*((UT(6*I-1)-UTM(6*I-1))/DT)**2 + KIN2=KIN2+0.5*JS*((UT(6*I-0)-UTM(6*I-0))/DT)**2 + + UTP(6*I-5)=(R(6*I-5)-D(6*I-5)+FRX(I)+WSX(I))/((MFIL(I)/DT**2)+VDP(I)/(2.*DT)) + UTP(6*I-4)=(R(6*I-4)-D(6*I-4)+FRY(I)+BOYY(I)+WSY(I))/((MFIL(I)/DT**2)+VDP(I)/(2.*DT)) + UTP(6*I-3)=(R(6*I-3)-D(6*I-3)+FRZ(I)+BOYZ(I))/((MFIL(I)/DT**2)+VDP(I)/(2.*DT)) + UTP(6*I-2)=(R(6*I-2)-D(6*I-2))/((MFIL(I)*JS/MN)/DT**2+VDP(I)/(2.*DT)) + UTP(6*I-1)=(R(6*I-1)-D(6*I-1))/((MFIL(I)*JS/MN)/DT**2+VDP(I)/(2.*DT)) + UTP(6*I-0)=(R(6*I-0)-D(6*I-0))/((MFIL(I)*JS/MN)/DT**2+VDP(I)/(2.*DT)) + + IF (ABS(UTPP(6*I-5)-UTP(6*I-5)).GT.MAXDT) MAXDT=ABS(UTPP(6*I-5)-UTP(6*I-5)) + IF (ABS(UTPP(6*I-4)-UTP(6*I-4)).GT.MAXDT) MAXDT=ABS(UTPP(6*I-4)-UTP(6*I-4)) + IF (ABS(UTPP(6*I-3)-UTP(6*I-3)).GT.MAXDT) MAXDT=ABS(UTPP(6*I-3)-UTP(6*I-3)) + IF (ABS(UTPP(6*I-2)-UTP(6*I-2)).GT.MAXDT) MAXDT=ABS(UTPP(6*I-2)-UTP(6*I-2)) + IF (ABS(UTPP(6*I-1)-UTP(6*I-1)).GT.MAXDT) MAXDT=ABS(UTPP(6*I-1)-UTP(6*I-1)) + IF (ABS(UTPP(6*I-0)-UTP(6*I-0)).GT.MAXDT) MAXDT=ABS(UTPP(6*I-0)-UTP(6*I-0)) + +! IF (UTP(6*I-5).GE.3e+03) UTP(6*I-5)=3.0e+03 +! IF (UTP(6*I-4).GE.3e+03) UTP(6*I-4)=3.0e+03 +! IF (UTP(6*I-3).GE.3e+03) UTP(6*I-3)=3.0e+03 +! IF (UTP(6*I-2).GE.3e+03) UTP(6*I-2)=3.0e+03 +! IF (UTP(6*I-1).GE.3e+03) UTP(6*I-1)=3.0e+03 +! IF (UTP(6*I-0).GE.3e+03) UTP(6*I-0)=3.0e+03 + + I1=X/GRID-INT(X/GRID) + I2=Y/GRID-INT(Y/GRID) + + CALL BIPINT(I1,I2,BED(INT(X/GRID),INT(Y/GRID)),BED(INT(X/GRID)+1,INT(Y/GRID)),& + BED(INT(X/GRID),INT(Y/GRID)+1),BED(INT(X/GRID)+1,INT(Y/GRID)+1),ZB) + +! IF (ABS(ZB-Z).LT.SCL*2.0.AND.(VDP(I).GE.1.0e+10*SCL*SCL.OR.T.LT.20.0)) THEN +! UTP(6*I-5)=UT(6*I-5) +! UTP(6*I-4)=UT(6*I-4) +! UTP(6*I-3)=UT(6*I-3) +! UTP(6*I-2)=UT(6*I-2) +! UTP(6*I-1)=UT(6*I-1) +! UTP(6*I-0)=UT(6*I-0) +! ENDIF + +! IF (X.LT.250.0.OR.Y.LT.250.0) THEN + IF (Y.LT.2.0*SCL) THEN + UTP(6*I-5)=UT(6*I-5) + UTP(6*I-4)=UT(6*I-4) + ENDIF + + IF (MOD(myid+1,ntasks/YN).eq.0) THEN + IF (X.GT.MAXX-2.0*SCL) THEN + UTP(6*I-5)=UT(6*I-5) + ENDIF + ENDIF + +! IF (X.GT.MAXX-250.0) THEN + IF (X.LT.2.0*SCL) THEN + UTP(6*I-5)=UT(6*I-5) +! UTP(6*I-4)=UT(6*I-4) + ENDIF +! ENDIF + + + DMPEN=DMPEN+VDP(I)*(UTP(6*I-5)-UTM(6*I-5))**2/(4*DT) + DMPEN=DMPEN+VDP(I)*(UTP(6*I-4)-UTM(6*I-4))**2/(4*DT) + DMPEN=DMPEN+VDP(I)*(UTP(6*I-3)-UTM(6*I-3))**2/(4*DT) + DMPEN=DMPEN+VDP(I)*(UTP(6*I-2)-UTM(6*I-2))**2/(4*DT) + DMPEN=DMPEN+VDP(I)*(UTP(6*I-1)-UTM(6*I-1))**2/(4*DT) + DMPEN=DMPEN+VDP(I)*(UTP(6*I-0)-UTM(6*I-0))**2/(4*DT) + + + WEN=WEN+WE(I) + + ENM=ENM+EN(6*I-5)+EN(6*I-4)+EN(6*I-3)+EN(6*I-2)+EN(6*I-1)+EN(6*I-0) + + EMM(I)=EN(6*I-5)+EN(6*I-4)+EN(6*I-3)+EN(6*I-2)+EN(6*I-1)+EN(6*I-0) + + IF (Z.LT.WL+Y*SSB) THEN + MGH=MGH+1.06*MFIL(I)*ABS(Z-WL-Y*SSB)/SQB + ELSE + MGH=MGH+9.8*MFIL(I)*ABS(Z-WL-Y*SSB)/SQB + ENDIF + + 29 CONTINUE + + IF (RY.EQ.1) THEN + CALL MPI_ALLREDUCE(GSUM,GSUM0,1,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr) + CALL MPI_ALLREDUCE(MGH,MGH0,1,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr) + END IF + +! IF (RY.EQ.REST*STEPS0+1) THEN + + IF (RY.EQ.RY0) THEN + CALL MPI_ALLREDUCE(ENM0,ENMS0,1,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr) + ENDIF + + IF (MOD(RY,100).EQ.0) THEN + CALL MPI_ALLREDUCE(KIN,KINS,1,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr) + CALL MPI_ALLREDUCE(KIN2,KINS2,1,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr) + CALL MPI_ALLREDUCE(ENM,ENMS,1,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr) + CALL MPI_ALLREDUCE(MGH,MGHS,1,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr) + CALL MPI_ALLREDUCE(DMPEN,DMPENS,1,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr) + CALL MPI_ALLREDUCE(WEN,WENS,1,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr) + CALL MPI_ALLREDUCE(GSUM,GSUMS,1,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr) + CALL MPI_ALLREDUCE(DPE,DPES,1,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr) + CALL MPI_ALLREDUCE(BCE,BCES,1,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr) + CALL MPI_ALLREDUCE(BCC,BCCS,1,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,ierr) + CALL MPI_ALLREDUCE(PSUM,PSUMS,1,MPI_DOUBLE_PRECISION,MPI_SUM,MPI_COMM_WORLD,ierr) + IF (myid.EQ.0) WRITE(612,*) T,WENS+ENMS+ENMS0-BCES+KINS+KINS2& + +MGHS-MGH0,PSUMS-DPES-DMPENS-GSUMS+GSUM0 + + IF (myid.EQ.0) WRITE(610,10) T,WENS,ENMS+ENMS0,KINS,MGHS-MGH0 + IF (myid.EQ.0) WRITE(611,10) T,DPES,DMPENS,PSUMS,GSUMS + IF (myid.EQ.0) WRITE(613,19) T,KINS2,BCES,BCCS + END IF + + T=T+DT + + MML=0.0 + + DO I=1,NTOT + N1=NAN(1,I) + N2=NAN(2,I) + IF (EF(I).GT.0.0) THEN + DDX=NRXF(1,N1)+UT(6*N1-5)-NRXF(1,N2)-UT(6*N2-5) + DDY=NRXF(2,N1)+UT(6*N1-4)-NRXF(2,N2)-UT(6*N2-4) + DDZ=NRXF(3,N1)+UT(6*N1-3)-NRXF(3,N2)-UT(6*N2-3) + DX=NRXF(1,N1)-NRXF(1,N2) + DY=NRXF(2,N1)-NRXF(2,N2) + DZ=NRXF(3,N1)-NRXF(3,N2) + L=SQRT(DX**2+DY**2+DZ**2) + DL=SQRT(DDX**2+DDY**2+DDZ**2) + V1=ABS(UT(6*N1-2)-UT(6*N2-2)) + V2=ABS(UT(6*N1-1)-UT(6*N2-1)) + V3=ABS(UT(6*N1-0)-UT(6*N2-0)) + MAXV=MAX(V1,V2,V3) + LOAD=((DL-L)+0.35*MAXV) + IF (LOAD.GT.MML) MML=LOAD + IF (LOAD.GT.MLOAD.AND.T.GT.2.00) THEN + BCE=BCE+0.5*EF(I)*S**2/LNN*(DL-L)**2 + EF(I)=0.0 + BCC=BCC+1 + ENDIF + ENDIF + END DO + +! IF (myid.ne.0.and.myid.ne.(ntasks-1)/2+1) THEN +! DO I=1,NTOL +! N1=NANL(1,I) +! N2=NANL(2,I) +! IF (EFL(I).GT.0.0) THEN +! DDX=NRXFL(1,N1)+UTL(6*N1-5)-NRXF(1,N2)-UT(6*N2-5) +! DDY=NRXFL(2,N1)+UTL(6*N1-4)-NRXF(2,N2)-UT(6*N2-4) +! DDZ=NRXFL(3,N1)+UTL(6*N1-3)-NRXF(3,N2)-UT(6*N2-3) +! DX=NRXFL(1,N1)-NRXF(1,N2) +! DY=NRXFL(2,N1)-NRXF(2,N2) +! DZ=NRXFL(3,N1)-NRXF(3,N2) +! L=SQRT(DX**2+DY**2+DZ**2) +! DL=SQRT(DDX**2+DDY**2+DDZ**2) +! V1=ABS(UTL(6*N1-2)-UT(6*N2-2)) +! V2=ABS(UTL(6*N1-1)-UT(6*N2-1)) +! V3=ABS(UTL(6*N1-0)-UT(6*N2-0)) +! MAXV=MAX(V1,V2,V3) +! LOAD=((DL-L)+0.35*MAXV) +! IF (LOAD.GT.MML) MML=LOAD +! IF (LOAD.GT.MLOAD.AND.T.GT.1.0) THEN +! BCE=BCE+0.5*EFL(I)*S**2/LNN*(DL-L)**2 +! EFL(I)=0.0 +! BCC=BCC+1 +! ENDIF +! ENDIF +! END DO +! ENDIF + + IF (myid.ne.ntasks-1.and.myid.ne.(ntasks-1)/2) THEN + DO I=1,NTOR + N1=NANR(1,I) + N2=NANR(2,I) + IF (EFR(I).GT.0.0) THEN + DDX=NRXFR(1,N1)+UTR(6*N1-5)-NRXF(1,N2)-UT(6*N2-5) + DDY=NRXFR(2,N1)+UTR(6*N1-4)-NRXF(2,N2)-UT(6*N2-4) + DDZ=NRXFR(3,N1)+UTR(6*N1-3)-NRXF(3,N2)-UT(6*N2-3) + DX=NRXFR(1,N1)-NRXF(1,N2) + DY=NRXFR(2,N1)-NRXF(2,N2) + DZ=NRXFR(3,N1)-NRXF(3,N2) + L=SQRT(DX**2+DY**2+DZ**2) + DL=SQRT(DDX**2+DDY**2+DDZ**2) + V1=ABS(UTR(6*N1-2)-UT(6*N2-2)) + V2=ABS(UTR(6*N1-1)-UT(6*N2-1)) + V3=ABS(UTR(6*N1-0)-UT(6*N2-0)) + MAXV=MAX(V1,V2,V3) + LOAD=((DL-L)+0.35*MAXV) + IF (LOAD.GT.MML) MML=LOAD + IF (LOAD.GT.MLOAD.AND.T.GT.2.00) THEN + BCE=BCE+0.5*EFR(I)*S**2/LNN*(DL-L)**2 + EFR(I)=0.0 + BCC=BCC+1 + ENDIF + ENDIF + END DO + ENDIF + + dest=myid+1 + source=myid-1 + tag=131 + IF (MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Send(EFR,NTOR,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Recv(EFL,NTOL,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + IF (myid.le.(YN-1)*ntasks/YN) THEN + DO I=1,NTOF + N1=NANF(1,I) + N2=NANF(2,I) + IF (EFF(I).GT.0.0) THEN + DDX=NRXFF(1,N1)+UTF(6*N1-5)-NRXF(1,N2)-UT(6*N2-5) + DDY=NRXFF(2,N1)+UTF(6*N1-4)-NRXF(2,N2)-UT(6*N2-4) + DDZ=NRXFF(3,N1)+UTF(6*N1-3)-NRXF(3,N2)-UT(6*N2-3) + DX=NRXFF(1,N1)-NRXF(1,N2) + DY=NRXFF(2,N1)-NRXF(2,N2) + DZ=NRXFF(3,N1)-NRXF(3,N2) + L=SQRT(DX**2+DY**2+DZ**2) + DL=SQRT(DDX**2+DDY**2+DDZ**2) + V1=ABS(UTF(6*N1-2)-UT(6*N2-2)) + V2=ABS(UTF(6*N1-1)-UT(6*N2-1)) + V3=ABS(UTF(6*N1-0)-UT(6*N2-0)) + MAXV=MAX(V1,V2,V3) + LOAD=((DL-L)+0.35*MAXV) + IF (LOAD.GT.MML) MML=LOAD + IF (LOAD.GT.MLOAD.AND.T.GT.2.00) THEN + BCE=BCE+0.5*EFF(I)*S**2/LNN*(DL-L)**2 + EFF(I)=0.0 + BCC=BCC+1 + ENDIF + ENDIF + END DO + ENDIF + + dest=myid+ntasks/YN + source=myid-ntasks/YN + tag=132 + IF (myid.lt.(YN-1)*ntasks/YN)& + CALL MPI_Send(EFF,NTOF,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN)& + CALL MPI_Recv(EFB,NTOB,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + IF (myid.le.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN + DO I=1,NTOFL + N1=NANFL(1,I) + N2=NANFL(2,I) + IF (EFFL(I).GT.0.0) THEN + DDX=NRXFFL(1,N1)+UTFL(6*N1-5)-NRXF(1,N2)-UT(6*N2-5) + DDY=NRXFFL(2,N1)+UTFL(6*N1-4)-NRXF(2,N2)-UT(6*N2-4) + DDZ=NRXFFL(3,N1)+UTFL(6*N1-3)-NRXF(3,N2)-UT(6*N2-3) + DX=NRXFFL(1,N1)-NRXF(1,N2) + DY=NRXFFL(2,N1)-NRXF(2,N2) + DZ=NRXFFL(3,N1)-NRXF(3,N2) + L=SQRT(DX**2+DY**2+DZ**2) + DL=SQRT(DDX**2+DDY**2+DDZ**2) + V1=ABS(UTFL(6*N1-2)-UT(6*N2-2)) + V2=ABS(UTFL(6*N1-1)-UT(6*N2-1)) + V3=ABS(UTFL(6*N1-0)-UT(6*N2-0)) + MAXV=MAX(V1,V2,V3) + LOAD=((DL-L)+0.35*MAXV) + IF (LOAD.GT.MML) MML=LOAD + IF (LOAD.GT.MLOAD.AND.T.GT.2.00) THEN + BCE=BCE+0.5*EFFL(I)*S**2/LNN*(DL-L)**2 + EFFL(I)=0.0 + BCC=BCC+1 + ENDIF + ENDIF + END DO + ENDIF + + dest=myid+ntasks/YN-1 + source=myid-ntasks/YN+1 + tag=133 + IF (myid.lt.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Send(EFFL,NTOFL,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Recv(EFBR,NTOBR,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + + IF (myid.le.(YN-1)*ntasks/YN.AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN + DO I=1,NTOFR + N1=NANFR(1,I) + N2=NANFR(2,I) + IF (EFFR(I).GT.0.0) THEN + DDX=NRXFFR(1,N1)+UTFR(6*N1-5)-NRXF(1,N2)-UT(6*N2-5) + DDY=NRXFFR(2,N1)+UTFR(6*N1-4)-NRXF(2,N2)-UT(6*N2-4) + DDZ=NRXFFR(3,N1)+UTFR(6*N1-3)-NRXF(3,N2)-UT(6*N2-3) + DX=NRXFFR(1,N1)-NRXF(1,N2) + DY=NRXFFR(2,N1)-NRXF(2,N2) + DZ=NRXFFR(3,N1)-NRXF(3,N2) + L=SQRT(DX**2+DY**2+DZ**2) + DL=SQRT(DDX**2+DDY**2+DDZ**2) + V1=ABS(UTFR(6*N1-2)-UT(6*N2-2)) + V2=ABS(UTFR(6*N1-1)-UT(6*N2-1)) + V3=ABS(UTFR(6*N1-0)-UT(6*N2-0)) + MAXV=MAX(V1,V2,V3) + LOAD=((DL-L)+0.35*MAXV) + IF (LOAD.GT.MML) MML=LOAD + IF (LOAD.GT.MLOAD.AND.T.GT.2.00) THEN + BCE=BCE+0.5*EFFR(I)*S**2/LNN*(DL-L)**2 + EFFR(I)=0.0 + BCC=BCC+1 + ENDIF + ENDIF + END DO + ENDIF + + dest=myid+ntasks/YN+1 + source=myid-ntasks/YN-1 + tag=134 + IF (myid.lt.(YN-1)*ntasks/YN& + .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1)& + CALL MPI_Send(EFFR,NTOFR,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + IF (myid.ge.ntasks/YN.AND.MOD(myid,ntasks/YN).ne.0)& + CALL MPI_Recv(EFBL,NTOBL,MPI_DOUBLE_PRECISION,& + source,tag,MPI_COMM_WORLD,stat,ierr) + +! IF (myid.gt.(ntasks-1)/YN) THEN +! DO I=1,NTOB +! N1=NANB(1,I) +! N2=NANB(2,I) +! IF (EFB(I).GT.0.0) THEN +! DDX=NRXFB(1,N1)+UTB(6*N1-5)-NRXF(1,N2)-UT(6*N2-5) +! DDY=NRXFB(2,N1)+UTB(6*N1-4)-NRXF(2,N2)-UT(6*N2-4) +! DDZ=NRXFB(3,N1)+UTB(6*N1-3)-NRXF(3,N2)-UT(6*N2-3) +! DX=NRXFB(1,N1)-NRXF(1,N2) +! DY=NRXFB(2,N1)-NRXF(2,N2) +! DZ=NRXFB(3,N1)-NRXF(3,N2) +! L=SQRT(DX**2+DY**2+DZ**2) +! DL=SQRT(DDX**2+DDY**2+DDZ**2) +! V1=ABS(UTF(6*N1-2)-UT(6*N2-2)) +! V2=ABS(UTF(6*N1-1)-UT(6*N2-1)) +! V3=ABS(UTF(6*N1-0)-UT(6*N2-0)) +! MAXV=MAX(V1,V2,V3) +! LOAD=((DL-L)+0.35*MAXV) +! IF (LOAD.GT.MML) MML=LOAD +! IF (LOAD.GT.MLOAD.AND.T.GT.1.0) THEN +! BCE=BCE+0.5*EFB(I)*S**2/LNN*(DL-L)**2 +! EFB(I)=0.0 +! BCC=BCC+1 +! ENDIF +! ENDIF +! END DO +! ENDIF + +! IF (myid.gt.(ntasks-1)/YN.AND.MOD(myid,ntasks/YN).ne.0) THEN +! DO I=1,NTOBL +! N1=NANBL(1,I) +! N2=NANBL(2,I) +! IF (EFBL(I).GT.0.0) THEN +! DDX=NRXFBL(1,N1)+UTBL(6*N1-5)-NRXF(1,N2)-UT(6*N2-5) +! DDY=NRXFBL(2,N1)+UTBL(6*N1-4)-NRXF(2,N2)-UT(6*N2-4) +! DDZ=NRXFBL(3,N1)+UTBL(6*N1-3)-NRXF(3,N2)-UT(6*N2-3) +! DX=NRXFBL(1,N1)-NRXF(1,N2) +! DY=NRXFBL(2,N1)-NRXF(2,N2) +! DZ=NRXFBL(3,N1)-NRXF(3,N2) +! L=SQRT(DX**2+DY**2+DZ**2) +! DL=SQRT(DDX**2+DDY**2+DDZ**2) +! V1=ABS(UTFL(6*N1-2)-UT(6*N2-2)) +! V2=ABS(UTFL(6*N1-1)-UT(6*N2-1)) +! V3=ABS(UTFL(6*N1-0)-UT(6*N2-0)) +! MAXV=MAX(V1,V2,V3) +! LOAD=((DL-L)+0.35*MAXV) +! IF (LOAD.GT.MML) MML=LOAD +! IF (LOAD.GT.MLOAD.AND.T.GT.1.0) THEN +! BCE=BCE+0.5*EFBL(I)*S**2/LNN*(DL-L)**2 +! EFBL(I)=0.0 +! BCC=BCC+1 +! ENDIF +! ENDIF +! END DO +! ENDIF + +! IF (myid.gt.(ntasks-1)/YN +! 1 .AND.MOD(myid,ntasks/YN).ne.ntasks/YN-1) THEN +! DO I=1,NTOBR +! N1=NANBR(1,I) +! N2=NANBR(2,I) +! IF (EFBR(I).GT.0.0) THEN +! DDX=NRXFBR(1,N1)+UTBR(6*N1-5)-NRXF(1,N2)-UT(6*N2-5) +! DDY=NRXFBR(2,N1)+UTBR(6*N1-4)-NRXF(2,N2)-UT(6*N2-4) +! DDZ=NRXFBR(3,N1)+UTBR(6*N1-3)-NRXF(3,N2)-UT(6*N2-3) +! DX=NRXFBR(1,N1)-NRXF(1,N2) +! DY=NRXFBR(2,N1)-NRXF(2,N2) +! DZ=NRXFBR(3,N1)-NRXF(3,N2) +! L=SQRT(DX**2+DY**2+DZ**2) +! DL=SQRT(DDX**2+DDY**2+DDZ**2) +! V1=ABS(UTFR(6*N1-2)-UT(6*N2-2)) +! V2=ABS(UTFR(6*N1-1)-UT(6*N2-1)) +! V3=ABS(UTFR(6*N1-0)-UT(6*N2-0)) +! MAXV=MAX(V1,V2,V3) +! LOAD=((DL-L)+0.35*MAXV) +! IF (LOAD.GT.MML) MML=LOAD +! IF (LOAD.GT.MLOAD.AND.T.GT.1.0) THEN +! BCE=BCE+0.5*EFBR(I)*S**2/LNN*(DL-L)**2 +! EFBR(I)=0.0 +! BCC=BCC+1 +! ENDIF +! ENDIF +! END DO +! ENDIF + + DO I=1,6*NN + UTM(I)=UT(I) + UT(I)=UTP(I) + END DO + + IF (MOD(RY,20000).EQ.1) THEN + + dest=0 + + tag=151 + IF (myid.NE.0)& + CALL MPI_Send(UT,6*NN,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + + tag=152 + IF (myid.NE.0)& + CALL MPI_Send(NAN,3*NTOT,MPI_INTEGER,& + dest,tag,MPI_COMM_WORLD,ierr) + + tag=161 + IF (myid.NE.0)& + CALL MPI_Send(NRXF,3*NN,MPI_DOUBLE_PRECISION,& + dest,tag,MPI_COMM_WORLD,ierr) + + IF (myid.EQ.0) THEN + NRY=INT(RY/2e+04) + OPEN(UNIT=910,FILE='JYR'//na(NRY)//'.csv',STATUS='UNKNOWN') + OPEN(UNIT=920,FILE='STR'//na(NRY)//'.csv',STATUS='UNKNOWN') + + DO KK=1,ntasks-1 + + source=KK + + tag=151 + CALL MPI_Recv(UTW,6*PNN(source),MPI_DOUBLE_PRECISION,source,tag,MPI_COMM_WORLD,stat,ierr) + + tag=152 + CALL MPI_Recv(NANW,3*NTOTW(source),MPI_INTEGER,source,tag,MPI_COMM_WORLD,stat,ierr) + + tag=161 + CALL MPI_Recv(NRXFW,3*PNN(source),MPI_DOUBLE_PRECISION,source,tag,MPI_COMM_WORLD,stat,ierr) + + DO I=1,PNN(source) + X=NRXFW(1,I)+UTW(6*I-5) + Y=NRXFW(2,I)+UTW(6*I-4) + Z=NRXFW(3,I)+UTW(6*I-3) + WRITE(910,12) X,Y,Z + END DO + + DO I=1,NTOTW(source) + + X=(NRXFW(1,NANW(1,I))+UTW(6*NANW(1,I)-5)+NRXFW(1,NANW(2,I))+UTW(6*NANW(2,I)-5))/2.0 + + Y=(NRXFW(2,NANW(1,I))+UTW(6*NANW(1,I)-4)+NRXFW(2,NANW(2,I))+UTW(6*NANW(2,I)-4))/2.0 + + Z=(NRXFW(3,NANW(1,I))+UTW(6*NANW(1,I)-3)+NRXFW(3,NANW(2,I))+UTW(6*NANW(2,I)-3))/2.0 + + + N1=NANW(1,I) + N2=NANW(2,I) + DDX=NRXFW(1,N1)+UTW(6*N1-5)-NRXFW(1,N2)-UTW(6*N2-5) + DDY=NRXFW(2,N1)+UTW(6*N1-4)-NRXFW(2,N2)-UTW(6*N2-4) + DDZ=NRXFW(3,N1)+UTW(6*N1-3)-NRXFW(3,N2)-UTW(6*N2-3) + DX=NRXFW(1,N1)-NRXFW(1,N2) + DY=NRXFW(2,N1)-NRXFW(2,N2) + DZ=NRXFW(3,N1)-NRXFW(3,N2) + L=SQRT(DX**2+DY**2+DZ**2) + DL=SQRT(DDX**2+DDY**2+DDZ**2) + STR=(DL-L)/L + + +! IF (Z.GT.MAXZ-120.0) WRITE(920,12) X,Y,Z,STR + WRITE(920,12) X,Y,Z,STR + END DO + + END DO + + DO I=1,NN + X=NRXF(1,I)+UT(6*I-5) + Y=NRXF(2,I)+UT(6*I-4) + Z=NRXF(3,I)+UT(6*I-3) + WRITE(910,12) X,Y,Z + END DO + + DO I=1,NTOT + X=(NRXF(1,NAN(1,I))+UT(6*NAN(1,I)-5)+NRXF(1,NAN(2,I))+UT(6*NAN(2,I)-5))/2.0 + Y=(NRXF(2,NAN(1,I))+UT(6*NAN(1,I)-4)+NRXF(2,NAN(2,I))+UT(6*NAN(2,I)-4))/2.0 + Z=(NRXF(3,NAN(1,I))+UT(6*NAN(1,I)-3)+NRXF(3,NAN(2,I))+UT(6*NAN(2,I)-3))/2.0 + + N1=NAN(1,I) + N2=NAN(2,I) + DDX=NRXF(1,N1)+UT(6*N1-5)-NRXF(1,N2)-UT(6*N2-5) + DDY=NRXF(2,N1)+UT(6*N1-4)-NRXF(2,N2)-UT(6*N2-4) + DDZ=NRXF(3,N1)+UT(6*N1-3)-NRXF(3,N2)-UT(6*N2-3) + DX=NRXF(1,N1)-NRXF(1,N2) + DY=NRXF(2,N1)-NRXF(2,N2) + DZ=NRXF(3,N1)-NRXF(3,N2) + L=SQRT(DX**2+DY**2+DZ**2) + DL=SQRT(DDX**2+DDY**2+DDZ**2) + STR=(DL-L)/L + +! IF (Z.GT.MAXZ-120.0) WRITE(920,12) X,Y,STR + WRITE(920,12) X,Y,Z,STR + END DO + + ENDIF + +! CALL PSNET(NTOT,NN,myid,GL,WL,SUB,ntasks) + CLOSE(910) + CLOSE(920) + ENDIF + +! IF (RY.EQ.RY0+STEPS0) THEN +! CALL CRACK(NN,NTOT,CCN,EF,NAN,NRXF,UT,WL,myid,ntasks,NANR,NTOR,EFR) +! +! dest=0 +! tag=171 +! IF (myid.NE.0) CALL MPI_Send(CCN,NN,MPI_DOUBLE_PRECISION,dest,tag,MPI_COMM_WORLD,ierr) +! +! IF (myid.EQ.0) THEN +! OPEN(UNIT=112, FILE='frag',STATUS='UNKNOWN') +! DO KK=1,ntasks-1 +! source=KK +! tag=171 +! CALL MPI_Recv(CCNW,NN,MPI_DOUBLE_PRECISION,source,tag,MPI_COMM_WORLD,stat,ierr) +! DO I=1,NN +! CCN(I)=CCN(I)+CCNW(I) +! END DO +! END DO +! DO I=1,NN +! IF (CCN(I).NE.0) WRITE(112,*) I,CCN(I) +! CCN(I)=0 +! END DO +! CLOSE(112) +! ENDIF +! ENDIF + + IF (MOD(RY,10000).EQ.0) THEN + IF (myid.EQ.0) THEN + WRITE(*,*) RY,MML/MLOAD,BCC + WRITE(616,*) RY,MAXDT + ENDIF +! IF (BCC.NE.0) WRITE(700+myid,16) T, BCC + BCC=0 + ENDIF + + 100 CONTINUE + + OPEN(UNIT=930,FILE='RCK',STATUS='UNKNOWN') + DO KK=0,ntasks-1 + WRITE(930,*) KK, NTOTW(KK),PNN(KK),PTR(KK),PTB(KK) + END DO + CLOSE(930) + + CALL CPU_TIME(T2) + WRITE(*,*) 'TIME=',T2-T1,TS1 + + OPEN(UNIT=117+myid,FILE='REST0'//na(myid),STATUS='UNKNOWN') + WRITE(117+myid,*) NN,NTOT,NTOL,NTOR,NTOF,NTOB,BCC + write(117+myid,*) NTOFL,NTOFR,NTOBL,NTOBR + WRITE(117+myid,*) MAXX,MAXY,MAXZ,DMPEN,ENM+ENM0 + WRITE(117+myid,*) DPE,BCE,MGH0,GSUM0,PSUM,T,RY-1 + CLOSE (117+myid) + + OPEN(UNIT=117+myid,FILE='REST1'//na(myid),STATUS='UNKNOWN') + DO I=1,NTOT+NTOL+NTOR+NTOF+NTOB+NTOFL+NTOFR+NTOBL+NTOBR + WRITE(117+myid,*) CT(12*I-11),CT(12*I-10),CT(12*I-9),CT(12*I-8),CT(12*I-7),CT(12*I-6) + WRITE(117+myid,*) CT(12*I-5),CT(12*I-4),CT(12*I-3),CT(12*I-2),CT(12*I-1),CT(12*I-0) + END DO + CLOSE (117+myid) + + OPEN(UNIT=117+myid,FILE='REST2'//na(myid),STATUS='UNKNOWN') + DO I=1,NN + WRITE(117+myid,*) UT(6*I-5),UT(6*I-4),UT(6*I-3),UT(6*I-2),UT(6*I-1),UT(6*I-0) + WRITE(117+myid,*) UTM(6*I-5),UTM(6*I-4),UTM(6*I-3),UTM(6*I-2),UTM(6*I-1),UTM(6*I-0) + END DO + CLOSE (117+myid) + + OPEN(UNIT=117+myid,FILE='FS'//na(myid),STATUS='UNKNOWN') + DO SI=1,NTOT + WRITE(117+myid,*) NAN(1,SI),NAN(2,SI),NRXF(1,NAN(1,SI)),& + NRXF(2,NAN(1,SI)),NRXF(3,NAN(1,SI)),NRXF(1,NAN(2,SI)),& + NRXF(2,NAN(2,SI)),NRXF(3,NAN(2,SI)),EF(SI) + END DO + CLOSE (117+myid) + + OPEN(UNIT=117+myid,FILE='FSL'//na(myid),STATUS='UNKNOWN') + DO SI=1,NTOL + WRITE(117+myid,*) NANL(1,SI),NANL(2,SI),NRXFL(1,NANL(1,SI)),& + NRXFL(2,NANL(1,SI)),NRXFL(3,NANL(1,SI)),NRXF(1,NANL(2,SI)),& + NRXF(2,NANL(2,SI)),NRXF(3,NANL(2,SI)),EFL(SI) + END DO + CLOSE (117+myid) + + OPEN(UNIT=117+myid,FILE='FSR'//na(myid),STATUS='UNKNOWN') + DO SI=1,NTOR + WRITE(117+myid,*) NANR(1,SI),NANR(2,SI),NRXFR(1,NANR(1,SI)),& + NRXFR(2,NANR(1,SI)),NRXFR(3,NANR(1,SI)),NRXF(1,NANR(2,SI)),& + NRXF(2,NANR(2,SI)),NRXF(3,NANR(2,SI)),EFR(SI) + END DO + CLOSE (117+myid) + + OPEN(UNIT=117+myid,FILE='FSF'//na(myid),STATUS='UNKNOWN') + DO SI=1,NTOF + WRITE(117+myid,*) NANF(1,SI),NANF(2,SI),NRXFF(1,NANF(1,SI)),& + NRXFF(2,NANF(1,SI)),NRXFF(3,NANF(1,SI)),NRXF(1,NANF(2,SI)),& + NRXF(2,NANF(2,SI)),NRXF(3,NANF(2,SI)),EFF(SI) + END DO + CLOSE (117+myid) + + OPEN(UNIT=117+myid,FILE='FSFL'//na(myid),STATUS='UNKNOWN') + DO SI=1,NTOFL + WRITE(117+myid,*) NANFL(1,SI),NANFL(2,SI),NRXFFL(1,NANFL(1,SI)),& + NRXFFL(2,NANFL(1,SI)),NRXFFL(3,NANFL(1,SI)),NRXF(1,NANFL(2,SI)),& + NRXF(2,NANFL(2,SI)),NRXF(3,NANFL(2,SI)),EFFL(SI) + END DO + CLOSE (117+myid) + + OPEN(UNIT=117+myid,FILE='FSFR'//na(myid),STATUS='UNKNOWN') + DO SI=1,NTOFR + WRITE(117+myid,*) NANFR(1,SI),NANFR(2,SI),NRXFFR(1,NANFR(1,SI)),& + NRXFFR(2,NANFR(1,SI)),NRXFFR(3,NANFR(1,SI)),NRXF(1,NANFR(2,SI)),& + NRXF(2,NANFR(2,SI)),NRXF(3,NANFR(2,SI)),EFFR(SI) + END DO + CLOSE (117+myid) + + OPEN(UNIT=117+myid,FILE='FSB'//na(myid),STATUS='UNKNOWN') + DO SI=1,NTOB + WRITE(117+myid,*) NANB(1,SI),NANB(2,SI),NRXFB(1,NANB(1,SI)),& + NRXFB(2,NANB(1,SI)),NRXFB(3,NANB(1,SI)),NRXF(1,NANB(2,SI)),& + NRXF(2,NANB(2,SI)),NRXF(3,NANB(2,SI)),EFB(SI) + END DO + CLOSE (117+myid) + + OPEN(UNIT=117+myid,FILE='FSBL'//na(myid),STATUS='UNKNOWN') + DO SI=1,NTOBL + WRITE(117+myid,*) NANBL(1,SI),NANBL(2,SI),NRXFBL(1,NANBL(1,SI)),& + NRXFBL(2,NANBL(1,SI)),NRXFBL(3,NANBL(1,SI)),NRXF(1,NANBL(2,SI)),& + NRXF(2,NANBL(2,SI)),NRXF(3,NANBL(2,SI)),EFBL(SI) + END DO + CLOSE (117+myid) + + OPEN(UNIT=117+myid,FILE='FSBR'//na(myid),STATUS='UNKNOWN') + DO SI=1,NTOBR + WRITE(117+myid,*) NANBR(1,SI),NANBR(2,SI),NRXFBR(1,NANBR(1,SI)),& + NRXFBR(2,NANBR(1,SI)),NRXFBR(3,NANBR(1,SI)),NRXF(1,NANBR(2,SI)),& + NRXF(2,NANBR(2,SI)),NRXF(3,NANBR(2,SI)),EFBR(SI) + END DO + CLOSE (117+myid) + + IF (myid.EQ.0) THEN + OPEN(UNIT=117,FILE='crkd',STATUS='UNKNOWN') + DO SI=1,ntasks + WRITE(117,*) NTOTW(SI-1),PNN(SI-1),PTR(SI-1),PTB(SI-1) + END DO + CLOSE (117) + ENDIF + +! CALL MPI_BARRIER(MPI_COMM_WORLD,ierr) +! IF (myid.EQ.0) CALL CRACK(ntasks,NTOTW,PNN,PTR,PTB,YN) + + CALL MPI_FINALIZE(rc) + STOP + END + +