1 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
2 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
3 | !----------------------------------------------------------------------- |
---|
4 | ! CVS m_String.F90,v 1.8 2007-11-06 00:03:32 jacob Exp |
---|
5 | ! CVS MCT_2_8_0 |
---|
6 | !BOP ------------------------------------------------------------------- |
---|
7 | ! |
---|
8 | ! !MODULE: m_String - The String Datatype |
---|
9 | ! |
---|
10 | ! !DESCRIPTION: |
---|
11 | ! The {\tt String} datatype is an encapsulated pointer to a one-dimensional |
---|
12 | ! array of single characters. This allows one to define variable-length |
---|
13 | ! strings, and arrays of variable-length strings. |
---|
14 | ! |
---|
15 | ! !INTERFACE: |
---|
16 | |
---|
17 | module m_String |
---|
18 | |
---|
19 | ! !USES: |
---|
20 | ! No external modules are used in the declaration section of this module. |
---|
21 | |
---|
22 | implicit none |
---|
23 | |
---|
24 | private ! except |
---|
25 | |
---|
26 | ! !PUBLIC TYPES: |
---|
27 | |
---|
28 | public :: String ! The class data structure |
---|
29 | |
---|
30 | Type String |
---|
31 | #ifdef SEQUENCE |
---|
32 | sequence |
---|
33 | #endif |
---|
34 | character(len=1),dimension(:),pointer :: c |
---|
35 | End Type String |
---|
36 | |
---|
37 | ! !PUBLIC MEMBER FUNCTIONS: |
---|
38 | |
---|
39 | public :: toChar |
---|
40 | public :: char ! convert to a CHARACTER(*) |
---|
41 | |
---|
42 | public :: String_init |
---|
43 | public :: init ! set a CHARACTER(*) type to a String |
---|
44 | |
---|
45 | public :: String_clean |
---|
46 | public :: clean ! Deallocate memory occupied by a String |
---|
47 | |
---|
48 | public :: String_len |
---|
49 | public :: len ! length of a String |
---|
50 | |
---|
51 | public :: String_bcast |
---|
52 | public :: bcast ! Broadcast a String |
---|
53 | |
---|
54 | public :: String_mci ! Track memory used to store a String |
---|
55 | public :: String_mco |
---|
56 | |
---|
57 | public :: ptr_chars ! Assign a pointer to a String's |
---|
58 | ! character buffer |
---|
59 | |
---|
60 | interface char; module procedure & |
---|
61 | str2ch0_, & |
---|
62 | ch12ch0_ |
---|
63 | end interface |
---|
64 | |
---|
65 | interface toChar; module procedure & |
---|
66 | str2ch0_, & |
---|
67 | ch12ch0_ |
---|
68 | end interface |
---|
69 | |
---|
70 | interface String_init; module procedure & |
---|
71 | initc_, & |
---|
72 | initc1_, & |
---|
73 | inits_ |
---|
74 | end interface |
---|
75 | |
---|
76 | interface init; module procedure & |
---|
77 | initc_, & |
---|
78 | initc1_, & |
---|
79 | inits_ |
---|
80 | end interface |
---|
81 | |
---|
82 | interface String_clean; module procedure clean_; end interface |
---|
83 | interface clean; module procedure clean_; end interface |
---|
84 | interface String_len; module procedure len_; end interface |
---|
85 | interface len; module procedure len_; end interface |
---|
86 | interface String_bcast; module procedure bcast_; end interface |
---|
87 | interface bcast; module procedure bcast_; end interface |
---|
88 | |
---|
89 | interface String_mci; module procedure & |
---|
90 | mci0_, & |
---|
91 | mci1_, & |
---|
92 | mci2_, & |
---|
93 | mci3_ |
---|
94 | end interface |
---|
95 | |
---|
96 | interface String_mco; module procedure & |
---|
97 | mco0_, & |
---|
98 | mco1_, & |
---|
99 | mco2_, & |
---|
100 | mco3_ |
---|
101 | end interface |
---|
102 | |
---|
103 | interface ptr_chars; module procedure & |
---|
104 | ptr_chars_ |
---|
105 | end interface |
---|
106 | |
---|
107 | ! !REVISION HISTORY: |
---|
108 | ! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
109 | !EOP ___________________________________________________________________ |
---|
110 | |
---|
111 | character(len=*),parameter :: myname='MCT(MPEU)::m_String' |
---|
112 | |
---|
113 | contains |
---|
114 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
115 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
116 | !BOP ------------------------------------------------------------------- |
---|
117 | ! |
---|
118 | ! !IROUTINE: str2ch0_ - Convert a String to a CHARACTER |
---|
119 | ! |
---|
120 | ! !DESCRIPTION: |
---|
121 | ! This function returns the contents of the character buffer of the |
---|
122 | ! input {\tt String} argument {\tt str} as a {\tt CHARCTER} suitable |
---|
123 | ! for printing. |
---|
124 | ! |
---|
125 | ! !INTERFACE: |
---|
126 | |
---|
127 | function str2ch0_(str) |
---|
128 | |
---|
129 | ! !USES: |
---|
130 | ! |
---|
131 | ! No external modules are used by this function. |
---|
132 | |
---|
133 | implicit none |
---|
134 | |
---|
135 | ! !INPUT PARAMETERS: |
---|
136 | ! |
---|
137 | type(String), intent(in) :: str |
---|
138 | |
---|
139 | ! !OUTPUT PARAMETERS: |
---|
140 | ! |
---|
141 | character(len=size(str%c,1)) :: str2ch0_ |
---|
142 | |
---|
143 | ! !REVISION HISTORY: |
---|
144 | ! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
145 | !EOP ___________________________________________________________________ |
---|
146 | |
---|
147 | character(len=*),parameter :: myname_=myname//'::str2ch0_' |
---|
148 | integer :: i |
---|
149 | |
---|
150 | do i=1,size(str%c) |
---|
151 | str2ch0_(i:i)=str%c(i) |
---|
152 | end do |
---|
153 | |
---|
154 | end function str2ch0_ |
---|
155 | |
---|
156 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
157 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
158 | !BOP ------------------------------------------------------------------- |
---|
159 | ! |
---|
160 | ! !IROUTINE: ch12ch0_ - Convert a CHARACTER(:) to a CHARACTER(*) |
---|
161 | ! |
---|
162 | ! !DESCRIPTION: |
---|
163 | ! This function takes an input one-dimensional array of single characters |
---|
164 | ! and returns a single character string. |
---|
165 | ! |
---|
166 | ! !INTERFACE: |
---|
167 | |
---|
168 | function ch12ch0_(ch1) |
---|
169 | |
---|
170 | ! !USES: |
---|
171 | ! |
---|
172 | ! No external modules are used by this function. |
---|
173 | |
---|
174 | implicit none |
---|
175 | |
---|
176 | ! !INPUT PARAMETERS: |
---|
177 | ! |
---|
178 | character(len=1), dimension(:), intent(in) :: ch1 |
---|
179 | |
---|
180 | ! !OUTPUT PARAMETERS: |
---|
181 | ! |
---|
182 | character(len=size(ch1,1)) :: ch12ch0_ |
---|
183 | |
---|
184 | ! !REVISION HISTORY: |
---|
185 | ! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
186 | !EOP ___________________________________________________________________ |
---|
187 | |
---|
188 | character(len=*),parameter :: myname_=myname//'::ch12ch0_' |
---|
189 | integer :: i |
---|
190 | |
---|
191 | do i=1,size(ch1) |
---|
192 | ch12ch0_(i:i)=ch1(i) |
---|
193 | end do |
---|
194 | |
---|
195 | end function ch12ch0_ |
---|
196 | |
---|
197 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
198 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
199 | !BOP ------------------------------------------------------------------- |
---|
200 | ! |
---|
201 | ! !IROUTINE: initc_ - Create a String using a CHARACTER |
---|
202 | ! |
---|
203 | ! !DESCRIPTION: |
---|
204 | ! This routine takes an input scalar {\tt CHARACTER} argument {\tt chr}, |
---|
205 | ! and uses it to create the output {\tt String} argument {\tt str}. |
---|
206 | ! |
---|
207 | ! !INTERFACE: |
---|
208 | |
---|
209 | subroutine initc_(str, chr) |
---|
210 | |
---|
211 | ! !USES: |
---|
212 | ! |
---|
213 | use m_die, only : die,perr |
---|
214 | use m_mall,only : mall_mci,mall_ison |
---|
215 | |
---|
216 | implicit none |
---|
217 | |
---|
218 | ! !INPUT PARAMETERS: |
---|
219 | ! |
---|
220 | character(len=*), intent(in) :: chr |
---|
221 | |
---|
222 | ! !OUTPUT PARAMETERS: |
---|
223 | ! |
---|
224 | type(String), intent(out) :: str |
---|
225 | |
---|
226 | ! !REVISION HISTORY: |
---|
227 | ! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
228 | !EOP ___________________________________________________________________ |
---|
229 | |
---|
230 | character(len=*),parameter :: myname_=myname//'::initc_' |
---|
231 | integer :: ln,ier,i |
---|
232 | |
---|
233 | ln=len(chr) |
---|
234 | allocate(str%c(ln),stat=ier) |
---|
235 | if(ier /= 0) then |
---|
236 | call perr(myname_,'allocate()',ier) |
---|
237 | call die(myname_) |
---|
238 | endif |
---|
239 | |
---|
240 | if(mall_ison()) call mall_mci(str%c,myname) |
---|
241 | |
---|
242 | do i=1,ln |
---|
243 | str%c(i)=chr(i:i) |
---|
244 | end do |
---|
245 | |
---|
246 | end subroutine initc_ |
---|
247 | |
---|
248 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
249 | ! Math and Computer Science Division, Argonne National Laboratory ! |
---|
250 | !BOP ------------------------------------------------------------------- |
---|
251 | ! |
---|
252 | ! !IROUTINE: initc1_ - Create a String using a CHARACTER array |
---|
253 | ! |
---|
254 | ! !DESCRIPTION: |
---|
255 | ! This routine takes an input {\tt CHARACTER(:)} argument {\tt chr}, |
---|
256 | ! and uses it to create the output {\tt String} argument {\tt str}. |
---|
257 | ! |
---|
258 | ! !INTERFACE: |
---|
259 | |
---|
260 | subroutine initc1_(str, chr) |
---|
261 | |
---|
262 | ! !USES: |
---|
263 | ! |
---|
264 | use m_die, only : die,perr |
---|
265 | use m_mall,only : mall_mci,mall_ison |
---|
266 | |
---|
267 | implicit none |
---|
268 | |
---|
269 | ! !INPUT PARAMETERS: |
---|
270 | ! |
---|
271 | character, dimension(:), intent(in) :: chr |
---|
272 | |
---|
273 | ! !OUTPUT PARAMETERS: |
---|
274 | ! |
---|
275 | type(String), intent(out) :: str |
---|
276 | |
---|
277 | ! !REVISION HISTORY: |
---|
278 | ! 2Aug02 - J. Larson <larson@mcs.anl.gov> - initial prototype |
---|
279 | !EOP ___________________________________________________________________ |
---|
280 | |
---|
281 | character(len=*),parameter :: myname_=myname//'::initc1_' |
---|
282 | integer :: ln,ier,i |
---|
283 | |
---|
284 | ln=size(chr) |
---|
285 | allocate(str%c(ln),stat=ier) |
---|
286 | if(ier /= 0) then |
---|
287 | call perr(myname_,'allocate()',ier) |
---|
288 | call die(myname_) |
---|
289 | endif |
---|
290 | |
---|
291 | if(mall_ison()) call mall_mci(str%c,myname) |
---|
292 | |
---|
293 | do i=1,ln |
---|
294 | str%c(i)=chr(i) |
---|
295 | end do |
---|
296 | |
---|
297 | end subroutine initc1_ |
---|
298 | |
---|
299 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
300 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
301 | !BOP ------------------------------------------------------------------- |
---|
302 | ! |
---|
303 | ! !IROUTINE: inits_ - Initialization of a String from another String |
---|
304 | ! |
---|
305 | ! !DESCRIPTION: |
---|
306 | ! This routine takes an input {\tt String} argument {\tt iStr} and |
---|
307 | ! creates an output {\tt String} argument {\tt oStr}. In other words, |
---|
308 | ! it copies {\tt iStr} to {\tt oStr}. |
---|
309 | ! |
---|
310 | ! !INTERFACE: |
---|
311 | |
---|
312 | subroutine inits_(oStr, iStr) |
---|
313 | |
---|
314 | ! !USES: |
---|
315 | ! |
---|
316 | use m_die, only : die |
---|
317 | use m_mall,only : mall_mci,mall_ison |
---|
318 | |
---|
319 | implicit none |
---|
320 | |
---|
321 | ! !INPUT PARAMETERS: |
---|
322 | ! |
---|
323 | type(String), intent(in) :: iStr |
---|
324 | |
---|
325 | ! !OUTPUT PARAMETERS: |
---|
326 | ! |
---|
327 | type(String), intent(out) :: oStr |
---|
328 | |
---|
329 | ! !REVISION HISTORY: |
---|
330 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
331 | ! - initial prototype/prolog/code |
---|
332 | !EOP ___________________________________________________________________ |
---|
333 | |
---|
334 | character(len=*),parameter :: myname_=myname//'::inits_' |
---|
335 | integer :: ln,ier,i |
---|
336 | |
---|
337 | ln=size(iStr%c) |
---|
338 | |
---|
339 | allocate(oStr%c(ln),stat=ier) |
---|
340 | if(ier /= 0) call die(myname_,'allocate()',ier) |
---|
341 | |
---|
342 | if(mall_ison()) call mall_mci(oStr%c,myname) |
---|
343 | |
---|
344 | do i=1,ln |
---|
345 | oStr%c(i)=iStr%c(i) |
---|
346 | end do |
---|
347 | |
---|
348 | end subroutine inits_ |
---|
349 | |
---|
350 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
351 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
352 | !BOP ------------------------------------------------------------------- |
---|
353 | ! |
---|
354 | ! !IROUTINE: clean_ - Deallocate Memory Occupied by a String |
---|
355 | ! |
---|
356 | ! !DESCRIPTION: |
---|
357 | ! This routine deallocates memory associated with the input/output |
---|
358 | ! {\tt String} argument {\tt str}. This amounts to deallocating |
---|
359 | ! {\tt str\%c}. |
---|
360 | ! |
---|
361 | ! !INTERFACE: |
---|
362 | |
---|
363 | subroutine clean_(str) |
---|
364 | |
---|
365 | ! !USES: |
---|
366 | ! |
---|
367 | use m_die, only : die,perr |
---|
368 | use m_mall,only : mall_mco,mall_ison |
---|
369 | |
---|
370 | implicit none |
---|
371 | |
---|
372 | ! !INPUT/OUTPUT PARAMETERS: |
---|
373 | ! |
---|
374 | type(String), intent(inout) :: str |
---|
375 | |
---|
376 | ! !REVISION HISTORY: |
---|
377 | ! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
378 | !EOP ___________________________________________________________________ |
---|
379 | |
---|
380 | character(len=*),parameter :: myname_=myname//'::clean_' |
---|
381 | integer :: ier |
---|
382 | |
---|
383 | if(mall_ison()) call mall_mco(str%c,myname) |
---|
384 | |
---|
385 | deallocate(str%c,stat=ier) |
---|
386 | if(ier /= 0) then |
---|
387 | call perr(myname_,'deallocate()',ier) |
---|
388 | call die(myname_) |
---|
389 | endif |
---|
390 | |
---|
391 | end subroutine clean_ |
---|
392 | |
---|
393 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
394 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
395 | !BOP ------------------------------------------------------------------- |
---|
396 | ! |
---|
397 | ! !IROUTINE: bcast_ - MPI Broadcast of a rank-0 String |
---|
398 | ! |
---|
399 | ! !DESCRIPTION: |
---|
400 | ! This routine performs an MPI broadcast of the input/output {\tt String} |
---|
401 | ! argument {\tt Str} on a communicator associated with the Fortran integer |
---|
402 | ! handle {\tt comm}. The broadcast originates from the process with rank |
---|
403 | ! given by {\tt root} on {\tt comm}. The {\tt String} argument {\tt Str} |
---|
404 | ! is on entry valid only on the {\tt root} process, and is valid on exit |
---|
405 | ! on all processes on the communicator {\tt comm}. The success (failure) |
---|
406 | ! is signified by a zero (non-zero) value of the optional {\tt INTEGER} |
---|
407 | ! output argument {\tt stat}. |
---|
408 | ! |
---|
409 | ! !INTERFACE: |
---|
410 | |
---|
411 | subroutine bcast_(Str, root, comm, stat) |
---|
412 | |
---|
413 | ! !USES: |
---|
414 | ! |
---|
415 | use m_mpif90 |
---|
416 | use m_die, only : perr,die |
---|
417 | use m_mall,only : mall_mci,mall_ison |
---|
418 | |
---|
419 | implicit none |
---|
420 | |
---|
421 | ! !INPUT PARAMETERS: |
---|
422 | ! |
---|
423 | integer, intent(in) :: root |
---|
424 | integer, intent(in) :: comm |
---|
425 | |
---|
426 | ! !INPUT/OUTPUT PARAMETERS: |
---|
427 | ! |
---|
428 | type(String), intent(inout) :: Str ! (IN) on the root, |
---|
429 | ! (OUT) elsewhere |
---|
430 | |
---|
431 | ! !OUTPUT PARAMETERS: |
---|
432 | ! |
---|
433 | integer, optional, intent(out) :: stat |
---|
434 | |
---|
435 | ! !REVISION HISTORY: |
---|
436 | ! 27Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
437 | !EOP ___________________________________________________________________ |
---|
438 | |
---|
439 | character(len=*),parameter :: myname_=myname//'::bcast_' |
---|
440 | integer :: ln,ier,myID |
---|
441 | |
---|
442 | if(present(stat)) stat=0 |
---|
443 | |
---|
444 | call MP_comm_rank(comm,myID,ier) |
---|
445 | if(ier /= 0) then |
---|
446 | call MP_perr(myname_,'MP_comm_rank()',ier) |
---|
447 | if(.not.present(stat)) call die(myname_) |
---|
448 | stat=ier |
---|
449 | return |
---|
450 | endif |
---|
451 | |
---|
452 | if(myID==root) then |
---|
453 | ln=size(Str%c) |
---|
454 | if(ln<=0) call die(myname_,'size(Str%c) <= 0') |
---|
455 | endif |
---|
456 | |
---|
457 | call MPI_bcast(ln,1,MP_INTEGER,root,comm,ier) |
---|
458 | if(ier/=0) then |
---|
459 | call MP_perr(myname_,'MPI_bcast(ln)',ier) |
---|
460 | if(.not.present(stat)) call die(myname_) |
---|
461 | stat=ier |
---|
462 | return |
---|
463 | endif |
---|
464 | |
---|
465 | if(myID /= root) then |
---|
466 | |
---|
467 | allocate(Str%c(ln),stat=ier) |
---|
468 | if(ier /= 0) then |
---|
469 | call perr(myname_,'allocate()',ier) |
---|
470 | if(.not.present(stat)) call die(myname_) |
---|
471 | stat=ier |
---|
472 | return |
---|
473 | endif |
---|
474 | |
---|
475 | if(mall_ison()) call mall_mci(Str%c,myname) |
---|
476 | endif |
---|
477 | |
---|
478 | call MPI_bcast(Str%c(1),ln,MP_CHARACTER,root,comm,ier) |
---|
479 | if(ier/=0) then |
---|
480 | call MP_perr(myname_,'MPI_bcast(Str%c)',ier) |
---|
481 | if(.not.present(stat)) call die(myname_) |
---|
482 | stat=ier |
---|
483 | return |
---|
484 | endif |
---|
485 | |
---|
486 | end subroutine bcast_ |
---|
487 | |
---|
488 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
489 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
490 | !BOP ------------------------------------------------------------------- |
---|
491 | ! |
---|
492 | ! !IROUTINE: mci0_ - checking in a String scalar |
---|
493 | ! |
---|
494 | ! !DESCRIPTION: |
---|
495 | ! |
---|
496 | ! !INTERFACE: |
---|
497 | |
---|
498 | subroutine mci0_(marg,thread) |
---|
499 | |
---|
500 | ! !USES: |
---|
501 | ! |
---|
502 | use m_mall, only : mall_ci |
---|
503 | |
---|
504 | implicit none |
---|
505 | |
---|
506 | ! !INPUT PARAMETERS: |
---|
507 | ! |
---|
508 | type(String), intent(in) :: marg |
---|
509 | character(len=*), intent(in) :: thread |
---|
510 | |
---|
511 | ! !REVISION HISTORY: |
---|
512 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
513 | ! - initial prototype/prolog/code |
---|
514 | !EOP ___________________________________________________________________ |
---|
515 | |
---|
516 | character(len=*),parameter :: myname_=myname//'::mci0_' |
---|
517 | |
---|
518 | call mall_ci(1,thread) |
---|
519 | |
---|
520 | end subroutine mci0_ |
---|
521 | |
---|
522 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
523 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
524 | !BOP ------------------------------------------------------------------- |
---|
525 | ! |
---|
526 | ! !IROUTINE: mco0_ - checking out a String scalar |
---|
527 | ! |
---|
528 | ! !DESCRIPTION: |
---|
529 | ! |
---|
530 | ! !INTERFACE: |
---|
531 | |
---|
532 | subroutine mco0_(marg,thread) |
---|
533 | |
---|
534 | ! !USES: |
---|
535 | ! |
---|
536 | use m_mall, only : mall_co |
---|
537 | |
---|
538 | implicit none |
---|
539 | |
---|
540 | type(String), intent(in) :: marg |
---|
541 | character(len=*),intent(in) :: thread |
---|
542 | |
---|
543 | ! !REVISION HISTORY: |
---|
544 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
545 | ! - initial prototype/prolog/code |
---|
546 | !EOP ___________________________________________________________________ |
---|
547 | |
---|
548 | character(len=*),parameter :: myname_=myname//'::mco0_' |
---|
549 | |
---|
550 | call mall_co(1,thread) |
---|
551 | |
---|
552 | end subroutine mco0_ |
---|
553 | |
---|
554 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
555 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
556 | !BOP ------------------------------------------------------------------- |
---|
557 | ! |
---|
558 | ! !IROUTINE: mci1_ - checking in a String scalar |
---|
559 | ! |
---|
560 | ! !DESCRIPTION: |
---|
561 | ! |
---|
562 | ! !INTERFACE: |
---|
563 | |
---|
564 | subroutine mci1_(marg,thread) |
---|
565 | |
---|
566 | ! !USES: |
---|
567 | ! |
---|
568 | use m_mall, only : mall_ci |
---|
569 | |
---|
570 | implicit none |
---|
571 | |
---|
572 | ! !INPUT PARAMETERS: |
---|
573 | ! |
---|
574 | type(String), dimension(:), intent(in) :: marg |
---|
575 | character(len=*), intent(in) :: thread |
---|
576 | |
---|
577 | ! !REVISION HISTORY: |
---|
578 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
579 | ! - initial prototype/prolog/code |
---|
580 | !EOP ___________________________________________________________________ |
---|
581 | |
---|
582 | character(len=*),parameter :: myname_=myname//'::mci1_' |
---|
583 | |
---|
584 | call mall_ci(size(marg),thread) |
---|
585 | |
---|
586 | end subroutine mci1_ |
---|
587 | |
---|
588 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
589 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
590 | !BOP ------------------------------------------------------------------- |
---|
591 | ! |
---|
592 | ! !IROUTINE: mco1_ - checking out a String scalar |
---|
593 | ! |
---|
594 | ! !DESCRIPTION: |
---|
595 | ! |
---|
596 | ! !INTERFACE: |
---|
597 | |
---|
598 | subroutine mco1_(marg,thread) |
---|
599 | |
---|
600 | ! !USES: |
---|
601 | ! |
---|
602 | use m_mall, only : mall_co |
---|
603 | |
---|
604 | implicit none |
---|
605 | |
---|
606 | ! !INPUT PARAMETERS: |
---|
607 | ! |
---|
608 | type(String), dimension(:), intent(in) :: marg |
---|
609 | character(len=*), intent(in) :: thread |
---|
610 | |
---|
611 | ! !REVISION HISTORY: |
---|
612 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
613 | ! - initial prototype/prolog/code |
---|
614 | !EOP ___________________________________________________________________ |
---|
615 | |
---|
616 | character(len=*),parameter :: myname_=myname//'::mco1_' |
---|
617 | |
---|
618 | call mall_co(size(marg),thread) |
---|
619 | |
---|
620 | end subroutine mco1_ |
---|
621 | |
---|
622 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
623 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
624 | !BOP ------------------------------------------------------------------- |
---|
625 | ! |
---|
626 | ! !IROUTINE: mci2_ - checking in a String scalar |
---|
627 | ! |
---|
628 | ! !DESCRIPTION: |
---|
629 | ! |
---|
630 | ! !INTERFACE: |
---|
631 | |
---|
632 | subroutine mci2_(marg, thread) |
---|
633 | |
---|
634 | ! !USES: |
---|
635 | ! |
---|
636 | use m_mall, only : mall_ci |
---|
637 | |
---|
638 | implicit none |
---|
639 | |
---|
640 | ! !INPUT PARAMETERS: |
---|
641 | ! |
---|
642 | type(String), dimension(:,:), intent(in) :: marg |
---|
643 | character(len=*), intent(in) :: thread |
---|
644 | |
---|
645 | ! !REVISION HISTORY: |
---|
646 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
647 | ! - initial prototype/prolog/code |
---|
648 | !EOP ___________________________________________________________________ |
---|
649 | |
---|
650 | character(len=*),parameter :: myname_=myname//'::mci2_' |
---|
651 | |
---|
652 | call mall_ci(size(marg),thread) |
---|
653 | |
---|
654 | end subroutine mci2_ |
---|
655 | |
---|
656 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
657 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
658 | !BOP ------------------------------------------------------------------- |
---|
659 | ! |
---|
660 | ! !IROUTINE: mco2_ - checking out a String scalar |
---|
661 | ! |
---|
662 | ! !DESCRIPTION: |
---|
663 | ! |
---|
664 | ! !INTERFACE: |
---|
665 | |
---|
666 | subroutine mco2_(marg,thread) |
---|
667 | |
---|
668 | ! !USES: |
---|
669 | ! |
---|
670 | use m_mall, only : mall_co |
---|
671 | |
---|
672 | implicit none |
---|
673 | |
---|
674 | ! !INPUT PARAMETERS: |
---|
675 | ! |
---|
676 | type(String), dimension(:,:), intent(in) :: marg |
---|
677 | character(len=*), intent(in) :: thread |
---|
678 | |
---|
679 | ! !REVISION HISTORY: |
---|
680 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
681 | ! - initial prototype/prolog/code |
---|
682 | !EOP ___________________________________________________________________ |
---|
683 | |
---|
684 | character(len=*),parameter :: myname_=myname//'::mco2_' |
---|
685 | |
---|
686 | call mall_co(size(marg),thread) |
---|
687 | |
---|
688 | end subroutine mco2_ |
---|
689 | |
---|
690 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
691 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
692 | !BOP ------------------------------------------------------------------- |
---|
693 | ! |
---|
694 | ! !IROUTINE: mci3_ - checking in a String scalar |
---|
695 | ! |
---|
696 | ! !DESCRIPTION: |
---|
697 | ! |
---|
698 | ! !INTERFACE: |
---|
699 | |
---|
700 | subroutine mci3_(marg,thread) |
---|
701 | |
---|
702 | ! !USES: |
---|
703 | ! |
---|
704 | use m_mall, only : mall_ci |
---|
705 | |
---|
706 | implicit none |
---|
707 | |
---|
708 | ! !INPUT PARAMETERS: |
---|
709 | ! |
---|
710 | type(String), dimension(:,:,:), intent(in) :: marg |
---|
711 | character(len=*), intent(in) :: thread |
---|
712 | |
---|
713 | ! !REVISION HISTORY: |
---|
714 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
715 | ! - initial prototype/prolog/code |
---|
716 | !EOP ___________________________________________________________________ |
---|
717 | |
---|
718 | character(len=*),parameter :: myname_=myname//'::mci3_' |
---|
719 | |
---|
720 | call mall_ci(size(marg),thread) |
---|
721 | |
---|
722 | end subroutine mci3_ |
---|
723 | |
---|
724 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
725 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
726 | !BOP ------------------------------------------------------------------- |
---|
727 | ! |
---|
728 | ! !IROUTINE: mco3_ - checking out a String scalar |
---|
729 | ! |
---|
730 | ! !DESCRIPTION: |
---|
731 | ! |
---|
732 | ! !INTERFACE: |
---|
733 | |
---|
734 | subroutine mco3_(marg,thread) |
---|
735 | |
---|
736 | ! !USES: |
---|
737 | ! |
---|
738 | use m_mall, only : mall_co |
---|
739 | |
---|
740 | implicit none |
---|
741 | |
---|
742 | ! !INPUT PARAMETERS: |
---|
743 | ! |
---|
744 | type(String), dimension(:,:,:), intent(in) :: marg |
---|
745 | character(len=*), intent(in) :: thread |
---|
746 | |
---|
747 | ! !REVISION HISTORY: |
---|
748 | ! 07Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
749 | ! - initial prototype/prolog/code |
---|
750 | !EOP ___________________________________________________________________ |
---|
751 | |
---|
752 | character(len=*),parameter :: myname_=myname//'::mco3_' |
---|
753 | |
---|
754 | call mall_co(size(marg),thread) |
---|
755 | |
---|
756 | end subroutine mco3_ |
---|
757 | |
---|
758 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
759 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
760 | !BOP ------------------------------------------------------------------- |
---|
761 | ! |
---|
762 | ! !IROUTINE: len_ = len of a String |
---|
763 | ! |
---|
764 | ! !DESCRIPTION: |
---|
765 | ! |
---|
766 | ! !INTERFACE: |
---|
767 | |
---|
768 | integer function len_(str) |
---|
769 | |
---|
770 | ! !USES: |
---|
771 | ! |
---|
772 | ! No external modules are used by this function. |
---|
773 | |
---|
774 | implicit none |
---|
775 | |
---|
776 | ! !INPUT PARAMETERS: |
---|
777 | ! |
---|
778 | type(String),intent(in) :: str |
---|
779 | |
---|
780 | ! !REVISION HISTORY: |
---|
781 | ! 10Apr00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
782 | ! - initial prototype/prolog/code |
---|
783 | !EOP ___________________________________________________________________ |
---|
784 | |
---|
785 | character(len=*),parameter :: myname_=myname//'::len_' |
---|
786 | |
---|
787 | len_=size(str%c) |
---|
788 | |
---|
789 | end function len_ |
---|
790 | |
---|
791 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
792 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
793 | !BOP ------------------------------------------------------------------- |
---|
794 | ! |
---|
795 | ! !IROUTINE: ptr_chars_ - direct |
---|
796 | ! |
---|
797 | ! !DESCRIPTION: |
---|
798 | ! This pointer-valued function provides a direct interface to the |
---|
799 | ! character buffer in the input {\tt String} argument {\tt str}. That |
---|
800 | ! is, {\tt ptr\_chars\_ => str\%c}. |
---|
801 | ! |
---|
802 | ! !INTERFACE: |
---|
803 | |
---|
804 | function ptr_chars_(str) |
---|
805 | |
---|
806 | ! !USES: |
---|
807 | ! |
---|
808 | ! No external modules are used by this function. |
---|
809 | |
---|
810 | implicit none |
---|
811 | |
---|
812 | ! !INPUT PARAMETERS: |
---|
813 | ! |
---|
814 | type(String), intent(in) :: str |
---|
815 | |
---|
816 | ! !OUTPUT PARAMETERS: |
---|
817 | ! |
---|
818 | character(len=1), dimension(:), pointer :: ptr_chars_ |
---|
819 | |
---|
820 | ! !REVISION HISTORY: |
---|
821 | ! 10Apr00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
822 | ! - initial prototype/prolog/code |
---|
823 | !EOP ___________________________________________________________________ |
---|
824 | |
---|
825 | character(len=*),parameter :: myname_=myname//'::ptr_chars_' |
---|
826 | |
---|
827 | ptr_chars_ => str%c |
---|
828 | |
---|
829 | end function ptr_chars_ |
---|
830 | |
---|
831 | end module m_String |
---|