← Back to branch summary

~ubuntu-branches/ubuntu/trusty/nwchem/trusty-proposed

« back to all changes in this revision

Viewing changes to src/nwdft/rt_tddft/input/rt_tddft_input_field.F

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Daniel Leidert, Andreas Tille, Michael Banck
  • Date: 2013-07-04 12:14:55 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130704121455-5tvsx2qabor3nrui
Tags: 6.3-1
http://bugs.debian.org/696361
* New upstream release.
* Fixes anisotropic properties (Closes: #696361).
* New features include:
  + Multi-reference coupled cluster (MRCC) approaches
  + Hybrid DFT calculations with short-range HF 
  + New density-functionals including Minnesota (M08, M11) and HSE hybrid
    functionals
  + X-ray absorption spectroscopy (XAS) with TDDFT
  + Analytical gradients for the COSMO solvation model
  + Transition densities from TDDFT 
  + DFT+U and Electron-Transfer (ET) methods for plane wave calculations
  + Exploitation of space group symmetry in plane wave geometry optimizations
  + Local density of states (LDOS) collective variable added to Metadynamics
  + Various new XC functionals added for plane wave calculations, including
    hybrid and range-corrected ones
  + Electric field gradients with relativistic corrections 
  + Nudged Elastic Band optimization method
  + Updated basis sets and ECPs 

[ Daniel Leidert ]
* debian/watch: Fixed.

[ Andreas Tille ]
* debian/upstream: References

[ Michael Banck ]
* debian/upstream (Name): New field.
* debian/patches/02_makefile_flags.patch: Refreshed.
* debian/patches/06_statfs_kfreebsd.patch: Likewise.
* debian/patches/07_ga_target_force_linux.patch: Likewise.
* debian/patches/05_avoid_inline_assembler.patch: Removed, no longer needed.
* debian/patches/09_backported_6.1.1_fixes.patch: Likewise.
* debian/control (Build-Depends): Added gfortran-4.7 and gcc-4.7.
* debian/patches/10_force_gcc-4.7.patch: New patch, explicitly sets
  gfortran-4.7 and gcc-4.7, fixes test suite hang with gcc-4.8 (Closes:
  #701328, #713262).
* debian/testsuite: Added tests for COSMO analytical gradients and MRCC.
* debian/rules (MRCC_METHODS): New variable, required to enable MRCC methods.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/nwdft/rt_tddft/input/rt_tddft_input_field.F
 
1
C
 
2
C     rt_tddft_input_field.F
 
3
C     
 
4
C     Parses input deck for rt-tddft field (excitation) parameters.
 
5
C     
 
6
C
 
7
      subroutine rt_tddft_input_field (rtdb, field_name, nfields)
 
8
      implicit none
 
9
 
 
10
#include "rt_tddft.fh"
 
11
#include "errquit.fh"
 
12
#include "inp.fh"
 
13
#include "rtdb.fh"
 
14
#include "mafdecls.fh"
 
15
#include "stdio.fh"
 
16
 
 
17
      
 
18
C     == Inputs ==
 
19
      integer, intent(in)      :: rtdb
 
20
      character*16, intent(in) :: field_name   !hardcoded to match geom name max size
 
21
      integer, intent(in)      :: nfields      !this is the number of the current field
 
22
 
 
23
 
 
24
C     == Parameters ==
 
25
      character(*), parameter :: pname = "rt_tddft_input_field: "
 
26
 
 
27
 
 
28
C     == Variables ==
 
29
      logical done
 
30
      character*255 test
 
31
      
 
32
      type (rt_field_t) prev_field, this_field
 
33
      integer i
 
34
 
 
35
      character*20 type
 
36
      character*20 spin
 
37
      character spin1
 
38
      double precision max
 
39
      double precision center
 
40
      double precision frequency
 
41
      double precision width
 
42
      double precision phase
 
43
      character*2 polarization  !x,y,z for dipole; xx,xy,xz,... for quad
 
44
 
 
45
 
 
46
      logical lhave_center
 
47
      logical lhave_polarization
 
48
      logical lhave_width
 
49
      logical lhave_max
 
50
      logical lhave_type
 
51
      logical lhave_frequency
 
52
      logical lhave_spin
 
53
      logical lhave_phase
 
54
 
 
55
      if (nfields .gt. rt_max_fields)
 
56
     $     call errquit (pname//"cannot exceed max num fields", 0, 0)
 
57
      
 
58
 
 
59
      lhave_center = .false.
 
60
      lhave_polarization = .false.
 
61
      lhave_width = .false.
 
62
      lhave_type = .false.
 
63
      lhave_frequency = .false.
 
64
      lhave_spin = .false.
 
65
      lhave_phase = .false.
 
66
 
 
67
      
 
68
C     
 
69
C     Parse the input; we will put in rtdb later after checking.
 
70
C     
 
71
      done = .false.
 
72
      do while (.not. done)
 
73
         
 
74
         if (.not. inp_read()) 
 
75
     $        call errquit(pname//'Read failed input',0, INPUT_ERR)
 
76
         if (.not. inp_a(test)) 
 
77
     $        call errquit(pname//'Read failed keyword',0, INPUT_ERR)
 
78
         
 
79
         
 
80
         
 
81
C     
 
82
C     type (delta, cw, gaussian)
 
83
C     
 
84
         if (inp_compare(.false.,test,'type')) then
 
85
            if (.not. inp_a (type))
 
86
     $           call errquit (pname//"failed to read field type",0,0)
 
87
            
 
88
            if ( (type.ne."cw").and.
 
89
     $           (type.ne."delta").and.
 
90
     $           (type.ne."hann").and.
 
91
     $           (type.ne."gaussian") )
 
92
     $           call errquit (pname//"invalid field type: "//type,0,0)
 
93
            
 
94
            lhave_type = .true.
 
95
            
 
96
            
 
97
C     
 
98
C     spin which the field acts on
 
99
C     
 
100
         elseif (inp_compare(.false.,test,'spin')) then
 
101
            if (.not. inp_a (spin))
 
102
     $           call errquit (pname//
 
103
     $           "failed to read field target spin",0,0)
 
104
 
 
105
            lhave_spin = .true.
 
106
 
 
107
 
 
108
 
 
109
C
 
110
C     max value of the field
 
111
C
 
112
         elseif (inp_compare(.false.,test,'max')) then
 
113
            if (.not.inp_f(max)) call errquit (pname//
 
114
     $           "max takes a float", 0, 0)
 
115
            lhave_max = .true.
 
116
 
 
117
C
 
118
C     center the field (only for gaussian and Hann)
 
119
C
 
120
         elseif (inp_compare(.false.,test,'center')) then
 
121
            if (.not.inp_f(center)) call errquit (pname//
 
122
     $           "center takes a float >= 0", 0, 0)
 
123
            lhave_center = .true.
 
124
 
 
125
 
 
126
C
 
127
C     width the field (only for gaussian and Hann)
 
128
C
 
129
         elseif (inp_compare(.false.,test,'width')) then
 
130
            if (.not.inp_f(width)) call errquit (pname//
 
131
     $           "width takes a float >= 0", 0, 0)
 
132
            lhave_width = .true.
 
133
 
 
134
 
 
135
C
 
136
C     frequency the field (only for gaussian and cw)
 
137
C
 
138
         elseif (inp_compare(.false.,test,'frequency')) then
 
139
            if (.not.inp_f(frequency)) call errquit (pname//
 
140
     $           "frequency takes a float >= 0", 0, 0)
 
141
            lhave_frequency = .true.
 
142
 
 
143
 
 
144
C
 
145
C     field polarization
 
146
C
 
147
         elseif (inp_compare(.false.,test,'polarization')) then
 
148
            if (.not.inp_a(polarization)) call errquit (pname//
 
149
     $           "polarization can be: x,y,z (for dipole); "//
 
150
     $           "xx,xy,xz,... (for quad)", 0, 0)
 
151
            lhave_polarization = .true.
 
152
 
 
153
 
 
154
 
 
155
C
 
156
C     phase (only for gaussian and cw)
 
157
C     
 
158
         elseif (inp_compare(.false.,test,'phase')) then
 
159
            if (.not.inp_f(phase)) call errquit (pname//
 
160
     $           "phase takes a float >= 0", 0, 0)
 
161
            lhave_phase = .true.
 
162
 
 
163
 
 
164
C     
 
165
C     end of parse
 
166
C     
 
167
         else if (inp_compare(.false.,test,'end')) then
 
168
            done = .true.
 
169
         else
 
170
            call errquit(pname//'Unknown directive: '//trim(test),
 
171
     $           0, INPUT_ERR)
 
172
         endif
 
173
 
 
174
 
 
175
CXXX  [KAL]: CHIRP
 
176
 
 
177
      enddo
 
178
 
 
179
      
 
180
C
 
181
C     Now check that we have all required parameters, no superfluous
 
182
C     ones, no name clashes with other fields, and that params are
 
183
C     reasonable (e.g., no negative times, etc).
 
184
C
 
185
 
 
186
      if (nfields .gt. 1) then
 
187
         do i = 1, nfields - 1
 
188
            call rt_tddft_field_rtdb_get (rtdb, i, prev_field)
 
189
            if (prev_field%name .eq. field_name)
 
190
     $           call errquit (pname//"cannot have multiple fields"//
 
191
     $           " with the same name: "//trim(field_name), 0, 0)
 
192
         enddo
 
193
      endif
 
194
      
 
195
 
 
196
      if (.not. lhave_type)
 
197
     $     call errquit (pname//trim(field_name)//
 
198
     $     ": must supply a field type", 0, 0)
 
199
 
 
200
      if (lhave_spin) then
 
201
         if (spin.eq."alpha") then 
 
202
            spin1 = "a"
 
203
         elseif (spin.eq."beta") then 
 
204
            spin1 = "b"
 
205
         elseif (spin.eq."total") then 
 
206
            spin1 = "t"
 
207
         else
 
208
            spin1 = "X"
 
209
            call errquit (pname//"invalid field spin: "//spin,0,0)
 
210
         endif
 
211
      else
 
212
         spin1 = "t"            !default to acting on all spins
 
213
      endif
 
214
 
 
215
      if (.not. lhave_spin) spin = "total" !default to acting on both spins
 
216
 
 
217
 
 
218
      if (.not. lhave_max)
 
219
     $     call errquit (pname//trim(field_name)//
 
220
     $     ": must supply a field max", 0, 0)
 
221
 
 
222
      if (.not. lhave_polarization)
 
223
     $     call errquit (pname//trim(field_name)//
 
224
     $     ": must supply a field polarization", 0,0)
 
225
 
 
226
      if (type .eq. "cw") then
 
227
         if (.not. lhave_frequency)
 
228
     $        call errquit (pname//trim(field_name)//
 
229
     $        ": must supply a frequency if doing cw", 0,0)
 
230
         
 
231
         if (lhave_center) call errquit (pname//trim(field_name)//
 
232
     $     ": cannot specify center if cw", 0,0)
 
233
 
 
234
         if (lhave_width) call errquit (pname//trim(field_name)//
 
235
     $     ": cannot specify width if cw", 0,0)
 
236
      endif
 
237
 
 
238
      if (type .eq. "gaussian") then
 
239
         if (.not. lhave_frequency)
 
240
     $        call errquit (pname//trim(field_name)//
 
241
     $        ": must supply a frequency if doing gaussian", 0,0)
 
242
 
 
243
         if (.not. lhave_center) call errquit (pname//trim(field_name)//
 
244
     $     ": must specify center if gaussian", 0,0)
 
245
 
 
246
         if (.not. lhave_width) call errquit (pname//trim(field_name)//
 
247
     $     ": must specify width if gaussian", 0,0)
 
248
      endif
 
249
 
 
250
      if (type .eq. "hann") then
 
251
         if (.not. lhave_frequency)
 
252
     $        call errquit (pname//trim(field_name)//
 
253
     $        ": must supply a frequency if doing Hann", 0,0)
 
254
 
 
255
         if (.not. lhave_center) call errquit (pname//trim(field_name)//
 
256
     $     ": must specify center if Hann", 0,0)
 
257
 
 
258
         if (.not. lhave_width) call errquit (pname//trim(field_name)//
 
259
     $     ": must specify width if Hann", 0,0)
 
260
      endif
 
261
 
 
262
 
 
263
      if (type .eq. "delta") then
 
264
         if (lhave_frequency) call errquit (pname//trim(field_name)//
 
265
     $     ": cannot supply a frequency if doing delta", 0,0)
 
266
 
 
267
         if (.not. lhave_center) then
 
268
            center = 0d0        !default delta kick to t=0
 
269
            lhave_center = .true.
 
270
         endif
 
271
 
 
272
 
 
273
c$$$         if (lhave_center) call errquit (pname//trim(field_name)//
 
274
c$$$     $     ": cannot specify center if delta", 0,0)
 
275
 
 
276
         if (lhave_width) call errquit (pname//trim(field_name)//
 
277
     $     ": cannot specify width if delta", 0,0)
 
278
      endif
 
279
 
 
280
      if ( (polarization.ne."x").and.
 
281
     $     (polarization.ne."y").and.
 
282
     $     (polarization.ne."z") )
 
283
     $     call errquit (pname//trim(field_name)//
 
284
     $     ": polarization must be x, y, or z (quads disabled for now)",
 
285
     $     0,0)
 
286
 
 
287
C      if ( (lhave_frequency).and.(frequency.lt.0d0) )
 
288
C     $     call errquit (pname//trim(field_name)//
 
289
C     $     ": frequency must be positive", 0, 0)
 
290
 
 
291
      if ( (lhave_center).and.(center.lt.0d0) )
 
292
     $     call errquit (pname//trim(field_name)//
 
293
     $     ": center must be positive", 0, 0)
 
294
 
 
295
      if ( (lhave_width).and.(width.lt.0d0) )
 
296
     $     call errquit (pname//trim(field_name)//
 
297
     $     ": width must be positive", 0, 0)
 
298
 
 
299
 
 
300
C     (no, its OK to have a negative "max")
 
301
C      if ( (lhave_max).and.(max.lt.0d0) )
 
302
C     $     call errquit (pname//trim(field_name)//
 
303
C     $     ": max must be positive", 0, 0)
 
304
 
 
305
 
 
306
C
 
307
C     Frequency-related stuff only valid for CW and pulses (gaussian, hann)
 
308
C
 
309
      if (lhave_phase .or. lhave_frequency) then
 
310
         if ((type .ne. "cw").and.(type .ne. "gaussian")
 
311
     $        .and. (type .ne. "hann")) call errquit (pname//
 
312
     $        "phase and frequency only valid for "//
 
313
     $        "CW, gaussian, and hann",0,0)
 
314
      endif
 
315
 
 
316
 
 
317
C
 
318
C     Load into rtdb
 
319
C
 
320
      this_field%name = field_name
 
321
      this_field%type = type
 
322
      this_field%polarization = polarization
 
323
      this_field%max = max
 
324
      this_field%spin = spin1
 
325
 
 
326
      if (type.eq."cw") then
 
327
         this_field%frequency = frequency
 
328
         this_field%phase = phase
 
329
         this_field%width = -99d0
 
330
         this_field%center = -99d0
 
331
      endif
 
332
 
 
333
      if (type.eq."gaussian") then
 
334
         this_field%frequency = frequency
 
335
         this_field%phase = phase
 
336
         this_field%width = width
 
337
         this_field%center = center
 
338
      endif
 
339
 
 
340
      if (type.eq."hann") then
 
341
         this_field%frequency = frequency
 
342
         this_field%phase = phase
 
343
         this_field%width = width
 
344
         this_field%center = center
 
345
      endif
 
346
 
 
347
      if (type.eq."delta") then
 
348
         this_field%frequency = -99d0
 
349
         this_field%width = -99d0
 
350
         this_field%center = center
 
351
      endif
 
352
 
 
353
      call rt_tddft_field_rtdb_put (rtdb, nfields, this_field)
 
354
 
 
355
      end subroutine 
 
356
 
 
357
 
 
358
C====================================================================
 
359
C
 
360
C     Generate entry name for field rtdb stuff (hack)
 
361
C
 
362
      subroutine rt_tddft_field_rtdb_entry_name (i, name)
 
363
      implicit none
 
364
 
 
365
#include "errquit.fh"
 
366
#include "rtdb.fh"
 
367
#include "mafdecls.fh"
 
368
#include "stdio.fh"
 
369
#include "rt_tddft.fh"
 
370
 
 
371
      
 
372
C     == Inputs ==
 
373
      integer, intent(in) :: i
 
374
 
 
375
      
 
376
C     == Outputs ==
 
377
      character(len=*), intent(out) :: name   !was 17
 
378
 
 
379
      
 
380
C     == Parameters ==
 
381
      character(len=*), parameter :: pname =
 
382
     $     "rt_tddft_field_rtdb_entry_name"
 
383
 
 
384
      
 
385
C     == Variables ==
 
386
      character*5 istring       !note length 5 limit size of int
 
387
 
 
388
      
 
389
      if ( (i .gt. rt_max_fields).or.(i .lt. 1) )
 
390
     $     call errquit(pname//"i must be between 1, rt_max_fields",0,0)
 
391
 
 
392
      if (rt_max_fields .gt. 999) call errquit(pname//
 
393
     $     "rt_max_fields too large; fix formatting", 0, 0)
 
394
 
 
395
      write (istring, "(i0.5)") i
 
396
      
 
397
      name = "rt_tddft:field_"//trim(istring)//"_"
 
398
 
 
399
      end subroutine
 
400
 
 
401
 
 
402
C====================================================================      
 
403
C
 
404
C     Load field into rtbd.  This is an ugly hack, but it's easier than
 
405
C     adding a custom struct to the rtdb routines.
 
406
C     
 
407
      subroutine rt_tddft_field_rtdb_put (rtdb, i, field)
 
408
      implicit none
 
409
 
 
410
#include "rt_tddft.fh"
 
411
#include "errquit.fh"
 
412
#include "rtdb.fh"
 
413
#include "mafdecls.fh"
 
414
#include "stdio.fh"
 
415
 
 
416
      
 
417
C     == Inputs ==
 
418
      integer, intent(in)          :: rtdb
 
419
      integer, intent(in)          :: i           !index for the field
 
420
      type(rt_field_t), intent(in) :: field
 
421
 
 
422
 
 
423
C     == Parameters ==
 
424
      character(len=*), parameter :: pname = "rt_tddft_field_rtdb_put: "
 
425
 
 
426
 
 
427
C     == Variables ==
 
428
      character*32 basename
 
429
      character*32 entry_name
 
430
 
 
431
      if ( (i .gt. rt_max_fields).or.(i .lt. 1) )
 
432
     $     call errquit(pname//"i must be between 1, rt_max_fields",0,0)
 
433
 
 
434
      call rt_tddft_field_rtdb_entry_name (i, basename)
 
435
 
 
436
      entry_name = trim(basename) // "name"
 
437
      if (.not.rtdb_cput(rtdb,entry_name,1,field%name))
 
438
     $     call errquit(pname//'Write failed to name rtdb',
 
439
     $     0,RTDB_ERR)
 
440
 
 
441
      entry_name = trim(basename) // "type"
 
442
      if (.not.rtdb_cput(rtdb,entry_name,1,field%type))
 
443
     $     call errquit(pname//'Write failed to type rtdb',
 
444
     $     0,RTDB_ERR)
 
445
 
 
446
      entry_name = trim(basename) // "polarization"
 
447
      if (.not.rtdb_cput(rtdb,entry_name,1,field%polarization))
 
448
     $     call errquit(pname//'Write failed to polarization rtdb',
 
449
     $     0,RTDB_ERR)
 
450
 
 
451
      entry_name = trim(basename) // "spin"
 
452
      if (.not.rtdb_cput(rtdb,entry_name,1,field%spin))
 
453
     $     call errquit(pname//'Write failed to spin rtdb',
 
454
     $     0,RTDB_ERR)
 
455
 
 
456
      entry_name = trim(basename) // "max"
 
457
      if (.not.rtdb_put(rtdb,entry_name,mt_dbl,1,field%max))
 
458
     $     call errquit(pname//'Write failed to max rtdb',0,RTDB_ERR)
 
459
 
 
460
      entry_name = trim(basename) // "frequency"
 
461
      if (.not.rtdb_put(rtdb,entry_name,mt_dbl,1,field%frequency))
 
462
     $     call errquit(pname//'Write failed to frequency rtdb',
 
463
     $     0,RTDB_ERR)
 
464
      
 
465
      entry_name = trim(basename) // "width"
 
466
      if (.not.rtdb_put(rtdb,entry_name,mt_dbl,1,field%width))
 
467
     $     call errquit(pname//'Write failed to width rtdb',
 
468
     $     0,RTDB_ERR)
 
469
      
 
470
      entry_name = trim(basename) // "center"
 
471
      if (.not.rtdb_put(rtdb,entry_name,mt_dbl,1,field%center))
 
472
     $        call errquit(pname//'Write failed to center rtdb',
 
473
     $     0,RTDB_ERR)
 
474
 
 
475
      entry_name = trim(basename) // "phase"
 
476
      if (.not.rtdb_put(rtdb,entry_name,mt_dbl,1,field%phase))
 
477
     $        call errquit(pname//'Write failed to phase rtdb',
 
478
     $     0,RTDB_ERR)
 
479
 
 
480
      end subroutine
 
481
 
 
482
      
 
483
 
 
484
C
 
485
C     Get field from rtdb and put into struct
 
486
C
 
487
      subroutine rt_tddft_field_rtdb_get (rtdb, i, field)
 
488
      implicit none
 
489
 
 
490
#include "rt_tddft.fh"
 
491
#include "errquit.fh"
 
492
#include "rtdb.fh"
 
493
#include "mafdecls.fh"
 
494
#include "stdio.fh"
 
495
 
 
496
      
 
497
C     == Inputs ==
 
498
      integer, intent(in) :: rtdb
 
499
      integer, intent(in) :: i                 !index for the field
 
500
 
 
501
      
 
502
C     == Outputs ==
 
503
      type(rt_field_t), intent(out) :: field
 
504
 
 
505
 
 
506
 
 
507
C     == Parameters ==
 
508
      character(len=*), parameter :: pname = "rt_tddft_field_rtdb_get: "
 
509
 
 
510
 
 
511
C     == Variables ==
 
512
      character*32 basename
 
513
      character*32 entry_name
 
514
 
 
515
 
 
516
      if ( (i .gt. rt_max_fields).or.(i .lt. 1) )
 
517
     $     call errquit(pname//"i must be between 1, rt_max_fields",0,0)
 
518
 
 
519
      call rt_tddft_field_rtdb_entry_name (i, basename)
 
520
 
 
521
      
 
522
      entry_name = trim(basename) // "name"
 
523
      if (.not.rtdb_cget(rtdb,entry_name,1,field%name))
 
524
     $     call errquit(pname//'Read failed for name rtdb',
 
525
     $     0,RTDB_ERR)
 
526
 
 
527
      entry_name = trim(basename) // "type"
 
528
      if (.not.rtdb_cget(rtdb,entry_name,1,field%type))
 
529
     $     call errquit(pname//'Read failed for type rtdb',
 
530
     $     0,RTDB_ERR)
 
531
 
 
532
      entry_name = trim(basename) // "polarization"
 
533
      if (.not.rtdb_cget(rtdb,entry_name,1,field%polarization))
 
534
     $     call errquit(pname//'Read failed for polarization rtdb',
 
535
     $     0,RTDB_ERR)
 
536
 
 
537
      entry_name = trim(basename) // "spin"
 
538
      if (.not.rtdb_cget(rtdb,entry_name,1,field%spin))
 
539
     $     call errquit(pname//'Read failed for spin rtdb',
 
540
     $     0,RTDB_ERR)
 
541
 
 
542
      entry_name = trim(basename) // "max"
 
543
      if (.not.rtdb_get(rtdb,entry_name,mt_dbl,1,field%max))
 
544
     $     call errquit(pname//'Read failed for max rtdb',0,RTDB_ERR)
 
545
 
 
546
      entry_name = trim(basename) // "frequency"
 
547
      if (.not.rtdb_get(rtdb,entry_name,mt_dbl,1,field%frequency))
 
548
     $     call errquit(pname//'Read failed for frequency rtdb',
 
549
     $     0,RTDB_ERR)
 
550
      
 
551
      entry_name = trim(basename) // "width"
 
552
      if (.not.rtdb_get(rtdb,entry_name,mt_dbl,1,field%width))
 
553
     $     call errquit(pname//'Read failed for width rtdb',
 
554
     $     0,RTDB_ERR)
 
555
      
 
556
      entry_name = trim(basename) // "center"
 
557
      if (.not.rtdb_get(rtdb,entry_name,mt_dbl,1,field%center))
 
558
     $        call errquit(pname//'Read failed for center rtdb',
 
559
     $     0,RTDB_ERR)
 
560
 
 
561
      entry_name = trim(basename) // "phase"
 
562
      if (.not.rtdb_get(rtdb,entry_name,mt_dbl,1,field%phase))
 
563
     $        call errquit(pname//'Read failed for phase rtdb',
 
564
     $     0,RTDB_ERR)
 
565
      
 
566
      end subroutine