m_GeneralGrid.F90 109 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315
  1. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2. ! Math and Computer Science Division, Argonne National Laboratory !
  3. !-----------------------------------------------------------------------
  4. ! CVS m_GeneralGrid.F90,v 1.36 2008-05-12 01:57:21 jacob Exp
  5. ! CVS MCT_2_8_0
  6. !BOP -------------------------------------------------------------------
  7. !
  8. ! !MODULE: m_GeneralGrid -- Physical Coordinate Grid Information Storage
  9. !
  10. ! !DESCRIPTION:
  11. ! The {\tt GeneralGrid} data type is a flexible, generic structure for
  12. ! storing physical coordinate grid information. The {\tt GeneralGrid}
  13. ! may be employed to store coordinate grids of arbitrary dimension, and
  14. ! is also capable of supporting unstructured grids such as meteorological
  15. ! observation data streams. The grid is representated by a literal
  16. ! listing of the gridpoint coordinates, along with other integer and real
  17. ! {\em attributes} associated with each location. Examples of real
  18. ! non-coordinate attributes are grid cell length, cross-sectional area, and
  19. ! volume elements, projections of local directional unit vectors onto
  20. ! {\em et cetera} A {\tt GeneralGrid} as at minimum one integer
  21. ! attribute---{\em the global grid point number}, or {\tt GlobGridNum},
  22. ! which serves as a unique identifier for each physical grid location.
  23. !
  24. ! The real attributes of of the {\tt GeneralGrid} are grouped as {\tt List}
  25. ! components:
  26. ! \begin{itemize}
  27. ! \item {\tt GGrid\%coordinate\_list} contains the list of the physical
  28. ! dimension names of the grid. The user initializes a {\tt List} by
  29. ! supplying the items in it as a string with the items delimitted by
  30. ! colons. For example, setting the coordinates for Euclidean 3-space
  31. ! is accomplished by a choice of {\tt 'x:y:z'}, cylindrical coordinates
  32. ! by {\tt 'rho:theta:z'}, spherical coordinates by {\tt 'r:theta:phi'},
  33. ! {\em et cetera}.
  34. ! \item {\tt GGrid\%weight\_list} contains the names of the spatial
  35. ! cell length, area, and volume weights associated with the grid. These
  36. ! are also stored in {\tt List} form, and are set by the user in the same
  37. ! fashion as described above for coordinates. For example, one might
  38. ! wish create cell weight attributes for a cylindrical grid by defining
  39. ! a weight list of {\tt 'drho:dphi:rhodphi:dz}.
  40. ! \item {\tt GGrid\%other\_list} is space for the user to define other
  41. ! real attributes. For example, one might wish to do vector calculus
  42. ! operatons in spherical coordinates. Since the spherical coordinate
  43. ! unit vectors ${\hat r}$, ${\hat \theta}$, and ${\hat \phi}$
  44. ! vary in space, it is sometimes useful to store their projections on
  45. ! the fixed Euclidean unit vectors ${\bf \hat x}$, ${\bf \hat y}$, and
  46. ! ${\bf \hat z}$. To do this one might set up a list of attributes
  47. ! using the string
  48. ! \begin{verbatim}
  49. ! 'rx:ry:rz:thetax:thetay:thetaz:phix:phiy:phyz'
  50. ! \end{verbatim}
  51. ! \item {\tt GGrid\%index\_list} provides space for the user to define
  52. ! integer attributes such as alternative indexing schemes, indices for
  53. ! defining spatial regions, {\em et cetera}. This attribute list contains
  54. ! all the integer attributes for the {\tt GeneralGrid} save one: the
  55. ! with the ever-present {\em global gridpoint number attribute}
  56. ! {\tt GlobGridNum}, which is set automatically by MCT.
  57. ! \end{itemize}
  58. !
  59. ! This module contains the definition of the {\tt GeneralGrid} datatype,
  60. ! various methods for creating and destroying it, query methods, and tools
  61. ! for multiple-key sorting of gridpoints.
  62. !
  63. ! !INTERFACE:
  64. module m_GeneralGrid
  65. !
  66. ! !USES:
  67. !
  68. use m_List, only : List ! Support for List components.
  69. use m_AttrVect, only : AttrVect ! Support for AttrVect component.
  70. implicit none
  71. private ! except
  72. ! !PUBLIC TYPES:
  73. public :: GeneralGrid ! The class data structure
  74. Type GeneralGrid
  75. #ifdef SEQUENCE
  76. sequence
  77. #endif
  78. type(List) :: coordinate_list
  79. type(List) :: coordinate_sort_order
  80. logical, dimension(:), pointer :: descend
  81. type(List) :: weight_list
  82. type(List) :: other_list
  83. type(List) :: index_list
  84. type(AttrVect) :: data
  85. End Type GeneralGrid
  86. ! !PUBLIC MEMBER FUNCTIONS:
  87. public :: init ! Create a GeneralGrid
  88. public :: initCartesian !
  89. public :: initUnstructured !
  90. public :: clean ! Destroy a GeneralGrid
  91. public :: zero ! Zero data in a GeneralGrid
  92. ! Query functions-----------------
  93. public :: dims ! Return dimensionality of the GeneralGrid
  94. public :: indexIA ! Index integer attribute (indices)
  95. public :: indexRA ! Index integer attribute (coords/weights)
  96. public :: lsize ! Return local number of points
  97. public :: exportIAttr ! Return INTEGER attribute as a vector
  98. public :: exportRAttr ! Return REAL attribute as a vector
  99. ! Manipulation--------------------
  100. public :: importIAttr ! Insert INTEGER vector as attribute
  101. public :: importRAttr ! Insert REAL vector as attribute
  102. public :: Sort ! Sort point data by coordinates -> permutation
  103. public :: Permute ! Rearrange point data using input permutation
  104. public :: SortPermute ! Sort and Permute point data
  105. interface init ; module procedure &
  106. init_, &
  107. initl_, &
  108. initgg_
  109. end interface
  110. interface initCartesian ; module procedure &
  111. initCartesianSP_, &
  112. initCartesianDP_
  113. end interface
  114. interface initUnstructured ; module procedure &
  115. initUnstructuredSP_, &
  116. initUnstructuredDP_
  117. end interface
  118. interface clean ; module procedure clean_ ; end interface
  119. interface zero ; module procedure zero_ ; end interface
  120. interface dims ; module procedure dims_ ; end interface
  121. interface indexIA ; module procedure indexIA_ ; end interface
  122. interface indexRA ; module procedure indexRA_ ; end interface
  123. interface lsize ; module procedure lsize_ ; end interface
  124. interface exportIAttr ; module procedure exportIAttr_ ; end interface
  125. interface exportRAttr ; module procedure &
  126. exportRAttrSP_, &
  127. exportRAttrDP_
  128. end interface
  129. interface importIAttr ; module procedure importIAttr_ ; end interface
  130. interface importRAttr ; module procedure &
  131. importRAttrSP_, &
  132. importRAttrDP_
  133. end interface
  134. interface Sort ; module procedure Sort_ ; end interface
  135. interface Permute ; module procedure Permute_ ; end interface
  136. interface SortPermute ; module procedure SortPermute_ ; end interface
  137. ! !PUBLIC DATA MEMBERS:
  138. ! CHARACTER Tag for GeneralGrid Global Grid Point Identification Number
  139. character(len=*), parameter :: GlobGridNum='GlobGridNum'
  140. ! !SEE ALSO:
  141. ! The MCT module m_AttrVect and the mpeu module m_List.
  142. ! !REVISION HISTORY:
  143. ! 25Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
  144. ! 31Oct00 - J.W. Larson <larson@mcs.anl.gov> - modified the
  145. ! GeneralGrid type to allow inclusion of grid cell
  146. ! dimensions (lengths) and area/volume weights.
  147. ! 15Jan01 - J.W. Larson implemented new GeneralGrid type
  148. ! definition and added numerous APIs.
  149. ! 17Jan01 - J.W. Larson fixed minor bug in module header use
  150. ! statement.
  151. ! 19Jan01 - J.W. Larson added other_list and coordinate_sort_order
  152. ! components to the GeneralGrid type.
  153. ! 21Mar01 - J.W. Larson - deleted the initv_ API (more study
  154. ! needed before implementation.
  155. ! 2May01 - J.W. Larson - added initgg_ API (replaces old initv_).
  156. ! 13Dec01 - J.W. Larson - added import and export methods.
  157. ! 27Mar02 - J.W. Larson <larson@mcs.anl.gov> - Corrected usage of
  158. ! m_die routines throughout this module.
  159. ! 5Aug02 - E. Ong <eong@mcs.anl.gov> - Modified GeneralGrid usage
  160. ! to allow user-defined grid numbering schemes.
  161. !EOP ___________________________________________________________________
  162. character(len=*),parameter :: myname='MCT::m_GeneralGrid'
  163. contains
  164. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  165. ! Math and Computer Science Division, Argonne National Laboratory !
  166. !BOP -------------------------------------------------------------------
  167. !
  168. ! !IROUTINE: init_ - Create an Empty GeneralGrid
  169. !
  170. ! !DESCRIPTION:
  171. ! The routine {\tt init\_()} creates the storage space for grid point
  172. ! coordinates, area/volume weights, and other coordinate data ({\em e.g.},
  173. ! local cell dimensions). These data are referenced by {\tt List}
  174. ! components that are also created by this routine (see the documentation
  175. ! of the declaration section of this module for more details about setting
  176. ! list information). Each of the input {\tt CHARACTER} arguments is a
  177. ! colon-delimited string of attribute names, each corrsponding to a
  178. ! {\tt List} element of the output {\tt GeneralGrid} argument {\tt GGrid},
  179. ! and are summarized in the table below:
  180. !
  181. !\begin{table}[htbp]
  182. !\begin{center}
  183. !\begin{tabular}{|l|l|l|l|}
  184. !\hline
  185. !{\bf Argument} & {\bf Component of {\tt GGrid}} & {\bf Significance} & {\bf Required?} \\
  186. !\hline
  187. !{\tt CoordChars} & {\tt GGrid\%coordinate\_list} & Dimension Names & Yes \\
  188. !\hline
  189. !{\tt CoordSortOrder} & {\tt GGrid\%coordinate\_sort\_order} & Grid Point & No \\
  190. ! & & Sorting Keys & \\
  191. !\hline
  192. !{\tt WeightChars} & {\tt GGrid\%weight\_list} & Grid Cell & No \\
  193. ! & & Length, Area, and & \\
  194. ! & & Volume Weights & \\
  195. !\hline
  196. !{\tt OtherChars} & {\tt GGrid\%other\_list} & All Other & No \\
  197. ! & & Real Attributes & \\
  198. !\hline
  199. !{\tt IndexChars} & {\tt GGrid\%index\_list} & All Other & No \\
  200. ! & & Integer Attributes & \\
  201. !\hline
  202. !\end{tabular}
  203. !\end{center}
  204. !\end{table}
  205. !
  206. ! The input {\tt INTEGER} argument {\tt lsize} defines the number of grid points
  207. ! to be stored in {\tt GGrid}.
  208. !
  209. ! If a set of sorting keys is supplied in the argument {\tt CoordSortOrder},
  210. ! the user can control whether the sorting by each key is in descending or
  211. ! ascending order by supplying the input {\tt LOGICAL} array {\tt descend(:)}.
  212. ! By default, all sorting is in {\em ascending} order for each key if the
  213. ! argument {\tt descend} is not provided.
  214. !
  215. ! {\bf N.B.}: The output {\tt GeneralGrid} {\tt GGrid} is dynamically
  216. ! allocated memory. When one no longer needs {\tt GGrid}, one should
  217. ! release this space by invoking {\tt clean()} for the {\tt GeneralGrid}.
  218. !
  219. ! !INTERFACE:
  220. subroutine init_(GGrid, CoordChars, CoordSortOrder, descend, WeightChars, &
  221. OtherChars, IndexChars, lsize )
  222. !
  223. ! !USES:
  224. !
  225. use m_stdio
  226. use m_die
  227. use m_List, only : List
  228. use m_List, only : List_init => init
  229. use m_List, only : List_nitem => nitem
  230. use m_List, only : List_shared => GetSharedListIndices
  231. use m_List, only : List_append => append
  232. use m_List, only : List_copy => copy
  233. use m_List, only : List_nullify => nullify
  234. use m_List, only : List_clean => clean
  235. use m_AttrVect, only : AttrVect
  236. use m_AttrVect, only : AttrVect_init => init
  237. implicit none
  238. ! !INPUT PARAMETERS:
  239. !
  240. character(len=*), intent(in) :: CoordChars
  241. character(len=*), optional, intent(in) :: CoordSortOrder
  242. character(len=*), optional, intent(in) :: WeightChars
  243. logical, dimension(:), optional, pointer :: descend
  244. character(len=*), optional, intent(in) :: OtherChars
  245. character(len=*), optional, intent(in) :: IndexChars
  246. integer, optional, intent(in) :: lsize
  247. ! !OUTPUT PARAMETERS:
  248. !
  249. type(GeneralGrid), intent(out) :: GGrid
  250. ! !REVISION HISTORY:
  251. ! 25Sep00 - Jay Larson <larson@mcs.anl.gov> - initial prototype
  252. ! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - modified to fit
  253. ! new GeneralGrid definition.
  254. ! 19Mar01 - Jay Larson <larson@mcs.anl.gov> - added OtherChars
  255. ! 25Apr01 - Jay Larson <larson@mcs.anl.gov> - added GlobGridNum
  256. ! as a mandatory integer attribute.
  257. ! 13Jun01 - Jay Larson <larson@mcs.anl.gov> - No longer define
  258. ! blank List attributes of the GeneralGrid. Previous
  259. ! versions of this routine had this feature, and this
  260. ! caused problems with the GeneralGrid Send and Receive
  261. ! operations on the AIX platform.
  262. ! 13Jun01 - R. Jacob <jacob@mcs.anl.gov> - nullify any pointers
  263. ! for lists not declared.
  264. ! 15Feb02 - Jay Larson <larson@mcs.anl.gov> - made the input
  265. ! argument CoordSortOrder mandatory (rather than
  266. ! optional).
  267. ! 18Jul02 - E. Ong <eong@mcs.anl.gov> - replaced this version of
  268. ! init with one that calls initl_.
  269. ! 5Aug02 - E. Ong <eong@mcs.anl.gov> - made the input argument
  270. ! CoordSortOrder optional to allow user-defined grid
  271. ! numbering schemes.
  272. !EOP ___________________________________________________________________
  273. !
  274. character(len=*),parameter :: myname_=myname//'::init_'
  275. ! List to store real and integer attributes
  276. type(List) :: RAList, IAList
  277. ! Overlapping index storage arrays:
  278. integer, dimension(:), pointer :: &
  279. CoordListIndices, CoordSortOrderIndices
  280. ! Temporary vars
  281. integer :: NumShared, nitems, i, l, ierr
  282. ! Let's begin by nullifying everything:
  283. call List_nullify(GGrid%coordinate_list)
  284. call List_nullify(GGrid%coordinate_sort_order)
  285. call List_nullify(GGrid%weight_list)
  286. call List_nullify(GGrid%other_list)
  287. call List_nullify(GGrid%index_list)
  288. nullify(GGrid%descend)
  289. ! Convert the Character arguments to the appropriate
  290. ! GeneralGrid components.
  291. ! Set up the integer and real attribute lists.
  292. call List_init(GGrid%coordinate_list,trim(CoordChars))
  293. call List_copy(RAList,GGrid%coordinate_list)
  294. if(present(CoordSortOrder)) then
  295. call List_init(GGrid%coordinate_sort_order,trim(CoordSortOrder))
  296. endif
  297. if(present(WeightChars)) then
  298. call List_init(GGrid%weight_list,trim(WeightChars))
  299. call List_append(RAList, GGrid%weight_list)
  300. endif
  301. if(present(OtherChars)) then
  302. call List_init(GGrid%other_list,trim(OtherChars))
  303. call List_append(RAList, GGrid%other_list)
  304. endif
  305. call List_init(IAList,GlobGridNum)
  306. if(present(IndexChars)) then
  307. call List_init(GGrid%index_list,trim(IndexChars))
  308. call List_append(IAList, GGrid%index_list)
  309. endif
  310. ! Check the lists that we've initialized :
  311. nitems = List_nitem(GGrid%coordinate_list)
  312. ! Check the number of coordinates
  313. if(nitems <= 0) then
  314. write(stderr,*) myname_, &
  315. ':: ERROR CoordList is empty!'
  316. call die(myname_,'List_nitem(CoordList) <= 0',nitems)
  317. endif
  318. ! Check the items in the coordinate list and the
  319. ! coordinate grid sort keys...they should contain
  320. ! the same items.
  321. if(present(CoordSortOrder)) then
  322. call List_shared(GGrid%coordinate_list,GGrid%coordinate_sort_order, &
  323. NumShared,CoordListIndices,CoordSortOrderIndices)
  324. deallocate(CoordListIndices,CoordSortOrderIndices,stat=ierr)
  325. if(ierr/=0) call die(myname_,'deallocate(CoordListIndices..)',ierr)
  326. if(NumShared /= nitems) then
  327. call die(myname_,'CoordSortOrder must have the same items &
  328. & as CoordList',abs(nitems-NumShared))
  329. endif
  330. endif
  331. ! If the LOGICAL argument descend is present, check the
  332. ! number of entries to ensure they match the grid dimensionality.
  333. ! If descend is not present, assume all coordinate grid point
  334. ! sortings will be in ascending order.
  335. if(present(descend)) then
  336. if( ( (.not.associated(descend)) .or. &
  337. (.not.present(CoordSortOrder)) ) .or. &
  338. (size(descend) /= nitems) ) then
  339. write(stderr,*) myname_, &
  340. ':: ERROR using descend argument, &
  341. &associated(descend) = ', associated(descend), &
  342. ' present(CoordSortOrder) = ', present(CoordSortOrder), &
  343. ' size(descend) = ', size(descend), &
  344. ' List_nitem(CoordSortOrder) = ', &
  345. List_nitem(GGrid%coordinate_sort_order)
  346. call die(myname_, 'ERROR using -descend- argument; &
  347. & see stderr file for details')
  348. endif
  349. endif
  350. ! Finally, Initialize GGrid%descend from descend(:).
  351. ! If descend argument is not present, set it to the default .false.
  352. if(present(CoordSortOrder)) then
  353. allocate(GGrid%descend(nitems), stat=ierr)
  354. if(ierr /= 0) call die(myname_,"allocate GGrid%descend...",ierr)
  355. if(present(descend)) then
  356. do i=1,nitems
  357. GGrid%descend(i) = descend(i)
  358. enddo
  359. else
  360. do i=1,nitems
  361. GGrid%descend(i) = .FALSE.
  362. enddo
  363. endif
  364. endif
  365. ! Initialize GGrid%data using IAList, RAList, and lsize (if
  366. ! present).
  367. l = 0
  368. if(present(lsize)) l=lsize
  369. call AttrVect_init(GGrid%data, IAList, RAList, l)
  370. ! Deallocate the temporary variables
  371. call List_clean(IAList)
  372. call List_clean(RAList)
  373. end subroutine init_
  374. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  375. ! Math and Computer Science Division, Argonne National Laboratory !
  376. !BOP -------------------------------------------------------------------
  377. !
  378. ! !IROUTINE: initl_ - Create an Empty GeneralGrid from Lists
  379. !
  380. ! !DESCRIPTION:
  381. ! The routine {\tt initl\_()} creates the storage space for grid point
  382. ! coordinates, area/volume weights, and other coordinate data ({\em e.g.},
  383. ! local cell dimensions). These data are referenced by {\tt List}
  384. ! components that are also created by this routine (see the documentation
  385. ! of the declaration section of this module for more details about setting
  386. ! list information). Each of the input {\tt List} arguments is used
  387. ! directly to create the corresponding
  388. ! {\tt List} element of the output {\tt GeneralGrid} argument {\tt GGrid},
  389. ! and are summarized in the table below:
  390. !
  391. !\begin{table}[htbp]
  392. !\begin{center}
  393. !\begin{tabular}{|l|l|l|l|}
  394. !\hline
  395. !{\bf Argument} & {\bf Component of {\tt GGrid}} & {\bf Significance} & {\bf Required?} \\
  396. !\hline
  397. !{\tt CoordList} & {\tt GGrid\%coordinate\_list} & Dimension Names & Yes \\
  398. !\hline
  399. !{\tt CoordSortOrder} & {\tt GGrid\%coordinate\_sort\_order} & Grid Point & No \\
  400. ! & & Sorting Keys & \\
  401. !\hline
  402. !{\tt WeightList} & {\tt GGrid\%weight\_list} & Grid Cell & No \\
  403. ! & & Length, Area, and & \\
  404. ! & & Volume Weights & \\
  405. !\hline
  406. !{\tt OtherList} & {\tt GGrid\%other\_list} & All Other & No \\
  407. ! & & Real Attributes & \\
  408. !\hline
  409. !{\tt IndexList} & {\tt GGrid\%index\_list} & All Other & No \\
  410. ! & & Integer Attributes & \\
  411. !\hline
  412. !\end{tabular}
  413. !\end{center}
  414. !\end{table}
  415. !
  416. ! The input {\tt INTEGER} argument {\tt lsize} defines the number of grid points
  417. ! to be stored in {\tt GGrid}.
  418. !
  419. ! If a set of sorting keys is supplied in the argument {\tt CoordSortOrder},
  420. ! the user can control whether the sorting by each key is in descending or
  421. ! ascending order by supplying the input {\tt LOGICAL} array {\tt descend(:)}.
  422. ! By default, all sorting is in {\em ascending} order for each key if the
  423. ! argument {\tt descend} is not provided.
  424. !
  425. ! {\bf N.B.}: The output {\tt GeneralGrid} {\tt GGrid} is dynamically
  426. ! allocated memory. When one no longer needs {\tt GGrid}, one should
  427. ! release this space by invoking {\tt clean()} for the {\tt GeneralGrid}.
  428. !
  429. ! !INTERFACE:
  430. subroutine initl_(GGrid, CoordList, CoordSortOrder, descend, WeightList, &
  431. OtherList, IndexList, lsize )
  432. !
  433. ! !USES:
  434. !
  435. use m_stdio
  436. use m_die
  437. use m_List, only : List
  438. use m_List, only : List_init => init
  439. use m_List, only : List_allocated => allocated
  440. use m_List, only : List_nitem => nitem
  441. use m_List, only : List_shared => GetSharedListIndices
  442. use m_List, only : List_append => append
  443. use m_List, only : List_copy => copy
  444. use m_List, only : List_nullify => nullify
  445. use m_List, only : List_clean => clean
  446. use m_AttrVect, only : AttrVect
  447. use m_AttrVect, only : AttrVect_init => init
  448. implicit none
  449. ! !INPUT PARAMETERS:
  450. !
  451. Type(List), intent(in) :: CoordList
  452. Type(List), optional, intent(in) :: CoordSortOrder
  453. Type(List), optional, intent(in) :: WeightList
  454. logical, dimension(:), optional, pointer :: descend
  455. Type(List), optional, intent(in) :: OtherList
  456. Type(List), optional, intent(in) :: IndexList
  457. integer, optional, intent(in) :: lsize
  458. ! !OUTPUT PARAMETERS:
  459. !
  460. type(GeneralGrid), intent(out) :: GGrid
  461. ! !REVISION HISTORY:
  462. ! 10May01 - Jay Larson <larson@mcs.anl.gov> - initial version
  463. ! 8Aug01 - E.T. Ong <eong@mcs.anl.gov> - changed list assignment(=)
  464. ! to list copy to avoid compiler bugs with pgf90
  465. ! 17Jul02 - E. Ong <eong@mcs.anl.gov> - general revision;
  466. ! added error checks
  467. ! 5Aug02 - E. Ong <eong@mcs.anl.gov> - made input argument
  468. ! CoordSortOrder optional to allow for user-defined
  469. ! grid numbering schemes
  470. !EOP ___________________________________________________________________
  471. !
  472. character(len=*),parameter :: myname_=myname//'::initl_'
  473. ! List to store real and integer attributes
  474. type(List) :: RAList, IAList
  475. ! Overlapping attribute index storage arrays:
  476. integer, dimension(:), pointer :: &
  477. CoordListIndices, CoordSortOrderIndices
  478. ! Temporary vars
  479. integer :: NumShared, nitems, i, l, ierr
  480. ! Let's begin by nullifying everything:
  481. call List_nullify(GGrid%coordinate_list)
  482. call List_nullify(GGrid%coordinate_sort_order)
  483. call List_nullify(GGrid%weight_list)
  484. call List_nullify(GGrid%other_list)
  485. call List_nullify(GGrid%index_list)
  486. nullify(GGrid%descend)
  487. ! Check the arguments:
  488. nitems = List_nitem(CoordList)
  489. ! Check the number of coordinates
  490. if(nitems <= 0) then
  491. write(stderr,*) myname_, &
  492. ':: ERROR CoordList is empty!'
  493. call die(myname_,'List_nitem(CoordList) <= 0',nitems)
  494. endif
  495. ! Check the items in the coordinate list and the
  496. ! coordinate grid sort keys...they should contain
  497. ! the same items.
  498. if(present(CoordSortOrder)) then
  499. call List_shared(CoordList,CoordSortOrder,NumShared, &
  500. CoordListIndices,CoordSortOrderIndices)
  501. deallocate(CoordListIndices,CoordSortOrderIndices,stat=ierr)
  502. if(ierr/=0) call die(myname_,'deallocate(CoordListIndices..)',ierr)
  503. if(NumShared /= nitems) then
  504. call die(myname_,'CoordSortOrder must have the same items &
  505. & as CoordList',abs(nitems-NumShared))
  506. endif
  507. endif
  508. ! If the LOGICAL argument descend is present, check the
  509. ! number of entries to ensure they match the grid dimensionality.
  510. ! If descend is not present, assume all coordinate grid point
  511. ! sortings will be in ascending order.
  512. if(present(descend)) then
  513. if( ( (.not.associated(descend)) .or. &
  514. (.not.present(CoordSortOrder)) ) .or. &
  515. (size(descend) /= nitems) ) then
  516. write(stderr,*) myname_, &
  517. ':: ERROR using descend argument, &
  518. &associated(descend) = ', associated(descend), &
  519. ' present(CoordSortOrder) = ', present(CoordSortOrder), &
  520. ' size(descend) = ', size(descend), &
  521. ' List_nitem(CoordSortOrder) = ', &
  522. List_nitem(CoordSortOrder)
  523. call die(myname_, 'ERROR using -descend- argument; &
  524. &stderr file for details')
  525. endif
  526. endif
  527. ! Initialize GGrid%descend from descend(:), if present. If
  528. ! the argument descend(:) was not passed, set GGrid%descend
  529. ! to the default .false.
  530. if(present(CoordSortOrder)) then
  531. allocate(GGrid%descend(nitems), stat=ierr)
  532. if(ierr /= 0) call die(myname_,"allocate GGrid%descend...",ierr)
  533. if(present(descend)) then
  534. do i=1,nitems
  535. GGrid%descend(i) = descend(i)
  536. enddo
  537. else
  538. do i=1,nitems
  539. GGrid%descend(i) = .FALSE.
  540. enddo
  541. endif
  542. endif
  543. ! Process input lists and create the appropriate GeneralGrid
  544. ! List components
  545. call List_copy(GGrid%coordinate_list,CoordList)
  546. call List_copy(RAList,CoordList)
  547. if(present(CoordSortOrder)) then
  548. if(List_allocated(CoordSortOrder)) then
  549. call List_copy(GGrid%coordinate_sort_order,CoordSortOrder)
  550. else
  551. call die(myname_,"Argument CoortSortOrder not allocated")
  552. endif
  553. endif
  554. ! Concatenate present input Lists to create RAList, and
  555. ! at the same time assign the List components of GGrid
  556. if(present(WeightList)) then
  557. if(List_allocated(WeightList)) then
  558. call List_copy(GGrid%weight_list,WeightList)
  559. call List_append(RAList, WeightList)
  560. else
  561. call die(myname_,"Argument WeightList not allocated")
  562. endif
  563. endif
  564. if(present(OtherList)) then
  565. if(List_allocated(OtherList)) then
  566. call List_copy(GGrid%other_list,OtherList)
  567. call List_append(RAList, OtherList)
  568. else
  569. call die(myname_,"Argument OtherList not allocated")
  570. endif
  571. endif
  572. ! Concatenate present input Lists to create IAList
  573. call List_init(IAList,GlobGridNum)
  574. if(present(IndexList)) then
  575. call List_copy(GGrid%index_list,IndexList)
  576. call List_append(IAList, IndexList)
  577. endif
  578. ! Initialize GGrid%data using IAList, RAList, and lsize (if
  579. ! present).
  580. l = 0
  581. if(present(lsize)) l = lsize
  582. call AttrVect_init(GGrid%data, IAList, RAList, l)
  583. ! Deallocate the temporary variables
  584. call List_clean(IAList)
  585. call List_clean(RAList)
  586. end subroutine initl_
  587. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  588. ! Math and Computer Science Division, Argonne National Laboratory !
  589. !BOP -------------------------------------------------------------------
  590. !
  591. ! !IROUTINE: initgg_ - Create a GeneralGrid from Another
  592. !
  593. ! !DESCRIPTION:
  594. ! The routine {\tt initgg\_()} creates the storage space for grid point
  595. ! coordinates, area/volume weights, and other coordinate data ({\em e.g.},
  596. ! nearest-neighbor coordinates). These data are all copied from the
  597. ! already initialized input {\tt GeneralGrid} argument {\tt iGGrid}. This
  598. ! routine initializes the output {\tt GeneralGrid} argument {\tt oGGrid}
  599. ! with the same {\tt List} data as {\tt iGGrid}, but with storage space
  600. ! for {\tt lsize} gridpoints.
  601. !
  602. ! {\bf N.B.}: Though the attribute lists and gridpoint sorting strategy
  603. ! of {\tt iGGrid} is copied to {\tt oGGrid}, the actual values of the
  604. ! attributes are not.
  605. !
  606. ! {\bf N.B.}: It is assumed that {\tt iGGrid} has been initialized.
  607. !
  608. ! {\bf N.B.}: The output {\tt GeneralGrid} {\tt oGGrid} is dynamically
  609. ! allocated memory. When one no longer needs {\tt oGGrid}, one should
  610. ! release this space by invoking {\tt GeneralGrid\_clean()}.
  611. !
  612. ! !INTERFACE:
  613. subroutine initgg_(oGGrid, iGGrid, lsize)
  614. !
  615. ! !USES:
  616. !
  617. use m_stdio
  618. use m_die
  619. use m_List, only : List
  620. use m_List, only : List_allocated => allocated
  621. use m_List, only : List_copy => copy
  622. use m_List, only : List_nitems => nitem
  623. use m_List, only : List_nullify => nullify
  624. use m_AttrVect, only: AttrVect
  625. use m_AttrVect, only: AttrVect_init => init
  626. implicit none
  627. ! !INPUT PARAMETERS:
  628. !
  629. type(GeneralGrid), intent(in) :: iGGrid
  630. integer, optional, intent(in) :: lsize
  631. ! !OUTPUT PARAMETERS:
  632. !
  633. type(GeneralGrid), intent(out) :: oGGrid
  634. ! !REVISION HISTORY:
  635. ! 2May01 - Jay Larson <larson@mcs.anl.gov> - Initial version.
  636. ! 13Jun01 - Jay Larson <larson@mcs.anl.gov> - Now, undefined List
  637. ! components of the GeneralGrid iGGrid are no longer
  638. ! copied to oGGrid.
  639. ! 8Aug01 - E.T. Ong <eong@mcs.anl.gov> - changed list assignment(=)
  640. ! to list copy to avoid compiler bugs with pgf90
  641. ! 24Jul02 - E.T. Ong <eong@mcs.anl.gov> - updated this init version
  642. ! to correspond with initl_
  643. ! 5Aug02 - E. Ong <eong@mcs.anl.gov> - made input argument
  644. ! CoordSortOrder optional to allow for user-defined
  645. ! grid numbering schemes
  646. !EOP ___________________________________________________________________
  647. !
  648. character(len=*),parameter :: myname_=myname//'::initgg_'
  649. ! Number of grid points, number of grid dimensions
  650. integer :: n, ncoord, norder
  651. ! Loop index and Error Flag
  652. integer :: i, ierr
  653. ! Start by nullifying everything:
  654. call List_nullify(oGGrid%coordinate_list)
  655. call List_nullify(oGGrid%coordinate_sort_order)
  656. call List_nullify(oGGrid%weight_list)
  657. call List_nullify(oGGrid%other_list)
  658. call List_nullify(oGGrid%index_list)
  659. nullify(oGGrid%descend)
  660. ! Brief argument check:
  661. ncoord = dims_(iGGrid) ! dimensionality of the GeneralGrid
  662. if(associated(iGGrid%descend)) then
  663. if(size(iGGrid%descend) /= ncoord) then ! size mismatch
  664. call die(myname_,"size(iGGrid%descend) must equal ncoord, &
  665. & size(iGGrid%descend) = ", size(iGGrid%descend), &
  666. "ncoord = ", ncoord )
  667. endif
  668. endif
  669. ! If iGGrid%descend has been allocated, copy its contents;
  670. ! allocate and fill oGGrid%descend
  671. if(associated(iGGrid%descend)) then
  672. allocate(oGGrid%descend(ncoord), stat=ierr)
  673. if(ierr /= 0) then
  674. call die(myname_,"allocate(oGGrid%descend...", ierr)
  675. endif
  676. do i=1,ncoord
  677. oGGrid%descend(i) = iGGrid%descend(i)
  678. end do
  679. endif
  680. ! Copy list data from iGGrid to oGGrid.
  681. call List_copy(oGGrid%coordinate_list,iGGrid%coordinate_list)
  682. if(List_allocated(iGGrid%coordinate_sort_order)) then
  683. call List_copy(oGGrid%coordinate_sort_order,iGGrid%coordinate_sort_order)
  684. endif
  685. if(List_allocated(iGGrid%weight_list)) then
  686. call List_copy(oGGrid%weight_list,iGGrid%weight_list)
  687. endif
  688. if(List_allocated(iGGrid%other_list)) then
  689. call List_copy(oGGrid%other_list,iGGrid%other_list)
  690. endif
  691. if(List_allocated(iGGrid%index_list)) then
  692. call List_copy(oGGrid%index_list,iGGrid%index_list)
  693. endif
  694. ! if lsize is present, use it to set n; if not, set n=0
  695. n = 0
  696. if(present(lsize)) n=lsize
  697. ! Now, initialize oGGrid%data from iGGrid%data, but
  698. ! with length n.
  699. call AttrVect_init(oGGrid%data, iGGrid%data, n)
  700. end subroutine initgg_
  701. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  702. ! Math and Computer Science Division, Argonne National Laboratory !
  703. !BOP -------------------------------------------------------------------
  704. !
  705. ! !IROUTINE: initCartesianSP_ - Initialize a Cartesian GeneralGrid
  706. !
  707. ! !DESCRIPTION:
  708. ! The routine {\tt initCartesian\_()} creates the storage space for grid point
  709. ! coordinates, area and volume weights, and other coordinate data ({\em e.g.},
  710. ! cell area and volume weights). The names of the Cartesian axes are supplied
  711. ! by the user as a colon-delimitted string in the input {\tt CHARACTER}
  712. ! argument {\tt CoordChars}. For example, a Cartesian grid for Euclidian
  713. ! 3-space would have ${\tt CoordChars} = {\tt 'x:y:z'}$. The user can
  714. ! define named real attributes for spatial weighting data in the input
  715. ! {\tt CHARACTER} argument {\tt WeightChars}. For example, one could
  716. ! define attributes for Euclidean 3-space length elements by setting
  717. ! ${\tt WeightChars} = {\tt 'dx:dy:dz'}$. The input {\tt CHARCTER}
  718. ! argument {\tt OtherChars} provides space for defining other real
  719. ! attributes (again as a colon-delimited string of attribute names).
  720. ! One can define integer attributes by supplying a colon-delimitted
  721. ! string of names in the input {\tt CHARACTER} argument
  722. ! {\tt IndexChars}. For example, on could set aside storage space
  723. ! for the {\tt x}-, {\tt y}-, and {\tt z}-indices by setting
  724. ! ${\tt IndexChars} = {\tt 'xIndex:yIndex:zIndex'}$.
  725. !
  726. ! Once the storage space in {\tt GGrid} is initialized, The gridpoint
  727. ! coordinates are evaluated using the input arguments {\tt Dims} (the
  728. ! number of points on each coordinate axis) and {\tt AxisData} (the
  729. ! coordinate values on all of the points of all of the axes). The user
  730. ! presents the axes with each axis stored in a column of {\tt AxisData},
  731. ! and the axes are laid out in the same order as the ordering of the
  732. ! axis names in {\tt CoordChars}. The number of points on each axis
  733. ! is defined by the entries of the input {\tt INTEGER} array
  734. ! {\tt Dims(:)}. Continuing with the Euclidean 3-space example given
  735. ! above, setting ${\tt Dims(1:3)} = {\tt (256, 256, 128)}$ will result
  736. ! in a Cartesian grid with 256 points in the {\tt x}- and {\tt y}-directions,
  737. ! and 128 points in the {\tt z}-direction. Thus the appropriate dimensions
  738. ! of {\tt AxisData} are 256 rows (the maximum number of axis points among
  739. ! all the axes) by 3 columns (the number of physical dimensions). The
  740. ! {\tt x}-axis points are stored in {\tt AxisData(1:256,1)}, the
  741. ! {\tt y}-axis points are stored in {\tt AxisData(1:256,2)}, and the
  742. ! {\tt z}-axis points are stored in {\tt AxisData(1:128,3)}.
  743. !
  744. ! The sorting order of the gridpoints can be either user-defined, or
  745. ! set automatically by MCT. If the latter is desired, the user must
  746. ! supply the argument {\tt CoordSortOrder}, which defines the
  747. ! lexicographic ordering (by coordinate). The entries optional input
  748. ! {\tt LOGICAL} array {\tt descend(:)} stipulates whether the ordering
  749. ! with respect to the corresponding key in {\tt CoordChars} is to be
  750. ! {\em descending}. If {\tt CoordChars} is supplied, but {\tt descend(:)}
  751. ! is not, the gridpoint information is placed in {\em ascending} order
  752. ! for each key. Returning to our Euclidian 3-space example, a choice of
  753. ! ${\tt CoordSortOrder} = {\tt y:x:z}$ and ${\tt descend(1:3)} =
  754. ! ({\tt .TRUE.}, {\tt .FALSE.}, {\tt .FALSE.})$ will result in the entries of
  755. ! {\tt GGrid} being orderd lexicographically by {\tt y} (in descending
  756. ! order), {\tt x} (in ascending order), and {\tt z} (in ascending order).
  757. ! Regardless of the gridpoint sorting strategy, MCT will number each of
  758. ! the gridpoints in {\tt GGrid}, storing this information in the integer
  759. ! attribute named {\tt 'GlobGridNum'}.
  760. !
  761. ! !INTERFACE:
  762. subroutine initCartesianSP_(GGrid, CoordChars, CoordSortOrder, descend, &
  763. WeightChars, OtherChars, IndexChars, Dims, &
  764. AxisData)
  765. !
  766. ! !USES:
  767. !
  768. use m_stdio
  769. use m_die
  770. use m_realkinds, only : SP
  771. use m_String, only : String
  772. use m_String, only : String_ToChar => ToChar
  773. use m_String, only : String_clean => clean
  774. use m_List, only : List
  775. use m_List, only : List_init => init
  776. use m_List, only : List_clean => clean
  777. use m_List, only : List_nullify => nullify
  778. use m_List, only : List_append => append
  779. use m_List, only : List_nitem => nitem
  780. use m_List, only : List_get => get
  781. use m_List, only : List_shared => GetSharedListIndices
  782. use m_AttrVect, only : AttrVect
  783. use m_AttrVect, only : AttrVect_init => init
  784. use m_AttrVect, only : AttrVect_zero => zero
  785. implicit none
  786. ! !INPUT PARAMETERS:
  787. !
  788. character(len=*), intent(in) :: CoordChars
  789. character(len=*), optional, intent(in) :: CoordSortOrder
  790. character(len=*), optional, intent(in) :: WeightChars
  791. logical, dimension(:), optional, pointer :: descend
  792. character(len=*), optional, intent(in) :: OtherChars
  793. character(len=*), optional, intent(in) :: IndexChars
  794. integer, dimension(:), pointer :: Dims
  795. real(SP), dimension(:,:), pointer :: AxisData
  796. ! !OUTPUT PARAMETERS:
  797. !
  798. type(GeneralGrid), intent(out) :: GGrid
  799. ! !REVISION HISTORY:
  800. ! 7Jun01 - Jay Larson <larson@mcs.anl.gov> - API Specification.
  801. ! 12Aug02 - Jay Larson <larson@mcs.anl.gov> - Implementation.
  802. !EOP ___________________________________________________________________
  803. !
  804. character(len=*),parameter :: myname_=myname//'::initCartesianSP_'
  805. type(List) :: IAList, RAList
  806. type(String) :: AxisName
  807. integer, dimension(:), pointer :: &
  808. CoordListIndices, CoordSortOrderIndices
  809. integer :: DimMax, NumDims, NumGridPoints, NumShared
  810. integer :: ierr, iAxis, i, j, k, n, nCycles, nRepeat
  811. integer :: index
  812. ! Nullify GeneralGrid components
  813. call List_nullify(GGrid%coordinate_list)
  814. call List_nullify(GGrid%coordinate_sort_order)
  815. call List_nullify(GGrid%weight_list)
  816. call List_nullify(GGrid%other_list)
  817. call List_nullify(GGrid%index_list)
  818. nullify(GGrid%descend)
  819. ! Sanity check on axis definition arguments:
  820. ! Ensure each axis has a positive number of points, and
  821. ! determine DimMax, the maximum entry in Dims(:).
  822. DimMax = 1
  823. do i=1,size(Dims)
  824. if(Dims(i) > DimMax) DimMax = Dims(i)
  825. if(Dims(i) <= 0) then
  826. write(stderr,'(2a,i8,a,i8)') myname_, &
  827. ':: FATAL--illegal number of axis points in Dims(',i,') = ', &
  828. Dims(i)
  829. call die(myname_)
  830. endif
  831. end do
  832. ! Are the definitions of Dims(:) and AxisData(:,:) compatible?
  833. ! The number of elements in Dims(:) should match the number of
  834. ! columns in AxisData(:,:), and the maximum value stored in Dims(:)
  835. ! (DimMax determined above in this routine) must not exceed the
  836. ! number of rows in AxisData(:,:).
  837. if(size(AxisData,2) /= size(Dims)) then
  838. write(stderr,'(4a,i8,a,i8)') myname_, &
  839. ':: FATAL-- The number of axes (elements) referenced in Dims(:) ', &
  840. 'does not equal the number of columns in AxisData(:,:). ', &
  841. 'size(Dims) = ',size(Dims),' size(AxisData,2) = ',size(AxisData,2)
  842. call die(myname_)
  843. endif
  844. if(size(AxisData,1) < DimMax) then
  845. write(stderr,'(4a,i8,a,i8)') myname_, &
  846. ':: FATAL-- Maximum number of axis points max(Dims) is ', &
  847. 'greater than the number of rows in AxisData(:,:). ', &
  848. 'max(Dims) = ',DimMax,' size(AxisData,1) = ',size(AxisData,1)
  849. call die(myname_)
  850. endif
  851. ! If the LOGICAL descend(:) flags for sorting are present,
  852. ! make sure that (1) descend is associated, and
  853. ! (2) CoordSortOrder is also present, and
  854. ! (3) The size of descend(:) matches the size of Dims(:),
  855. ! both of which correspond to the number of axes on the
  856. ! Cartesian Grid.
  857. if(present(descend)) then
  858. if(.not.associated(descend)) then
  859. call die(myname_,'descend argument must be associated')
  860. endif
  861. if(.not. present(CoordSortOrder)) then
  862. write(stderr,'(4a)') myname_, &
  863. ':: FATAL -- Invocation with the argument descend(:) present ', &
  864. 'requires the presence of the argument CoordSortOrder, ', &
  865. 'which was not provided.'
  866. call die(myname_, 'Argument CoordSortOrder was not provided')
  867. endif
  868. if(size(descend) /= size(Dims)) then
  869. write(stderr,'(4a,i8,a,i8)') myname_, &
  870. ':: FATAL-- The sizes of the arrays descend(:) and Dims(:) ', &
  871. 'must match (they both must equal the number of dimensions ', &
  872. 'of the Cartesian Grid). size(Dims) = ',size(Dims), &
  873. ' size(descend) = ',size(descend)
  874. call die(myname_,'size of <descend> and <Dims> arguments must match')
  875. endif
  876. endif
  877. ! Initialize GGrid%coordinate_list and use the number of items
  878. ! in it to set the number of dimensions of the Cartesian
  879. ! Grid (NumDims):
  880. call List_init(GGrid%coordinate_list, CoordChars)
  881. NumDims = List_nitem(GGrid%coordinate_list)
  882. ! Check the number of arguments
  883. if(NumDims <= 0) then
  884. write(stderr,*) myname_, &
  885. ':: ERROR CoordList is empty!'
  886. call die(myname_,'List_nitem(CoordList) <= 0',NumDims)
  887. endif
  888. ! Do the number of coordinate names specified match the number
  889. ! of coordinate axes (i.e., the number of columns in AxisData(:,:))?
  890. if(NumDims /= size(AxisData,2)) then
  891. write(stderr,'(6a,i8,a,i8)') myname_, &
  892. ':: FATAL-- Number of axes specified in argument CoordChars ', &
  893. 'does not equal the number of axes stored in AxisData(:,:). ', &
  894. 'CoordChars = ', CoordChars, &
  895. 'Number of axes = ',NumDims, &
  896. ' size(AxisData,2) = ',size(AxisData,2)
  897. call die(myname_)
  898. endif
  899. ! End of argument sanity checks.
  900. ! Create other List components of GGrid and build REAL
  901. ! and INTEGER attribute lists for the AttrVect GGrid%data
  902. ! Start off with things *guaranteed* to be in IAList and RAList.
  903. ! The variable GlobGridNum is a CHARACTER parameter inherited
  904. ! from the declaration section of this module.
  905. call List_init(IAList, GlobGridNum)
  906. call List_init(RAList, CoordChars)
  907. if(present(CoordSortOrder)) then
  908. call List_init(GGrid%coordinate_sort_order, CoordSortOrder)
  909. ! Check the items in the coordinate list and the
  910. ! coordinate grid sort keys...they should contain
  911. ! the same items.
  912. call List_shared(GGrid%coordinate_list,GGrid%coordinate_sort_order, &
  913. NumShared,CoordListIndices,CoordSortOrderIndices)
  914. deallocate(CoordListIndices,CoordSortOrderIndices,stat=ierr)
  915. if(ierr/=0) call die(myname_,'deallocate(CoordListIndices..)',ierr)
  916. if(NumShared /= NumDims) then
  917. call die(myname_,'CoordSortOrder must have the same items &
  918. & as CoordList',abs(NumDims-NumShared))
  919. endif
  920. endif
  921. if(present(WeightChars)) then
  922. call List_init(GGrid%weight_list, WeightChars)
  923. call List_append(RAList, GGrid%weight_list)
  924. endif
  925. if(present(OtherChars)) then
  926. call List_init(GGrid%other_list, OtherChars)
  927. call List_append(RAList, GGrid%other_list)
  928. endif
  929. if(present(IndexChars)) then
  930. call List_init(GGrid%index_list, IndexChars)
  931. call List_append(IAList, GGrid%index_list)
  932. endif
  933. ! Finally, Initialize GGrid%descend from descend(:).
  934. ! If descend argument is not present, set it to the default .false.
  935. if(present(CoordSortOrder)) then
  936. allocate(GGrid%descend(NumDims), stat=ierr)
  937. if(ierr /= 0) call die(myname_,"allocate GGrid%descend...",ierr)
  938. if(present(descend)) then
  939. do n=1,NumDims
  940. GGrid%descend(n) = descend(n)
  941. end do
  942. else
  943. do n=1,NumDims
  944. GGrid%descend(n) = .FALSE.
  945. end do
  946. endif
  947. endif ! if(present(CoordSortOrder))...
  948. ! Compute the total number of grid points in the GeneralGrid.
  949. ! This is merely the product of the elements of Dims(:)
  950. NumGridPoints = 1
  951. do i=1,NumDims
  952. NumGridPoints = NumGridPoints * Dims(i)
  953. end do
  954. ! Now we are prepared to create GGrid%data:
  955. call AttrVect_init(GGrid%data, IAList, RAList, NumGridPoints)
  956. call AttrVect_zero(GGrid%data)
  957. ! Now, store Cartesian gridpoint data, in the order
  958. ! defined by how the user laid out AxisData(:,:)
  959. do n=1,NumDims
  960. ! Retrieve first coordinate axis name from GGrid%coordinate_list
  961. ! (as a String)
  962. call List_get(AxisName, n, GGrid%coordinate_list)
  963. ! Index this real attribute of GGrid
  964. iAxis = indexRA_(GGrid, String_ToChar(AxisName))
  965. if(iAxis <= 0) then
  966. write(stderr,'(4a)') myname_, &
  967. ':: REAL Attribute "',String_ToChar(AxisName),'" not found.'
  968. call die(myname_)
  969. endif
  970. ! Now, clear the String AxisName for use in the next
  971. ! cycle of this loop:
  972. call String_clean(AxisName)
  973. ! Compute the number of times we cycle through the axis
  974. ! values (nCycles), and the number of times each axis
  975. ! value is repeated in each cycle (nRepeat)
  976. nCycles = 1
  977. if(n > 1) then
  978. do i=1,n-1
  979. nCycles = nCycles * Dims(i)
  980. end do
  981. endif
  982. nRepeat = 1
  983. if(n < NumDims) then
  984. do i=n+1,NumDims
  985. nRepeat = nRepeat * Dims(i)
  986. end do
  987. endif
  988. ! Loop over the number of cycles for which we run through
  989. ! all the axis points. Within each cycle, loop over all
  990. ! of the axis points, repeating each value nRepeat times.
  991. ! This produces a set of grid entries that are in
  992. ! lexicographic order with respect to how the axes are
  993. ! presented to this routine.
  994. index = 1
  995. do i=1,nCycles
  996. do j=1,Dims(n)
  997. do k=1,nRepeat
  998. GGrid%data%rAttr(iAxis,index) = AxisData(j,n)
  999. index = index+1
  1000. end do ! do k=1,nRepeat
  1001. end do ! do j=1,Dims(n)
  1002. end do ! do i=1,nCycles
  1003. end do ! do n=1,NumDims...
  1004. ! If the argument CoordSortOrder was supplied, the entries
  1005. ! of GGrid will be sorted/permuted with this lexicographic
  1006. ! ordering, and the values of the GGrid INTEGER attribute
  1007. ! GlobGridNum will be numbered to reflect this new ordering
  1008. ! scheme.
  1009. index = indexIA_(GGrid, GlobGridNum)
  1010. if(present(CoordSortOrder)) then ! Sort permute entries before
  1011. ! numbering them
  1012. call SortPermute_(GGrid) ! Sort / permute
  1013. endif ! if(present(CoordSortOrder))...
  1014. ! Number the gridpoints based on the AttrVect point index
  1015. ! (i.e., the second index in GGrid%data%iAttr)
  1016. do i=1, lsize_(GGrid)
  1017. GGrid%data%iAttr(index,i) = i
  1018. end do
  1019. ! Finally, clean up intermediate Lists
  1020. call List_clean(IAList)
  1021. call List_clean(RAList)
  1022. end subroutine initCartesianSP_
  1023. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1024. ! Math and Computer Science Division, Argonne National Laboratory !
  1025. ! ----------------------------------------------------------------------
  1026. !
  1027. ! !IROUTINE: initCartesianDP_ - Initialize a Cartesian GeneralGrid
  1028. !
  1029. ! !DESCRIPTION:
  1030. ! Double Precision version of initCartesianSP_
  1031. !
  1032. ! !INTERFACE:
  1033. subroutine initCartesianDP_(GGrid, CoordChars, CoordSortOrder, descend, &
  1034. WeightChars, OtherChars, IndexChars, Dims, &
  1035. AxisData)
  1036. !
  1037. ! !USES:
  1038. !
  1039. use m_stdio
  1040. use m_die
  1041. use m_realkinds, only : DP
  1042. use m_String, only : String
  1043. use m_String, only : String_ToChar => ToChar
  1044. use m_String, only : String_clean => clean
  1045. use m_List, only : List
  1046. use m_List, only : List_init => init
  1047. use m_List, only : List_clean => clean
  1048. use m_List, only : List_nullify => nullify
  1049. use m_List, only : List_append => append
  1050. use m_List, only : List_nitem => nitem
  1051. use m_List, only : List_get => get
  1052. use m_List, only : List_shared => GetSharedListIndices
  1053. use m_AttrVect, only : AttrVect
  1054. use m_AttrVect, only : AttrVect_init => init
  1055. use m_AttrVect, only : AttrVect_zero => zero
  1056. implicit none
  1057. ! !INPUT PARAMETERS:
  1058. !
  1059. character(len=*), intent(in) :: CoordChars
  1060. character(len=*), optional, intent(in) :: CoordSortOrder
  1061. character(len=*), optional, intent(in) :: WeightChars
  1062. logical, dimension(:), optional, pointer :: descend
  1063. character(len=*), optional, intent(in) :: OtherChars
  1064. character(len=*), optional, intent(in) :: IndexChars
  1065. integer, dimension(:), pointer :: Dims
  1066. real(DP), dimension(:,:), pointer :: AxisData
  1067. ! !OUTPUT PARAMETERS:
  1068. !
  1069. type(GeneralGrid), intent(out) :: GGrid
  1070. ! !REVISION HISTORY:
  1071. ! 7Jun01 - Jay Larson <larson@mcs.anl.gov> - API Specification.
  1072. ! 12Aug02 - Jay Larson <larson@mcs.anl.gov> - Implementation.
  1073. ! ______________________________________________________________________
  1074. !
  1075. character(len=*),parameter :: myname_=myname//'::initCartesianDP_'
  1076. type(List) :: IAList, RAList
  1077. type(String) :: AxisName
  1078. integer, dimension(:), pointer :: &
  1079. CoordListIndices, CoordSortOrderIndices
  1080. integer :: DimMax, NumDims, NumGridPoints, NumShared
  1081. integer :: ierr, iAxis, i, j, k, n, nCycles, nRepeat
  1082. integer :: index
  1083. ! Nullify GeneralGrid components
  1084. call List_nullify(GGrid%coordinate_list)
  1085. call List_nullify(GGrid%coordinate_sort_order)
  1086. call List_nullify(GGrid%weight_list)
  1087. call List_nullify(GGrid%other_list)
  1088. call List_nullify(GGrid%index_list)
  1089. nullify(GGrid%descend)
  1090. ! Sanity check on axis definition arguments:
  1091. ! Ensure each axis has a positive number of points, and
  1092. ! determine DimMax, the maximum entry in Dims(:).
  1093. DimMax = 1
  1094. do i=1,size(Dims)
  1095. if(Dims(i) > DimMax) DimMax = Dims(i)
  1096. if(Dims(i) <= 0) then
  1097. write(stderr,'(2a,i8,a,i8)') myname_, &
  1098. ':: FATAL--illegal number of axis points in Dims(',i,') = ', &
  1099. Dims(i)
  1100. call die(myname_)
  1101. endif
  1102. end do
  1103. ! Are the definitions of Dims(:) and AxisData(:,:) compatible?
  1104. ! The number of elements in Dims(:) should match the number of
  1105. ! columns in AxisData(:,:), and the maximum value stored in Dims(:)
  1106. ! (DimMax determined above in this routine) must not exceed the
  1107. ! number of rows in AxisData(:,:).
  1108. if(size(AxisData,2) /= size(Dims)) then
  1109. write(stderr,'(4a,i8,a,i8)') myname_, &
  1110. ':: FATAL-- The number of axes (elements) referenced in Dims(:) ', &
  1111. 'does not equal the number of columns in AxisData(:,:). ', &
  1112. 'size(Dims) = ',size(Dims),' size(AxisData,2) = ',size(AxisData,2)
  1113. call die(myname_)
  1114. endif
  1115. if(size(AxisData,1) < DimMax) then
  1116. write(stderr,'(4a,i8,a,i8)') myname_, &
  1117. ':: FATAL-- Maximum number of axis points max(Dims) is ', &
  1118. 'greater than the number of rows in AxisData(:,:). ', &
  1119. 'max(Dims) = ',DimMax,' size(AxisData,1) = ',size(AxisData,1)
  1120. call die(myname_)
  1121. endif
  1122. ! If the LOGICAL descend(:) flags for sorting are present,
  1123. ! make sure that (1) descend is associated, and
  1124. ! (2) CoordSortOrder is also present, and
  1125. ! (3) The size of descend(:) matches the size of Dims(:),
  1126. ! both of which correspond to the number of axes on the
  1127. ! Cartesian Grid.
  1128. if(present(descend)) then
  1129. if(.not.associated(descend)) then
  1130. call die(myname_,'descend argument must be associated')
  1131. endif
  1132. if(.not. present(CoordSortOrder)) then
  1133. write(stderr,'(4a)') myname_, &
  1134. ':: FATAL -- Invocation with the argument descend(:) present ', &
  1135. 'requires the presence of the argument CoordSortOrder, ', &
  1136. 'which was not provided.'
  1137. call die(myname_, 'Argument CoordSortOrder was not provided')
  1138. endif
  1139. if(size(descend) /= size(Dims)) then
  1140. write(stderr,'(4a,i8,a,i8)') myname_, &
  1141. ':: FATAL-- The sizes of the arrays descend(:) and Dims(:) ', &
  1142. 'must match (they both must equal the number of dimensions ', &
  1143. 'of the Cartesian Grid). size(Dims) = ',size(Dims), &
  1144. ' size(descend) = ',size(descend)
  1145. call die(myname_,'size of <descend> and <Dims> arguments must match')
  1146. endif
  1147. endif
  1148. ! Initialize GGrid%coordinate_list and use the number of items
  1149. ! in it to set the number of dimensions of the Cartesian
  1150. ! Grid (NumDims):
  1151. call List_init(GGrid%coordinate_list, CoordChars)
  1152. NumDims = List_nitem(GGrid%coordinate_list)
  1153. ! Check the number of arguments
  1154. if(NumDims <= 0) then
  1155. write(stderr,*) myname_, &
  1156. ':: ERROR CoordList is empty!'
  1157. call die(myname_,'List_nitem(CoordList) <= 0',NumDims)
  1158. endif
  1159. ! Do the number of coordinate names specified match the number
  1160. ! of coordinate axes (i.e., the number of columns in AxisData(:,:))?
  1161. if(NumDims /= size(AxisData,2)) then
  1162. write(stderr,'(6a,i8,a,i8)') myname_, &
  1163. ':: FATAL-- Number of axes specified in argument CoordChars ', &
  1164. 'does not equal the number of axes stored in AxisData(:,:). ', &
  1165. 'CoordChars = ', CoordChars, &
  1166. 'Number of axes = ',NumDims, &
  1167. ' size(AxisData,2) = ',size(AxisData,2)
  1168. call die(myname_)
  1169. endif
  1170. ! End of argument sanity checks.
  1171. ! Create other List components of GGrid and build REAL
  1172. ! and INTEGER attribute lists for the AttrVect GGrid%data
  1173. ! Start off with things *guaranteed* to be in IAList and RAList.
  1174. ! The variable GlobGridNum is a CHARACTER parameter inherited
  1175. ! from the declaration section of this module.
  1176. call List_init(IAList, GlobGridNum)
  1177. call List_init(RAList, CoordChars)
  1178. if(present(CoordSortOrder)) then
  1179. call List_init(GGrid%coordinate_sort_order, CoordSortOrder)
  1180. ! Check the items in the coordinate list and the
  1181. ! coordinate grid sort keys...they should contain
  1182. ! the same items.
  1183. call List_shared(GGrid%coordinate_list,GGrid%coordinate_sort_order, &
  1184. NumShared,CoordListIndices,CoordSortOrderIndices)
  1185. deallocate(CoordListIndices,CoordSortOrderIndices,stat=ierr)
  1186. if(ierr/=0) call die(myname_,'deallocate(CoordListIndices..)',ierr)
  1187. if(NumShared /= NumDims) then
  1188. call die(myname_,'CoordSortOrder must have the same items &
  1189. & as CoordList',abs(NumDims-NumShared))
  1190. endif
  1191. endif
  1192. if(present(WeightChars)) then
  1193. call List_init(GGrid%weight_list, WeightChars)
  1194. call List_append(RAList, GGrid%weight_list)
  1195. endif
  1196. if(present(OtherChars)) then
  1197. call List_init(GGrid%other_list, OtherChars)
  1198. call List_append(RAList, GGrid%other_list)
  1199. endif
  1200. if(present(IndexChars)) then
  1201. call List_init(GGrid%index_list, IndexChars)
  1202. call List_append(IAList, GGrid%index_list)
  1203. endif
  1204. ! Finally, Initialize GGrid%descend from descend(:).
  1205. ! If descend argument is not present, set it to the default .false.
  1206. if(present(CoordSortOrder)) then
  1207. allocate(GGrid%descend(NumDims), stat=ierr)
  1208. if(ierr /= 0) call die(myname_,"allocate GGrid%descend...",ierr)
  1209. if(present(descend)) then
  1210. do n=1,NumDims
  1211. GGrid%descend(n) = descend(n)
  1212. end do
  1213. else
  1214. do n=1,NumDims
  1215. GGrid%descend(n) = .FALSE.
  1216. end do
  1217. endif
  1218. endif ! if(present(CoordSortOrder))...
  1219. ! Compute the total number of grid points in the GeneralGrid.
  1220. ! This is merely the product of the elements of Dims(:)
  1221. NumGridPoints = 1
  1222. do i=1,NumDims
  1223. NumGridPoints = NumGridPoints * Dims(i)
  1224. end do
  1225. ! Now we are prepared to create GGrid%data:
  1226. call AttrVect_init(GGrid%data, IAList, RAList, NumGridPoints)
  1227. call AttrVect_zero(GGrid%data)
  1228. ! Now, store Cartesian gridpoint data, in the order
  1229. ! defined by how the user laid out AxisData(:,:)
  1230. do n=1,NumDims
  1231. ! Retrieve first coordinate axis name from GGrid%coordinate_list
  1232. ! (as a String)
  1233. call List_get(AxisName, n, GGrid%coordinate_list)
  1234. ! Index this real attribute of GGrid
  1235. iAxis = indexRA_(GGrid, String_ToChar(AxisName))
  1236. if(iAxis <= 0) then
  1237. write(stderr,'(4a)') myname_, &
  1238. ':: REAL Attribute "',String_ToChar(AxisName),'" not found.'
  1239. call die(myname_)
  1240. endif
  1241. ! Now, clear the String AxisName for use in the next
  1242. ! cycle of this loop:
  1243. call String_clean(AxisName)
  1244. ! Compute the number of times we cycle through the axis
  1245. ! values (nCycles), and the number of times each axis
  1246. ! value is repeated in each cycle (nRepeat)
  1247. nCycles = 1
  1248. if(n > 1) then
  1249. do i=1,n-1
  1250. nCycles = nCycles * Dims(i)
  1251. end do
  1252. endif
  1253. nRepeat = 1
  1254. if(n < NumDims) then
  1255. do i=n+1,NumDims
  1256. nRepeat = nRepeat * Dims(i)
  1257. end do
  1258. endif
  1259. ! Loop over the number of cycles for which we run through
  1260. ! all the axis points. Within each cycle, loop over all
  1261. ! of the axis points, repeating each value nRepeat times.
  1262. ! This produces a set of grid entries that are in
  1263. ! lexicographic order with respect to how the axes are
  1264. ! presented to this routine.
  1265. index = 1
  1266. do i=1,nCycles
  1267. do j=1,Dims(n)
  1268. do k=1,nRepeat
  1269. GGrid%data%rAttr(iAxis,index) = AxisData(j,n)
  1270. index = index+1
  1271. end do ! do k=1,nRepeat
  1272. end do ! do j=1,Dims(n)
  1273. end do ! do i=1,nCycles
  1274. end do ! do n=1,NumDims...
  1275. ! If the argument CoordSortOrder was supplied, the entries
  1276. ! of GGrid will be sorted/permuted with this lexicographic
  1277. ! ordering, and the values of the GGrid INTEGER attribute
  1278. ! GlobGridNum will be numbered to reflect this new ordering
  1279. ! scheme.
  1280. index = indexIA_(GGrid, GlobGridNum)
  1281. if(present(CoordSortOrder)) then ! Sort permute entries before
  1282. ! numbering them
  1283. call SortPermute_(GGrid) ! Sort / permute
  1284. endif ! if(present(CoordSortOrder))...
  1285. ! Number the gridpoints based on the AttrVect point index
  1286. ! (i.e., the second index in GGrid%data%iAttr)
  1287. do i=1, lsize_(GGrid)
  1288. GGrid%data%iAttr(index,i) = i
  1289. end do
  1290. ! Finally, clean up intermediate Lists
  1291. call List_clean(IAList)
  1292. call List_clean(RAList)
  1293. end subroutine initCartesianDP_
  1294. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1295. ! Math and Computer Science Division, Argonne National Laboratory !
  1296. !BOP -------------------------------------------------------------------
  1297. !
  1298. ! !IROUTINE: initUnstructuredSP_ - Initialize an Unstructured GeneralGrid
  1299. !
  1300. ! !DESCRIPTION:
  1301. ! This routine creates the storage space for grid point
  1302. ! coordinates, area/volume weights, and other coordinate data ({\em e.g.},
  1303. ! local cell dimensions), and fills in user-supplied values for the grid
  1304. ! point coordinates. These data are referenced by {\tt List}
  1305. ! components that are also created by this routine (see the documentation
  1306. ! of the declaration section of this module for more details about setting
  1307. ! list information). Each of the input {\tt CHARACTER} arguments is a
  1308. ! colon-delimited string of attribute names, each corrsponding to a
  1309. ! {\tt List} element of the output {\tt GeneralGrid} argument {\tt GGrid},
  1310. ! and are summarized in the table below:
  1311. !
  1312. !\begin{table}[htbp]
  1313. !\begin{center}
  1314. !\begin{tabular}{|l|l|l|l|}
  1315. !\hline
  1316. !{\bf Argument} & {\bf Component of {\tt GGrid}} & {\bf Significance} & {\bf Required?} \\
  1317. !\hline
  1318. !{\tt CoordChars} & {\tt GGrid\%coordinate\_list} & Dimension Names & Yes \\
  1319. !\hline
  1320. !{\tt CoordSortOrder} & {\tt GGrid\%coordinate\_sort\_order} & Grid Point & No \\
  1321. ! & & Sorting Keys & \\
  1322. !\hline
  1323. !{\tt WeightChars} & {\tt GGrid\%weight\_list} & Grid Cell & No \\
  1324. ! & & Length, Area, and & \\
  1325. ! & & Volume Weights & \\
  1326. !\hline
  1327. !{\tt OtherChars} & {\tt GGrid\%other\_list} & All Other & No \\
  1328. ! & & Real Attributes & \\
  1329. !\hline
  1330. !{\tt IndexChars} & {\tt GGrid\%index\_list} & All Other & No \\
  1331. ! & & Integer Attributes & \\
  1332. !\hline
  1333. !\end{tabular}
  1334. !\end{center}
  1335. !\end{table}
  1336. !
  1337. ! The number of physical dimensions of the grid is set by the user in
  1338. ! the input {\tt INTEGER} argument {\tt nDims}, and the number of grid
  1339. ! points stored in {\tt GGrid} is set using the input {\tt INTEGER}
  1340. ! argument {\tt nPoints}. The grid point coordinates are input via the
  1341. ! {\tt REAL} array {\tt PointData(:)}. The number of entries in
  1342. ! {\tt PointData} must equal the product of {\tt nDims} and {\tt nPoints}.
  1343. ! The grid points are grouped in {\tt nPoints} consecutive groups of
  1344. ! {\tt nDims} entries, with the coordinate values for each point set in
  1345. ! the same order as the dimensions are named in the list {\tt CoordChars}.
  1346. !
  1347. ! If a set of sorting keys is supplied in the argument {\tt CoordSortOrder},
  1348. ! the user can control whether the sorting by each key is in descending or
  1349. ! ascending order by supplying the input {\tt LOGICAL} array {\tt descend(:)}.
  1350. ! By default, all sorting is in {\em ascending} order for each key if the
  1351. ! argument {\tt descend} is not provided.
  1352. !
  1353. ! {\bf N.B.}: The output {\tt GeneralGrid} {\tt GGrid} is dynamically
  1354. ! allocated memory. When one no longer needs {\tt GGrid}, one should
  1355. ! release this space by invoking {\tt clean()} for the {\tt GeneralGrid}.
  1356. !
  1357. ! !INTERFACE:
  1358. subroutine initUnstructuredSP_(GGrid, CoordChars, CoordSortOrder, descend, &
  1359. WeightChars, OtherChars, IndexChars, nDims, &
  1360. nPoints, PointData)
  1361. !
  1362. ! !USES:
  1363. !
  1364. use m_stdio
  1365. use m_die
  1366. use m_realkinds,only : SP
  1367. use m_String, only : String, char
  1368. use m_List, only : List
  1369. use m_List, only : List_init => init
  1370. use m_List, only : List_clean => clean
  1371. use m_List, only : List_nitem => nitem
  1372. use m_List, only : List_nullify => nullify
  1373. use m_List, only : List_copy => copy
  1374. use m_List, only : List_append => append
  1375. use m_List, only : List_shared => GetSharedListIndices
  1376. use m_AttrVect, only : AttrVect
  1377. use m_AttrVect, only : AttrVect_init => init
  1378. use m_AttrVect, only : AttrVect_zero => zero
  1379. implicit none
  1380. ! !INPUT PARAMETERS:
  1381. !
  1382. character(len=*), intent(in) :: CoordChars
  1383. character(len=*), optional, intent(in) :: CoordSortOrder
  1384. character(len=*), optional, intent(in) :: WeightChars
  1385. logical, dimension(:), optional, pointer :: descend
  1386. character(len=*), optional, intent(in) :: OtherChars
  1387. character(len=*), optional, intent(in) :: IndexChars
  1388. integer, intent(in) :: nDims
  1389. integer, intent(in) :: nPoints
  1390. real(SP), dimension(:), pointer :: PointData
  1391. ! !OUTPUT PARAMETERS:
  1392. !
  1393. type(GeneralGrid), intent(out) :: GGrid
  1394. ! !REVISION HISTORY:
  1395. ! 7Jun01 - Jay Larson <larson@mcs.anl.gov> - API specification.
  1396. ! 22Aug02 - J. Larson <larson@mcs.anl.gov> - Implementation.
  1397. !EOP ___________________________________________________________________
  1398. !
  1399. character(len=*),parameter :: myname_=myname//'::initUnstructuredSP_'
  1400. integer :: i, ierr, index, n, nOffSet, NumShared
  1401. integer, dimension(:), pointer :: &
  1402. CoordListIndices, CoordSortOrderIndices
  1403. type(List) :: IAList, RAList
  1404. ! Nullify all GeneralGrid components
  1405. call List_nullify(GGrid%coordinate_list)
  1406. call List_nullify(GGrid%coordinate_sort_order)
  1407. call List_nullify(GGrid%weight_list)
  1408. call List_nullify(GGrid%other_list)
  1409. call List_nullify(GGrid%index_list)
  1410. nullify(GGrid%descend)
  1411. ! Sanity checks on input arguments:
  1412. ! If the LOGICAL descend(:) flags for sorting are present,
  1413. ! make sure that (1) it is associated,
  1414. ! (2) CoordSortOrder is also present, and
  1415. ! (3) The size of descend(:) matches the size of Dims(:),
  1416. ! both of which correspond to the number of axes on the
  1417. ! Cartesian Grid.
  1418. if(present(descend)) then
  1419. if(.not.associated(descend)) then
  1420. call die(myname_,'descend argument must be associated')
  1421. endif
  1422. if(.not. present(CoordSortOrder)) then
  1423. write(stderr,'(4a)') myname_, &
  1424. ':: FATAL -- Invocation with the argument descend(:) present ', &
  1425. 'requires the presence of the argument CoordSortOrder, ', &
  1426. 'which was not provided.'
  1427. call die(myname_,'Argument CoordSortOrder was not provided')
  1428. endif
  1429. if(present(descend)) then
  1430. if(size(descend) /= nDims) then
  1431. write(stderr,'(4a,i8,a,i8)') myname_, &
  1432. ':: FATAL-- The size of the array descend(:) and nDims ', &
  1433. 'must be equal (they both must equal the number of dimensions ', &
  1434. 'of the unstructured Grid). nDims = ',nDims, &
  1435. ' size(descend) = ',size(descend)
  1436. call die(myname_,'size(descend)/=nDims')
  1437. endif
  1438. endif
  1439. endif
  1440. ! Initialize GGrid%coordinate_list and comparethe number of items
  1441. ! to the number of dimensions of the unstructured nDims:
  1442. call List_init(GGrid%coordinate_list, CoordChars)
  1443. ! Check the coordinate_list
  1444. if(nDims /= List_nitem(GGrid%coordinate_list)) then
  1445. write(stderr,'(4a,i8,3a,i8)') myname_, &
  1446. ':: FATAL-- The number of coordinate names supplied in the ', &
  1447. 'argument CoordChars must equal the number of dimensions ', &
  1448. 'specified by the argument nDims. nDims = ',nDims, &
  1449. ' CoordChars = ',CoordChars, ' number of dimensions in CoordChars = ', &
  1450. List_nitem(GGrid%coordinate_list)
  1451. call die(myname_)
  1452. endif
  1453. if(nDims <= 0) then
  1454. write(stderr,*) myname_, ':: ERROR nDims=0!'
  1455. call die(myname_,'nDims <= 0',nDims)
  1456. endif
  1457. ! PointData is a one-dimensional array containing all the gridpoint
  1458. ! coordinates. As such, its size must equal nDims * nPoints. True?
  1459. if(size(PointData) /= nDims * nPoints) then
  1460. write(stderr,'(3a,3(a,i8))') myname_, &
  1461. ':: FATAL-- The length of the array PointData(:) must match ', &
  1462. 'the product of the input arguments nDims and nPoints. ', &
  1463. 'nDims = ',nDims, ' nPoints = ',nPoints,&
  1464. ' size(PointData) = ',size(PointData)
  1465. call die(myname_)
  1466. endif
  1467. ! End of input argument sanity checks.
  1468. ! Create other List components of GGrid and build REAL
  1469. ! and INTEGER attribute lists for the AttrVect GGrid%data
  1470. ! Start off with things *guaranteed* to be in IAList and RAList.
  1471. ! The variable GlobGridNum is a CHARACTER parameter inherited
  1472. ! from the declaration section of this module.
  1473. call List_init(IAList, GlobGridNum)
  1474. call List_init(RAList, CoordChars)
  1475. if(present(CoordSortOrder)) then
  1476. call List_init(GGrid%coordinate_sort_order, CoordSortOrder)
  1477. call List_shared(GGrid%coordinate_list,GGrid%coordinate_sort_order, &
  1478. NumShared,CoordListIndices,CoordSortOrderIndices)
  1479. deallocate(CoordListIndices,CoordSortOrderIndices,stat=ierr)
  1480. if(ierr/=0) call die(myname_,'deallocate(CoordListIndices..)',ierr)
  1481. if(NumShared /= nDims) then
  1482. call die(myname_,'CoordSortOrder must have the same items &
  1483. & as CoordList',abs(nDims-NumShared))
  1484. endif
  1485. endif
  1486. if(present(WeightChars)) then
  1487. call List_init(GGrid%weight_list, WeightChars)
  1488. call List_append(RAList, GGrid%weight_list)
  1489. endif
  1490. if(present(OtherChars)) then
  1491. call List_init(GGrid%other_list, OtherChars)
  1492. call List_append(RAList, GGrid%other_list)
  1493. endif
  1494. if(present(IndexChars)) then
  1495. call List_init(GGrid%index_list, IndexChars)
  1496. call List_append(IAList, GGrid%index_list)
  1497. endif
  1498. ! Initialize GGrid%descend from descend(:).
  1499. ! If descend argument is not present, set it to the default .false.
  1500. if(present(CoordSortOrder)) then
  1501. allocate(GGrid%descend(nDims), stat=ierr)
  1502. if(ierr /= 0) call die(myname_,"allocate GGrid%descend...",ierr)
  1503. if(present(descend)) then
  1504. do n=1,nDims
  1505. GGrid%descend(n) = descend(n)
  1506. end do
  1507. else
  1508. do n=1,nDims
  1509. GGrid%descend(n) = .FALSE.
  1510. end do
  1511. endif
  1512. endif ! if(present(CoordSortOrder))...
  1513. ! Create Grid attribute data storage AttrVect GGrid%data:
  1514. call AttrVect_init(GGrid%data, IAList, RAList, nPoints)
  1515. call AttrVect_zero(GGrid%data)
  1516. ! Load up gridpoint coordinate data into GGrid%data.
  1517. ! Given how we've set up the real attributes of GGrid%data,
  1518. ! we have guaranteed the first nDims real attributes are
  1519. ! the gridpoint coordinates.
  1520. do n=1,nPoints
  1521. nOffSet = (n-1) * nDims
  1522. do i=1,nDims
  1523. GGrid%data%rAttr(i,n) = PointData(nOffset + i)
  1524. end do
  1525. end do
  1526. ! If the argument CoordSortOrder was supplied, the entries
  1527. ! of GGrid will be sorted/permuted with this lexicographic
  1528. ! ordering, and the values of the GGrid INTEGER attribute
  1529. ! GlobGridNum will be numbered to reflect this new ordering
  1530. ! scheme.
  1531. index = indexIA_(GGrid, GlobGridNum)
  1532. if(present(CoordSortOrder)) then ! Sort permute entries before
  1533. ! numbering them
  1534. call SortPermute_(GGrid) ! Sort / permute
  1535. endif ! if(present(CoordSortOrder))...
  1536. ! Number the gridpoints based on the AttrVect point index
  1537. ! (i.e., the second index in GGrid%data%iAttr)
  1538. do i=1, lsize_(GGrid)
  1539. GGrid%data%iAttr(index,i) = i
  1540. end do
  1541. ! Clean up temporary allocated structures:
  1542. call List_clean(IAList)
  1543. call List_clean(RAList)
  1544. end subroutine initUnstructuredSP_
  1545. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1546. ! Math and Computer Science Division, Argonne National Laboratory !
  1547. ! ----------------------------------------------------------------------
  1548. !
  1549. ! !IROUTINE: initUnstructuredDP_ - Initialize an Unstructured GeneralGrid
  1550. !
  1551. ! !DESCRIPTION:
  1552. ! Double precision version of initUnstructuredSP_
  1553. !
  1554. ! !INTERFACE:
  1555. subroutine initUnstructuredDP_(GGrid, CoordChars, CoordSortOrder, descend, &
  1556. WeightChars, OtherChars, IndexChars, nDims, &
  1557. nPoints, PointData)
  1558. !
  1559. ! !USES:
  1560. !
  1561. use m_stdio
  1562. use m_die
  1563. use m_realkinds,only : DP
  1564. use m_String, only : String, char
  1565. use m_List, only : List
  1566. use m_List, only : List_init => init
  1567. use m_List, only : List_clean => clean
  1568. use m_List, only : List_nitem => nitem
  1569. use m_List, only : List_nullify => nullify
  1570. use m_List, only : List_copy => copy
  1571. use m_List, only : List_append => append
  1572. use m_List, only : List_shared => GetSharedListIndices
  1573. use m_AttrVect, only : AttrVect
  1574. use m_AttrVect, only : AttrVect_init => init
  1575. use m_AttrVect, only : AttrVect_zero => zero
  1576. implicit none
  1577. ! !INPUT PARAMETERS:
  1578. !
  1579. character(len=*), intent(in) :: CoordChars
  1580. character(len=*), optional, intent(in) :: CoordSortOrder
  1581. character(len=*), optional, intent(in) :: WeightChars
  1582. logical, dimension(:), optional, pointer :: descend
  1583. character(len=*), optional, intent(in) :: OtherChars
  1584. character(len=*), optional, intent(in) :: IndexChars
  1585. integer, intent(in) :: nDims
  1586. integer, intent(in) :: nPoints
  1587. real(DP), dimension(:), pointer :: PointData
  1588. ! !OUTPUT PARAMETERS:
  1589. !
  1590. type(GeneralGrid), intent(out) :: GGrid
  1591. ! !REVISION HISTORY:
  1592. ! 7Jun01 - Jay Larson <larson@mcs.anl.gov> - API specification.
  1593. ! 22Aug02 - J. Larson <larson@mcs.anl.gov> - Implementation.
  1594. ! ______________________________________________________________________
  1595. !
  1596. character(len=*),parameter :: myname_=myname//'::initUnstructuredDP_'
  1597. integer :: i, ierr, index, n, nOffSet, NumShared
  1598. integer, dimension(:), pointer :: &
  1599. CoordListIndices, CoordSortOrderIndices
  1600. type(List) :: IAList, RAList
  1601. ! Nullify all GeneralGrid components
  1602. call List_nullify(GGrid%coordinate_list)
  1603. call List_nullify(GGrid%coordinate_sort_order)
  1604. call List_nullify(GGrid%weight_list)
  1605. call List_nullify(GGrid%other_list)
  1606. call List_nullify(GGrid%index_list)
  1607. nullify(GGrid%descend)
  1608. ! Sanity checks on input arguments:
  1609. ! If the LOGICAL descend(:) flags for sorting are present,
  1610. ! make sure that (1) it is associated,
  1611. ! (2) CoordSortOrder is also present, and
  1612. ! (3) The size of descend(:) matches the size of Dims(:),
  1613. ! both of which correspond to the number of axes on the
  1614. ! Cartesian Grid.
  1615. if(present(descend)) then
  1616. if(.not.associated(descend)) then
  1617. call die(myname_,'descend argument must be associated')
  1618. endif
  1619. if(.not. present(CoordSortOrder)) then
  1620. write(stderr,'(4a)') myname_, &
  1621. ':: FATAL -- Invocation with the argument descend(:) present ', &
  1622. 'requires the presence of the argument CoordSortOrder, ', &
  1623. 'which was not provided.'
  1624. call die(myname_,'Argument CoordSortOrder was not provided')
  1625. endif
  1626. if(present(descend)) then
  1627. if(size(descend) /= nDims) then
  1628. write(stderr,'(4a,i8,a,i8)') myname_, &
  1629. ':: FATAL-- The size of the array descend(:) and nDims ', &
  1630. 'must be equal (they both must equal the number of dimensions ', &
  1631. 'of the unstructured Grid). nDims = ',nDims, &
  1632. ' size(descend) = ',size(descend)
  1633. call die(myname_,'size(descend)/=nDims')
  1634. endif
  1635. endif
  1636. endif
  1637. ! Initialize GGrid%coordinate_list and comparethe number of items
  1638. ! to the number of dimensions of the unstructured nDims:
  1639. call List_init(GGrid%coordinate_list, CoordChars)
  1640. ! Check the coordinate_list
  1641. if(nDims /= List_nitem(GGrid%coordinate_list)) then
  1642. write(stderr,'(4a,i8,3a,i8)') myname_, &
  1643. ':: FATAL-- The number of coordinate names supplied in the ', &
  1644. 'argument CoordChars must equal the number of dimensions ', &
  1645. 'specified by the argument nDims. nDims = ',nDims, &
  1646. ' CoordChars = ',CoordChars, ' number of dimensions in CoordChars = ', &
  1647. List_nitem(GGrid%coordinate_list)
  1648. call die(myname_)
  1649. endif
  1650. if(nDims <= 0) then
  1651. write(stderr,*) myname_, ':: ERROR nDims=0!'
  1652. call die(myname_,'nDims <= 0',nDims)
  1653. endif
  1654. ! PointData is a one-dimensional array containing all the gridpoint
  1655. ! coordinates. As such, its size must equal nDims * nPoints. True?
  1656. if(size(PointData) /= nDims * nPoints) then
  1657. write(stderr,'(3a,3(a,i8))') myname_, &
  1658. ':: FATAL-- The length of the array PointData(:) must match ', &
  1659. 'the product of the input arguments nDims and nPoints. ', &
  1660. 'nDims = ',nDims, ' nPoints = ',nPoints,&
  1661. ' size(PointData) = ',size(PointData)
  1662. call die(myname_)
  1663. endif
  1664. ! End of input argument sanity checks.
  1665. ! Create other List components of GGrid and build REAL
  1666. ! and INTEGER attribute lists for the AttrVect GGrid%data
  1667. ! Start off with things *guaranteed* to be in IAList and RAList.
  1668. ! The variable GlobGridNum is a CHARACTER parameter inherited
  1669. ! from the declaration section of this module.
  1670. call List_init(IAList, GlobGridNum)
  1671. call List_init(RAList, CoordChars)
  1672. if(present(CoordSortOrder)) then
  1673. call List_init(GGrid%coordinate_sort_order, CoordSortOrder)
  1674. call List_shared(GGrid%coordinate_list,GGrid%coordinate_sort_order, &
  1675. NumShared,CoordListIndices,CoordSortOrderIndices)
  1676. deallocate(CoordListIndices,CoordSortOrderIndices,stat=ierr)
  1677. if(ierr/=0) call die(myname_,'deallocate(CoordListIndices..)',ierr)
  1678. if(NumShared /= nDims) then
  1679. call die(myname_,'CoordSortOrder must have the same items &
  1680. & as CoordList',abs(nDims-NumShared))
  1681. endif
  1682. endif
  1683. if(present(WeightChars)) then
  1684. call List_init(GGrid%weight_list, WeightChars)
  1685. call List_append(RAList, GGrid%weight_list)
  1686. endif
  1687. if(present(OtherChars)) then
  1688. call List_init(GGrid%other_list, OtherChars)
  1689. call List_append(RAList, GGrid%other_list)
  1690. endif
  1691. if(present(IndexChars)) then
  1692. call List_init(GGrid%index_list, IndexChars)
  1693. call List_append(IAList, GGrid%index_list)
  1694. endif
  1695. ! Initialize GGrid%descend from descend(:).
  1696. ! If descend argument is not present, set it to the default .false.
  1697. if(present(CoordSortOrder)) then
  1698. allocate(GGrid%descend(nDims), stat=ierr)
  1699. if(ierr /= 0) call die(myname_,"allocate GGrid%descend...",ierr)
  1700. if(present(descend)) then
  1701. do n=1,nDims
  1702. GGrid%descend(n) = descend(n)
  1703. end do
  1704. else
  1705. do n=1,nDims
  1706. GGrid%descend(n) = .FALSE.
  1707. end do
  1708. endif
  1709. endif ! if(present(CoordSortOrder))...
  1710. ! Create Grid attribute data storage AttrVect GGrid%data:
  1711. call AttrVect_init(GGrid%data, IAList, RAList, nPoints)
  1712. call AttrVect_zero(GGrid%data)
  1713. ! Load up gridpoint coordinate data into GGrid%data.
  1714. ! Given how we've set up the real attributes of GGrid%data,
  1715. ! we have guaranteed the first nDims real attributes are
  1716. ! the gridpoint coordinates.
  1717. do n=1,nPoints
  1718. nOffSet = (n-1) * nDims
  1719. do i=1,nDims
  1720. GGrid%data%rAttr(i,n) = PointData(nOffset + i)
  1721. end do
  1722. end do
  1723. ! If the argument CoordSortOrder was supplied, the entries
  1724. ! of GGrid will be sorted/permuted with this lexicographic
  1725. ! ordering, and the values of the GGrid INTEGER attribute
  1726. ! GlobGridNum will be numbered to reflect this new ordering
  1727. ! scheme.
  1728. index = indexIA_(GGrid, GlobGridNum)
  1729. if(present(CoordSortOrder)) then ! Sort permute entries before
  1730. ! numbering them
  1731. call SortPermute_(GGrid) ! Sort / permute
  1732. endif ! if(present(CoordSortOrder))...
  1733. ! Number the gridpoints based on the AttrVect point index
  1734. ! (i.e., the second index in GGrid%data%iAttr)
  1735. do i=1, lsize_(GGrid)
  1736. GGrid%data%iAttr(index,i) = i
  1737. end do
  1738. ! Clean up temporary allocated structures:
  1739. call List_clean(IAList)
  1740. call List_clean(RAList)
  1741. end subroutine initUnstructuredDP_
  1742. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1743. ! Math and Computer Science Division, Argonne National Laboratory !
  1744. !BOP -------------------------------------------------------------------
  1745. !
  1746. ! !IROUTINE: clean_ - Destroy a GeneralGrid
  1747. !
  1748. ! !DESCRIPTION:
  1749. ! This routine deallocates all attribute storage space for the input/output
  1750. ! {\tt GeneralGrid} argument {\tt GGrid}, and destroys all of its {\tt List}
  1751. ! components and sorting flags. The success (failure) of this operation is
  1752. ! signified by the zero (non-zero) value of the optional {\tt INTEGER}
  1753. ! output argument {\tt stat}.
  1754. !
  1755. ! !INTERFACE:
  1756. subroutine clean_(GGrid, stat)
  1757. !
  1758. ! !USES:
  1759. !
  1760. use m_stdio
  1761. use m_die
  1762. use m_List, only : List_clean => clean
  1763. use m_List, only : List_allocated => allocated
  1764. use m_AttrVect, only : AttrVect_clean => clean
  1765. implicit none
  1766. ! !INPUT/OUTPUT PARAMETERS:
  1767. !
  1768. type(GeneralGrid), intent(inout) :: GGrid
  1769. integer, optional, intent(out) :: stat
  1770. ! !REVISION HISTORY:
  1771. ! 25Sep00 - J.W. Larson <larson@mcs.anl.gov> - initial prototype
  1772. ! 20Mar01 - J.W. Larson <larson@mcs.anl.gov> - complete version.
  1773. ! 1Mar01 - E.T. Ong <eong@mcs.anl.gov> - removed dies to prevent
  1774. ! crashes when cleaning uninitialized attrvects. Added
  1775. ! optional stat argument.
  1776. ! 5Aug02 - E. Ong <eong@mcs.anl.gov> - a more rigorous revision
  1777. !EOP ___________________________________________________________________
  1778. character(len=*),parameter :: myname_=myname//'::clean_'
  1779. integer :: ierr
  1780. if(present(stat)) then
  1781. stat=0
  1782. call AttrVect_clean(GGrid%data,ierr)
  1783. if(ierr/=0) stat=ierr
  1784. call List_clean(GGrid%coordinate_list,ierr)
  1785. if(ierr/=0) stat=ierr
  1786. if(List_allocated(GGrid%coordinate_sort_order)) then
  1787. call List_clean(GGrid%coordinate_sort_order,ierr)
  1788. if(ierr/=0) stat=ierr
  1789. endif
  1790. if(List_allocated(GGrid%weight_list)) then
  1791. call List_clean(GGrid%weight_list,ierr)
  1792. if(ierr/=0) stat=ierr
  1793. endif
  1794. if(List_allocated(GGrid%other_list)) then
  1795. call List_clean(GGrid%other_list,ierr)
  1796. if(ierr/=0) stat=ierr
  1797. endif
  1798. if(List_allocated(GGrid%index_list)) then
  1799. call List_clean(GGrid%index_list,ierr)
  1800. if(ierr/=0) stat=ierr
  1801. endif
  1802. if(associated(GGrid%descend)) then
  1803. deallocate(GGrid%descend, stat=ierr)
  1804. if(ierr/=0) stat=ierr
  1805. endif
  1806. else
  1807. call AttrVect_clean(GGrid%data)
  1808. call List_clean(GGrid%coordinate_list)
  1809. if(List_allocated(GGrid%coordinate_sort_order)) then
  1810. call List_clean(GGrid%coordinate_sort_order)
  1811. endif
  1812. if(List_allocated(GGrid%weight_list)) then
  1813. call List_clean(GGrid%weight_list)
  1814. endif
  1815. if(List_allocated(GGrid%other_list)) then
  1816. call List_clean(GGrid%other_list)
  1817. endif
  1818. if(List_allocated(GGrid%index_list)) then
  1819. call List_clean(GGrid%index_list)
  1820. endif
  1821. if(associated(GGrid%descend)) then
  1822. deallocate(GGrid%descend, stat=ierr)
  1823. if(ierr/=0) call die(myname_,'deallocate(GGrid%descend)',ierr)
  1824. endif
  1825. endif
  1826. end subroutine clean_
  1827. !BOP -------------------------------------------------------------------
  1828. !
  1829. ! !IROUTINE: zero_ - Set GeneralGrid Data to Zero
  1830. !
  1831. ! !DESCRIPTION:
  1832. ! This routine sets all of the point values of the integer and real
  1833. ! attributes of an the input/output {\tt GeneralGrid} argument {\tt GGrid}
  1834. ! to zero. The default action is to set the values of all the real and
  1835. ! integer attributes to zero.
  1836. !
  1837. ! !INTERFACE:
  1838. subroutine zero_(GGrid, zeroReals, zeroInts)
  1839. ! !USES:
  1840. use m_die,only : die
  1841. use m_stdio,only : stderr
  1842. use m_AttrVect, only : AttrVect_zero => zero
  1843. implicit none
  1844. ! !INPUT/OUTPUT PARAMETERS:
  1845. !
  1846. type(GeneralGrid), intent(INOUT) :: GGrid
  1847. ! !INPUT PARAMETERS:
  1848. logical, optional, intent(IN) :: zeroReals
  1849. logical, optional, intent(IN) :: zeroInts
  1850. ! !REVISION HISTORY:
  1851. ! 11May08 - R. Jacob <jacob@mcs.anl.gov> - initial prototype/code
  1852. !EOP ___________________________________________________________________
  1853. character(len=*),parameter :: myname_=myname//'::zero_'
  1854. logical myZeroReals, myZeroInts
  1855. if(present(zeroReals)) then
  1856. myZeroReals = zeroReals
  1857. else
  1858. myZeroReals = .TRUE.
  1859. endif
  1860. if(present(zeroInts)) then
  1861. myZeroInts = zeroInts
  1862. else
  1863. myZeroInts = .TRUE.
  1864. endif
  1865. call AttrVect_zero(GGrid%data,myZeroReals,myZeroInts)
  1866. end subroutine zero_
  1867. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1868. ! Math and Computer Science Division, Argonne National Laboratory !
  1869. !BOP -------------------------------------------------------------------
  1870. !
  1871. ! !IROUTINE: dims_ - Return the Dimensionality of a GeneralGrid
  1872. !
  1873. ! !DESCRIPTION:
  1874. ! This {\tt INTEGER} function returns the number of physical dimensions
  1875. ! of the input {\tt GeneralGrid} argument {\tt GGrid}.
  1876. !
  1877. ! !INTERFACE:
  1878. integer function dims_(GGrid)
  1879. !
  1880. ! !USES:
  1881. !
  1882. use m_stdio
  1883. use m_die
  1884. use m_List, only : List_nitem => nitem
  1885. implicit none
  1886. ! !INPUT PARAMETERS:
  1887. !
  1888. type(GeneralGrid), intent(in) :: GGrid
  1889. ! !REVISION HISTORY:
  1890. ! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - initial version
  1891. !EOP ___________________________________________________________________
  1892. !
  1893. character(len=*),parameter :: myname_=myname//'::dims_'
  1894. dims_ = List_nitem(GGrid%coordinate_list)
  1895. if(dims_<=0) then
  1896. call die(myname_,"GGrid has zero dimensions",dims_)
  1897. endif
  1898. end function dims_
  1899. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1900. ! Math and Computer Science Division, Argonne National Laboratory !
  1901. !BOP -------------------------------------------------------------------
  1902. !
  1903. ! !IROUTINE: indexIA - Index an Integer Attribute
  1904. !
  1905. ! !DESCRIPTION:
  1906. ! This function returns an {\tt INTEGER}, corresponding to the location
  1907. ! of an integer attribute within the input {\tt GeneralGrid} argument
  1908. ! {\tt GGrid}. For example, every {\tt GGrid} has at least one integer
  1909. ! attribute (namely the global gridpoint index {\tt 'GlobGridNum'}).
  1910. ! The array of integer values for the attribute {\tt 'GlobGridNum'} is
  1911. ! stored in
  1912. ! \begin{verbatim}
  1913. ! {\tt GGrid%data%iAttr(indexIA_(GGrid,'GlobGridNum'),:)}.
  1914. ! \end{verbatim}
  1915. ! If {\tt indexIA\_()} is unable to match {\tt item} to any of the integer
  1916. ! attributes present in {\tt GGrid}, the resulting value is zero which is
  1917. ! equivalent to an error. The optional input {\tt CHARACTER} arguments
  1918. ! {\tt perrWith} and {\tt dieWith} control how such errors are handled.
  1919. ! Below are the rules how error handling is controlled by using
  1920. ! {\tt perrWith} and {\tt dieWith}:
  1921. ! \begin{enumerate}
  1922. ! \item if neither {\tt perrWith} nor {\tt dieWith} are present,
  1923. ! {\tt indexIA\_()} terminates execution with an internally generated
  1924. ! error message;
  1925. ! \item if {\tt perrWith} is present, but {\tt dieWith} is not, an error
  1926. ! message is written to {\tt stderr} incorporating user-supplied
  1927. ! traceback information stored in the argument {\tt perrWith};
  1928. ! \item if {\tt dieWith} is present, execution terminates with an error
  1929. ! message written to {\tt stderr} that incorporates user-supplied
  1930. ! traceback information stored in the argument {\tt dieWith}; and
  1931. ! \item if both {\tt perrWith} and {\tt dieWith} are present, execution
  1932. ! terminates with an error message using {\tt dieWith}, and the argument
  1933. ! {\tt perrWith} is ignored.
  1934. ! \end{enumerate}
  1935. !
  1936. ! !INTERFACE:
  1937. integer function indexIA_(GGrid, item, perrWith, dieWith)
  1938. !
  1939. ! !USES:
  1940. !
  1941. use m_die
  1942. use m_stdio
  1943. use m_String, only : String
  1944. use m_String, only : String_init => init
  1945. use m_String, only : String_clean => clean
  1946. use m_String, only : String_ToChar => ToChar
  1947. use m_TraceBack, only : GenTraceBackString
  1948. use m_AttrVect, only : AttrVect_indexIA => indexIA
  1949. implicit none
  1950. ! !INPUT PARAMETERS:
  1951. !
  1952. type(GeneralGrid), intent(in) :: GGrid
  1953. character(len=*), intent(in) :: item
  1954. character(len=*), optional, intent(in) :: perrWith
  1955. character(len=*), optional, intent(in) :: dieWith
  1956. ! !REVISION HISTORY:
  1957. ! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - Initial version.
  1958. ! 27Mar02 - Jay Larson <larson@mcs.anl.gov> - Cleaned up error
  1959. ! handling logic.
  1960. ! 2Aug02 - Jay Larson <larson@mcs.anl.gov> - Further refinement
  1961. ! of error handling.
  1962. !EOP ___________________________________________________________________
  1963. !
  1964. character(len=*), parameter :: myname_=myname//'::indexIA_'
  1965. type(String) :: myTrace
  1966. ! Generate a traceback String
  1967. if(present(dieWith)) then
  1968. call GenTraceBackString(myTrace, dieWith, myname_)
  1969. else
  1970. if(present(perrWith)) then
  1971. call GenTraceBackString(myTrace, perrWith, myname_)
  1972. else
  1973. call GenTraceBackString(myTrace, myname_)
  1974. endif
  1975. endif
  1976. ! Call AttrVect_indexIA() accordingly:
  1977. if( present(dieWith) .or. &
  1978. ((.not. present(dieWith)) .and. (.not. present(perrWith))) ) then
  1979. indexIA_ = AttrVect_indexIA(GGrid%data, item, &
  1980. dieWith=String_ToChar(myTrace))
  1981. else ! perrWith but no dieWith case
  1982. indexIA_ = AttrVect_indexIA(GGrid%data, item, &
  1983. perrWith=String_ToChar(myTrace))
  1984. endif
  1985. call String_clean(myTrace)
  1986. end function indexIA_
  1987. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  1988. ! Math and Computer Science Division, Argonne National Laboratory !
  1989. !BOP -------------------------------------------------------------------
  1990. !
  1991. ! !IROUTINE: indexRA - Index a Real Attribute
  1992. !
  1993. ! !DESCRIPTION:
  1994. ! This function returns an {\tt INTEGER}, corresponding to the location
  1995. ! of an integer attribute within the input {\tt GeneralGrid} argument
  1996. ! {\tt GGrid}. For example, every {\tt GGrid} has at least one integer
  1997. ! attribute (namely the global gridpoint index {\tt 'GlobGridNum'}).
  1998. ! The array of integer values for the attribute {\tt 'GlobGridNum'} is
  1999. ! stored in
  2000. ! \begin{verbatim}
  2001. ! {\tt GGrid%data%iAttr(indexRA_(GGrid,'GlobGridNum'),:)}.
  2002. ! \end{verbatim}
  2003. ! If {\tt indexRA\_()} is unable to match {\tt item} to any of the integer
  2004. ! attributes present in {\tt GGrid}, the resulting value is zero which is
  2005. ! equivalent to an error. The optional input {\tt CHARACTER} arguments
  2006. ! {\tt perrWith} and {\tt dieWith} control how such errors are handled.
  2007. ! Below are the rules how error handling is controlled by using
  2008. ! {\tt perrWith} and {\tt dieWith}:
  2009. ! \begin{enumerate}
  2010. ! \item if neither {\tt perrWith} nor {\tt dieWith} are present,
  2011. ! {\tt indexRA\_()} terminates execution with an internally generated
  2012. ! error message;
  2013. ! \item if {\tt perrWith} is present, but {\tt dieWith} is not, an error
  2014. ! message is written to {\tt stderr} incorporating user-supplied
  2015. ! traceback information stored in the argument {\tt perrWith};
  2016. ! \item if {\tt dieWith} is present, execution terminates with an error
  2017. ! message written to {\tt stderr} that incorporates user-supplied
  2018. ! traceback information stored in the argument {\tt dieWith}; and
  2019. ! \item if both {\tt perrWith} and {\tt dieWith} are present, execution
  2020. ! terminates with an error message using {\tt dieWith}, and the argument
  2021. ! {\tt perrWith} is ignored.
  2022. ! \end{enumerate}
  2023. !
  2024. ! !INTERFACE:
  2025. integer function indexRA_(GGrid, item, perrWith, dieWith)
  2026. !
  2027. ! !USES:
  2028. !
  2029. use m_stdio
  2030. use m_die
  2031. use m_String, only : String
  2032. use m_String, only : String_init => init
  2033. use m_String, only : String_clean => clean
  2034. use m_String, only : String_ToChar => ToChar
  2035. use m_TraceBack, only : GenTraceBackString
  2036. use m_AttrVect, only : AttrVect_indexRA => indexRA
  2037. implicit none
  2038. ! !INPUT PARAMETERS:
  2039. !
  2040. type(GeneralGrid), intent(in) :: GGrid
  2041. character(len=*), intent(in) :: item
  2042. character(len=*), optional, intent(in) :: perrWith
  2043. character(len=*), optional, intent(in) :: dieWith
  2044. ! !REVISION HISTORY:
  2045. ! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - Initial version.
  2046. ! 27Mar02 - Jay Larson <larson@mcs.anl.gov> - Cleaned up error
  2047. ! handling logic.
  2048. !EOP ___________________________________________________________________
  2049. !
  2050. character(len=*),parameter :: myname_=myname//'::indexRA_'
  2051. type(String) :: myTrace
  2052. ! Generate a traceback String
  2053. if(present(dieWith)) then ! append myname_ onto dieWith
  2054. call GenTraceBackString(myTrace, dieWith, myname_)
  2055. else
  2056. if(present(perrWith)) then ! append myname_ onto perrwith
  2057. call GenTraceBackString(myTrace, perrWith, myname_)
  2058. else ! Start a TraceBack String
  2059. call GenTraceBackString(myTrace, myname_)
  2060. endif
  2061. endif
  2062. ! Call AttrVect_indexRA() accordingly:
  2063. if( present(dieWith) .or. &
  2064. ((.not. present(dieWith)) .and. (.not. present(perrWith))) ) then
  2065. indexRA_ = AttrVect_indexRA(GGrid%data, item, &
  2066. dieWith=String_ToChar(myTrace))
  2067. else ! perrWith but no dieWith case
  2068. indexRA_ = AttrVect_indexRA(GGrid%data, item, &
  2069. perrWith=String_ToChar(myTrace))
  2070. endif
  2071. call String_clean(myTrace)
  2072. end function indexRA_
  2073. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2074. ! Math and Computer Science Division, Argonne National Laboratory !
  2075. !BOP -------------------------------------------------------------------
  2076. !
  2077. ! !IROUTINE: lsize - Number of Grid Points
  2078. !
  2079. ! !DESCRIPTION:
  2080. ! This {\tt INTEGER} function returns the number of grid points stored
  2081. ! in the input {\tt GeneralGrid} argument {\tt GGrid}. Note that the
  2082. ! value returned will be the number of points stored on a local process
  2083. ! in the case of a distributed {\tt GeneralGrid}.
  2084. !
  2085. ! !INTERFACE:
  2086. integer function lsize_(GGrid)
  2087. !
  2088. ! !USES:
  2089. !
  2090. use m_List, only : List
  2091. use m_List, only : List_allocated => allocated
  2092. use m_AttrVect, only : AttrVect_lsize => lsize
  2093. use m_die, only : die
  2094. implicit none
  2095. ! !INPUT PARAMETERS:
  2096. !
  2097. type(GeneralGrid), intent(in) :: GGrid
  2098. ! !REVISION HISTORY:
  2099. ! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - Initial version.
  2100. ! 27Mar02 - Jay Larson <larson@mcs.anl.gov> - slight logic change.
  2101. ! 27Mar02 - Jay Larson <larson@mcs.anl.gov> - Bug fix and use of
  2102. ! List_allocated() function to check for existence of
  2103. ! attributes.
  2104. ! 5Aug02 - E. Ong <eong@mcs.anl.gov> - more rigorous revision
  2105. !EOP ___________________________________________________________________
  2106. !
  2107. character(len=*),parameter :: myname_=myname//'::lsize_'
  2108. if(List_allocated(GGrid%data%rList) .and. &
  2109. List_allocated(GGrid%data%iList)) then
  2110. lsize_ = AttrVect_lsize( GGrid%data )
  2111. else
  2112. call die(myname_,"Argument GGrid%data is not associated!")
  2113. endif
  2114. end function lsize_
  2115. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2116. ! Math and Computer Science Division, Argonne National Laboratory !
  2117. !BOP -------------------------------------------------------------------
  2118. !
  2119. ! !IROUTINE: exportIAttr_ - Return GeneralGrid INTEGER Attribute as a Vector
  2120. !
  2121. ! !DESCRIPTION:
  2122. ! This routine extracts from the input {\tt GeneralGrid} argument
  2123. ! {\tt GGrid} the integer attribute corresponding to the tag defined in
  2124. ! the input {\tt CHARACTER} argument {\tt AttrTag}, and returns it in
  2125. ! the {\tt INTEGER} output array {\tt outVect}, and its length in the
  2126. ! output {\tt INTEGER} argument {\tt lsize}.
  2127. !
  2128. ! {\bf N.B.:} This routine will fail if the {\tt AttrTag} is not in
  2129. ! the {\tt GeneralGrid} {\tt List} component {\tt GGrid\%data\%iList}.
  2130. !
  2131. ! {\bf N.B.:} The flexibility of this routine regarding the pointer
  2132. ! association status of the output argument {\tt outVect} means the
  2133. ! user must invoke this routine with care. If the user wishes this
  2134. ! routine to fill a pre-allocated array, then obviously this array
  2135. ! must be allocated prior to calling this routine. If the user wishes
  2136. ! that the routine {\em create} the output argument array {\tt outVect},
  2137. ! then the user must ensure this pointer is not allocated (i.e. the user
  2138. ! must nullify this pointer) before this routine is invoked.
  2139. !
  2140. ! {\bf N.B.:} If the user has relied on this routine to allocate memory
  2141. ! associated with the pointer {\tt outVect}, then the user is responsible
  2142. ! for deallocating this array once it is no longer needed. Failure to
  2143. ! do so will result in a memory leak.
  2144. !
  2145. ! !INTERFACE:
  2146. subroutine exportIAttr_(GGrid, AttrTag, outVect, lsize)
  2147. !
  2148. ! !USES:
  2149. !
  2150. use m_die
  2151. use m_stdio
  2152. use m_AttrVect, only : AttrVect_exportIAttr => exportIAttr
  2153. implicit none
  2154. ! !INPUT PARAMETERS:
  2155. type(GeneralGrid), intent(in) :: GGrid
  2156. character(len=*), intent(in) :: AttrTag
  2157. ! !OUTPUT PARAMETERS:
  2158. integer, dimension(:), pointer :: outVect
  2159. integer, optional, intent(out) :: lsize
  2160. ! !REVISION HISTORY:
  2161. ! 13Dec01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
  2162. !EOP ___________________________________________________________________
  2163. character(len=*),parameter :: myname_=myname//'::exportIAttr_'
  2164. ! Export the data (inheritance from AttrVect)
  2165. if(present(lsize)) then
  2166. call AttrVect_exportIAttr(GGrid%data, AttrTag, outVect, lsize)
  2167. else
  2168. call AttrVect_exportIAttr(GGrid%data, AttrTag, outVect)
  2169. endif
  2170. end subroutine exportIAttr_
  2171. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2172. ! Math and Computer Science Division, Argonne National Laboratory !
  2173. !BOP -------------------------------------------------------------------
  2174. !
  2175. ! !IROUTINE: exportRAttrSP_ - Return GeneralGrid REAL Attribute as a Vector
  2176. !
  2177. ! !DESCRIPTION:
  2178. ! This routine extracts from the input {\tt GeneralGrid} argument
  2179. ! {\tt GGrid} the real attribute corresponding to the tag defined in
  2180. ! the input {\tt CHARACTER} argument {\tt AttrTag}, and returns it in
  2181. ! the {\tt REAL} output array {\tt outVect}, and its length in the
  2182. ! output {\tt INTEGER} argument {\tt lsize}.
  2183. !
  2184. ! {\bf N.B.:} This routine will fail if the {\tt AttrTag} is not in
  2185. ! the {\tt GeneralGrid} {\tt List} component {\tt GGrid\%data\%rList}.
  2186. !
  2187. ! {\bf N.B.:} The flexibility of this routine regarding the pointer
  2188. ! association status of the output argument {\tt outVect} means the
  2189. ! user must invoke this routine with care. If the user wishes this
  2190. ! routine to fill a pre-allocated array, then obviously this array
  2191. ! must be allocated prior to calling this routine. If the user wishes
  2192. ! that the routine {\em create} the output argument array {\tt outVect},
  2193. ! then the user must ensure this pointer is not allocated (i.e. the user
  2194. ! must nullify this pointer) before this routine is invoked.
  2195. !
  2196. ! {\bf N.B.:} If the user has relied on this routine to allocate memory
  2197. ! associated with the pointer {\tt outVect}, then the user is responsible
  2198. ! for deallocating this array once it is no longer needed. Failure to
  2199. ! do so will result in a memory leak.
  2200. !
  2201. ! !INTERFACE:
  2202. subroutine exportRAttrSP_(GGrid, AttrTag, outVect, lsize)
  2203. !
  2204. ! !USES:
  2205. !
  2206. use m_die
  2207. use m_stdio
  2208. use m_realkinds, only : SP
  2209. use m_AttrVect, only : AttrVect_exportRAttr => exportRAttr
  2210. implicit none
  2211. ! !INPUT PARAMETERS:
  2212. type(GeneralGrid), intent(in) :: GGrid
  2213. character(len=*), intent(in) :: AttrTag
  2214. ! !OUTPUT PARAMETERS:
  2215. real(SP), dimension(:), pointer :: outVect
  2216. integer, optional, intent(out) :: lsize
  2217. ! !REVISION HISTORY:
  2218. ! 13Dec01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
  2219. !
  2220. !EOP ___________________________________________________________________
  2221. character(len=*),parameter :: myname_=myname//'::exportRAttrSP_'
  2222. ! Export the data (inheritance from AttrVect)
  2223. if(present(lsize)) then
  2224. call AttrVect_exportRAttr(GGrid%data, AttrTag, outVect, lsize)
  2225. else
  2226. call AttrVect_exportRAttr(GGrid%data, AttrTag, outVect)
  2227. endif
  2228. end subroutine exportRAttrSP_
  2229. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2230. ! Math and Computer Science Division, Argonne National Laboratory !
  2231. ! ---------------------------------------------------------------------
  2232. !
  2233. ! !IROUTINE: exportRAttrDP_ - Return GeneralGrid REAL Attribute as a Vector
  2234. !
  2235. ! !DESCRIPTION:
  2236. ! double precision version of exportRAttrSP_
  2237. !
  2238. ! !INTERFACE:
  2239. subroutine exportRAttrDP_(GGrid, AttrTag, outVect, lsize)
  2240. !
  2241. ! !USES:
  2242. !
  2243. use m_die
  2244. use m_stdio
  2245. use m_realkinds, only : DP
  2246. use m_AttrVect, only : AttrVect_exportRAttr => exportRAttr
  2247. implicit none
  2248. ! !INPUT PARAMETERS:
  2249. type(GeneralGrid), intent(in) :: GGrid
  2250. character(len=*), intent(in) :: AttrTag
  2251. ! !OUTPUT PARAMETERS:
  2252. real(DP), dimension(:), pointer :: outVect
  2253. integer, optional, intent(out) :: lsize
  2254. ! !REVISION HISTORY:
  2255. ! 13Dec01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
  2256. !
  2257. !_______________________________________________________________________
  2258. character(len=*),parameter :: myname_=myname//'::exportRAttrDP_'
  2259. ! Export the data (inheritance from AttrVect)
  2260. if(present(lsize)) then
  2261. call AttrVect_exportRAttr(GGrid%data, AttrTag, outVect, lsize)
  2262. else
  2263. call AttrVect_exportRAttr(GGrid%data, AttrTag, outVect)
  2264. endif
  2265. end subroutine exportRAttrDP_
  2266. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2267. ! Math and Computer Science Division, Argonne National Laboratory !
  2268. !BOP -------------------------------------------------------------------
  2269. !
  2270. ! !IROUTINE: importIAttr_ - Import GeneralGrid INTEGER Attribute
  2271. !
  2272. ! !DESCRIPTION:
  2273. ! This routine imports data provided in the input {\tt INTEGER} vector
  2274. ! {\tt inVect} into the {\tt GeneralGrid} argument {\tt GGrid}, storing
  2275. ! it as the integer attribute corresponding to the tag defined in
  2276. ! the input {\tt CHARACTER} argument {\tt AttrTag}. The input
  2277. ! {\tt INTEGER} argument {\tt lsize} is used to ensure there is
  2278. ! sufficient space in the {\tt GeneralGrid} to store the data.
  2279. !
  2280. ! {\bf N.B.:} This routine will fail if the {\tt AttrTag} is not in
  2281. ! the {\tt GeneralGrid} {\tt List} component {\tt GGrid\%data\%iList}.
  2282. !
  2283. ! !INTERFACE:
  2284. subroutine importIAttr_(GGrid, AttrTag, inVect, lsize)
  2285. !
  2286. ! !USES:
  2287. !
  2288. use m_die
  2289. use m_stdio
  2290. use m_AttrVect, only : AttrVect_importIAttr => importIAttr
  2291. implicit none
  2292. ! !INPUT PARAMETERS:
  2293. character(len=*), intent(in) :: AttrTag
  2294. integer, dimension(:), pointer :: inVect
  2295. integer, intent(in) :: lsize
  2296. ! !INPUT/OUTPUT PARAMETERS:
  2297. type(GeneralGrid), intent(inout) :: GGrid
  2298. ! !REVISION HISTORY:
  2299. ! 13Dec01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
  2300. ! 27Mar02 - Jay Larson <larson@mcs.anl.gov> - improved error handling.
  2301. !EOP ___________________________________________________________________
  2302. character(len=*),parameter :: myname_=myname//'::importIAttr_'
  2303. ! Argument Check:
  2304. if(lsize > lsize_(GGrid)) then
  2305. write(stderr,*) myname_,':: ERROR, lsize > lsize_(GGrid).', &
  2306. 'lsize = ',lsize,'lsize_(GGrid) = ',lsize_(GGrid)
  2307. call die(myname_)
  2308. endif
  2309. ! Import the data (inheritance from AttrVect)
  2310. call AttrVect_importIAttr(GGrid%data, AttrTag, inVect, lsize)
  2311. end subroutine importIAttr_
  2312. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2313. ! Math and Computer Science Division, Argonne National Laboratory !
  2314. !BOP -------------------------------------------------------------------
  2315. !
  2316. ! !IROUTINE: importRAttrSP_ - Import GeneralGrid REAL Attribute
  2317. !
  2318. ! !DESCRIPTION:
  2319. ! This routine imports data provided in the input {\tt REAL} vector
  2320. ! {\tt inVect} into the {\tt GeneralGrid} argument {\tt GGrid}, storing
  2321. ! it as the real attribute corresponding to the tag defined in
  2322. ! the input {\tt CHARACTER} argument {\tt AttrTag}. The input
  2323. ! {\tt INTEGER} argument {\tt lsize} is used to ensure there is
  2324. ! sufficient space in the {\tt GeneralGrid} to store the data.
  2325. !
  2326. ! {\bf N.B.:} This routine will fail if the {\tt AttrTag} is not in
  2327. ! the {\tt GeneralGrid} {\tt List} component {\tt GGrid\%data\%rList}.
  2328. !
  2329. ! !INTERFACE:
  2330. subroutine importRAttrSP_(GGrid, AttrTag, inVect, lsize)
  2331. !
  2332. ! !USES:
  2333. !
  2334. use m_die , only : die
  2335. use m_die , only : MP_perr_die
  2336. use m_stdio , only : stderr
  2337. use m_realkinds, only : SP
  2338. use m_AttrVect, only : AttrVect_importRAttr => importRAttr
  2339. implicit none
  2340. ! !INPUT PARAMETERS:
  2341. character(len=*), intent(in) :: AttrTag
  2342. real(SP), dimension(:), pointer :: inVect
  2343. integer, intent(in) :: lsize
  2344. ! !INPUT/OUTPUT PARAMETERS:
  2345. type(GeneralGrid), intent(inout) :: GGrid
  2346. ! !REVISION HISTORY:
  2347. ! 13Dec01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
  2348. ! 27Mar02 - Jay Larson <larson@mcs.anl.gov> - improved error handling.
  2349. !EOP ___________________________________________________________________
  2350. character(len=*),parameter :: myname_=myname//'::importRAttrSP_'
  2351. ! Argument Check:
  2352. if(lsize > lsize_(GGrid)) then
  2353. write(stderr,*) myname_,':: ERROR, lsize > lsize_(GGrid).', &
  2354. 'lsize = ',lsize,'lsize_(GGrid) = ',lsize_(GGrid)
  2355. call die(myname_)
  2356. endif
  2357. ! Import the data (inheritance from AttrVect)
  2358. call AttrVect_importRAttr(GGrid%data, AttrTag, inVect, lsize)
  2359. end subroutine importRAttrSP_
  2360. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2361. ! Math and Computer Science Division, Argonne National Laboratory !
  2362. !-----------------------------------------------------------------------
  2363. !
  2364. ! !IROUTINE: importRAttrDP_ - Import GeneralGrid REAL Attribute
  2365. !
  2366. ! !DESCRIPTION:
  2367. ! Double precision version of importRAttrSP_
  2368. !
  2369. ! !INTERFACE:
  2370. subroutine importRAttrDP_(GGrid, AttrTag, inVect, lsize)
  2371. !
  2372. ! !USES:
  2373. !
  2374. use m_die , only : die
  2375. use m_die , only : MP_perr_die
  2376. use m_stdio , only : stderr
  2377. use m_realkinds, only : DP
  2378. use m_AttrVect, only : AttrVect_importRAttr => importRAttr
  2379. implicit none
  2380. ! !INPUT PARAMETERS:
  2381. character(len=*), intent(in) :: AttrTag
  2382. real(DP), dimension(:), pointer :: inVect
  2383. integer, intent(in) :: lsize
  2384. ! !INPUT/OUTPUT PARAMETERS:
  2385. type(GeneralGrid), intent(inout) :: GGrid
  2386. ! !REVISION HISTORY:
  2387. ! 13Dec01 - J.W. Larson <larson@mcs.anl.gov> - initial prototype.
  2388. ! 27Mar02 - Jay Larson <larson@mcs.anl.gov> - improved error handling.
  2389. !_______________________________________________________________________
  2390. character(len=*),parameter :: myname_=myname//'::importRAttrDP_'
  2391. ! Argument Check:
  2392. if(lsize > lsize_(GGrid)) then
  2393. write(stderr,*) myname_,':: ERROR, lsize > lsize_(GGrid).', &
  2394. 'lsize = ',lsize,'lsize_(GGrid) = ',lsize_(GGrid)
  2395. call die(myname_)
  2396. endif
  2397. ! Import the data (inheritance from AttrVect)
  2398. call AttrVect_importRAttr(GGrid%data, AttrTag, inVect, lsize)
  2399. end subroutine importRAttrDP_
  2400. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2401. ! Math and Computer Science Division, Argonne National Laboratory !
  2402. !BOP -------------------------------------------------------------------
  2403. !
  2404. ! !IROUTINE: Sort_ - Generate Sort Permutation Defined by Arbitrary Keys.
  2405. !
  2406. ! !DESCRIPTION:
  2407. ! The subroutine {\tt Sort\_()} uses the list of keys present in the
  2408. ! input {\tt List} variable {\tt key\_List}. This list of keys is
  2409. ! checked to ensure that {\em only} coordinate attributes are present
  2410. ! in the sorting keys, and that there are no redundant keys. Once
  2411. ! checked, this list is used to find the appropriate real attributes
  2412. ! referenced by the items in {\tt key\_list} ( that is, it identifies the
  2413. ! appropriate entries in {\tt GGrid\%data\%rList}), and then uses these
  2414. ! keys to generate a an output permutation {\tt perm} that will put
  2415. ! the entries of the attribute vector {\tt GGrid\%data} in lexicographic
  2416. ! order as defined by {\tt key\_list} (the ordering in {\tt key\_list}
  2417. ! being from left to right.
  2418. !
  2419. ! !INTERFACE:
  2420. subroutine Sort_(GGrid, key_List, perm, descend)
  2421. !
  2422. ! !USES:
  2423. !
  2424. use m_stdio
  2425. use m_die
  2426. use m_AttrVect, only : AttrVect_Sort => Sort
  2427. use m_List, only : List_nitem => nitem
  2428. implicit none
  2429. ! !INPUT PARAMETERS:
  2430. !
  2431. type(GeneralGrid), intent(in) :: GGrid
  2432. type(List), intent(in) :: key_list
  2433. logical, dimension(:), optional, intent(in) :: descend
  2434. ! !OUTPUT PARAMETERS:
  2435. !
  2436. integer, dimension(:), pointer :: perm
  2437. ! !REVISION HISTORY:
  2438. ! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - Initial version.
  2439. ! 20Mar01 - Jay Larson <larson@mcs.anl.gov> - Final working version.
  2440. !EOP ___________________________________________________________________
  2441. !
  2442. character(len=*),parameter :: myname_=myname//'::Sort_'
  2443. logical, dimension(:), allocatable :: descending
  2444. integer :: n, ierr
  2445. ! Here is how we transmit the sort order keys stored
  2446. ! in descending (if present):
  2447. n = List_nitem(key_list)
  2448. allocate(descending(n), stat=ierr)
  2449. if(ierr /= 0) then
  2450. call die(myname_,"allocate(descending...",ierr)
  2451. endif
  2452. if(present(descend)) then
  2453. descending = descend
  2454. else
  2455. descending = .false.
  2456. endif
  2457. ! This is a straightforward call to AttrVect_Sort().
  2458. call AttrVect_Sort(GGrid%data, key_list, perm, descending)
  2459. ! Clean up...
  2460. deallocate(descending, stat=ierr)
  2461. if(ierr /= 0) then
  2462. call die(myname_,"deallocate(descending...",ierr)
  2463. endif
  2464. end subroutine Sort_
  2465. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2466. ! Math and Computer Science Division, Argonne National Laboratory !
  2467. !BOP -------------------------------------------------------------------
  2468. !
  2469. ! !IROUTINE: Sortg_ - Generate Sort Permutation Based on GeneralGrid Keys.
  2470. !
  2471. ! !DESCRIPTION:
  2472. ! The subroutine {\tt Sortg\_()} uses the list of sorting keys present in
  2473. ! the input {\tt GeneralGrid} variable {\tt GGrid\%coordinate\_sort\_order}
  2474. ! to create a sort permutation {\tt perm(:)}. Sorting is either in ascending
  2475. ! or descending order based on the entries of {\tt GGrid\%descend(:)}.
  2476. ! The output index permutation is stored in the array {\tt perm(:)} that
  2477. ! will put the entries of the attribute vector {\tt GGrid\%data} in
  2478. ! lexicographic order as defined by {\tt GGrid\%coordinate\_sort\_order}. The
  2479. ! ordering in {\tt GGrid\%coordinate\_sort\_order} being from left to right.
  2480. !
  2481. ! {\bf N.B.:} This routine returnss an allocatable array perm(:). This
  2482. ! allocated array must be deallocated when the user no longer needs it.
  2483. ! Failure to do so will cause a memory leak.
  2484. !
  2485. ! {\bf N.B.:} This routine will fail if {\tt GGrid} has not been initialized
  2486. ! with sort keys in the {\tt List} component {\tt GGrid\%coordinate\_sort\_order}.
  2487. !
  2488. ! !INTERFACE:
  2489. subroutine Sortg_(GGrid, perm)
  2490. !
  2491. ! !USES:
  2492. !
  2493. use m_List, only : List_allocated => allocated
  2494. use m_die, only : die
  2495. implicit none
  2496. ! !INPUT PARAMETERS:
  2497. !
  2498. type(GeneralGrid), intent(in) :: GGrid
  2499. ! !OUTPUT PARAMETERS:
  2500. !
  2501. integer, dimension(:), pointer :: perm
  2502. ! !REVISION HISTORY:
  2503. ! 22Mar01 - Jay Larson <larson@mcs.anl.gov> - Initial version.
  2504. ! 5Aug02 - E. Ong <eong@mcs.anl.gov> - revise with more error checking.
  2505. !EOP ___________________________________________________________________
  2506. !
  2507. character(len=*),parameter :: myname_=myname//'::Sortg_'
  2508. if(.not.List_allocated(GGrid%coordinate_sort_order)) then
  2509. call die(myname_, "GGrid%coordinate_aort_order must be &
  2510. &allocated for use in any sort function")
  2511. endif
  2512. if(associated(GGrid%descend)) then
  2513. call Sort_(GGrid, GGrid%coordinate_sort_order, &
  2514. perm, GGrid%descend)
  2515. else
  2516. call Sort_(GGrid=GGrid, key_list=GGrid%coordinate_sort_order, &
  2517. perm=perm)
  2518. endif
  2519. end subroutine Sortg_
  2520. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2521. ! Math and Computer Science Division, Argonne National Laboratory !
  2522. !BOP -------------------------------------------------------------------
  2523. !
  2524. ! !IROUTINE: Permute_ - Permute GeneralGrid Attributes Using Supplied Index Permutation
  2525. !
  2526. ! !DESCRIPTION:
  2527. ! The subroutine {\tt Permute\_()} uses an input index permutation {\tt perm}
  2528. ! to re-order the coordinate data stored in the {\tt GeneralGrid} argument
  2529. ! {\tt GGrid}. This permutation can be generated by either of the routines
  2530. ! {\tt Sort\_()} or {\tt Sortg\_()} contained in this module.
  2531. !
  2532. ! !INTERFACE:
  2533. subroutine Permute_(GGrid, perm)
  2534. !
  2535. ! !USES:
  2536. !
  2537. use m_stdio
  2538. use m_die
  2539. use m_AttrVect, only : AttrVect
  2540. use m_AttrVect, only : AttrVect_Permute => Permute
  2541. implicit none
  2542. ! !INPUT PARAMETERS:
  2543. !
  2544. integer, dimension(:), intent(in) :: perm
  2545. ! !INPUT/OUTPUT PARAMETERS:
  2546. !
  2547. type(GeneralGrid), intent(inout) :: GGrid
  2548. ! !REVISION HISTORY:
  2549. ! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - API specification.
  2550. ! 10Apr01 - Jay Larson <larson@mcs.anl.gov> - API modified, working
  2551. ! code.
  2552. !EOP ___________________________________________________________________
  2553. !
  2554. character(len=*),parameter :: myname_=myname//'::Permute_'
  2555. ! This is a straightforward call to AttrVect_Permute:
  2556. call AttrVect_Permute(GGrid%data, perm)
  2557. end subroutine Permute_
  2558. !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  2559. ! Math and Computer Science Division, Argonne National Laboratory !
  2560. !BOP -------------------------------------------------------------------
  2561. !
  2562. ! !IROUTINE: SortPermute_ - Sort and Permute GeneralGrid Attributes
  2563. !
  2564. ! !DESCRIPTION:
  2565. ! The subroutine {\tt SortPermute\_()} uses the list of keys defined in
  2566. ! {\tt GGrid\%coordinate\_sort\_order} to create an index permutation
  2567. ! {\tt perm}, which is then applied to re-order the coordinate data stored
  2568. ! in the {\tt GeneralGrid} argument {\tt GGrid} (more specifically, the
  2569. ! gridpoint data stored in {\tt GGrid\%data}. This permutation is generated
  2570. ! by the routine {\tt Sortg\_()} contained in this module. The permutation
  2571. ! is carried out by the routine {\tt Permute\_()} contained in this module.
  2572. !
  2573. ! {\bf N.B.:} This routine will fail if {\tt GGrid} has not been initialized
  2574. ! with sort keys in the {\tt List} component {\tt GGrid\%coordinate\_sort\_order}.
  2575. !
  2576. ! !INTERFACE:
  2577. subroutine SortPermute_(GGrid)
  2578. !
  2579. ! !USES:
  2580. !
  2581. use m_stdio
  2582. use m_die
  2583. implicit none
  2584. ! !INPUT/OUTPUT PARAMETERS:
  2585. !
  2586. type(GeneralGrid), intent(inout) :: GGrid
  2587. ! !REVISION HISTORY:
  2588. ! 15Jan01 - Jay Larson <larson@mcs.anl.gov> - API specification.
  2589. ! 10Apr01 - Jay Larson <larson@mcs.anl.gov> - API modified, working
  2590. ! code.
  2591. ! 13Apr01 - Jay Larson <larson@mcs.anl.gov> - Simplified API and
  2592. ! code (Thanks to Tony Craig of NCAR for detecting the
  2593. ! bug that inspired these changes).
  2594. !EOP ___________________________________________________________________
  2595. !
  2596. character(len=*),parameter :: myname_=myname//'::SortPermute_'
  2597. integer, dimension(:), pointer :: perm
  2598. integer :: ierr
  2599. call Sortg_(GGrid, perm)
  2600. call Permute_(GGrid, perm)
  2601. ! Clean up--deallocate temporary permutation array:
  2602. deallocate(perm, stat=ierr)
  2603. if(ierr /= 0) then
  2604. call die(myname_,"deallocate(perm)",ierr)
  2605. endif
  2606. end subroutine SortPermute_
  2607. end module m_GeneralGrid