ROMS
Loading...
Searching...
No Matches
Data Types | Functions/Subroutines | Variables
inp_decode_mod Module Reference

Data Types

interface  load_i
 
interface  load_l
 
interface  load_r
 
interface  load_s1d
 

Functions/Subroutines

integer function decode_line (line_text, keyword, nval, cval, rval)
 
logical function find_file (ng, out, fname, keyword)
 
integer function load_0d_i (ninp, vinp, nout, vout)
 
integer function load_1d_i (ninp, vinp, nout, vout)
 
integer function load_2d_i (ninp, vinp, iout, jout, vout)
 
integer function load_3d_i (ninp, vinp, iout, jout, kout, vout)
 
integer function load_0d_l (ninp, vinp, nout, vout)
 
integer function load_1d_l (ninp, vinp, nout, vout)
 
integer function load_2d_l (ninp, vinp, iout, jout, vout)
 
integer function load_3d_l (ninp, vinp, iout, jout, kout, vout)
 
integer function load_0d_dp (ninp, vinp, nout, vout)
 
integer function load_1d_dp (ninp, vinp, nout, vout)
 
integer function load_2d_dp (ninp, vinp, iout, jout, vout)
 
integer function load_3d_dp (ninp, vinp, iout, jout, kout, vout)
 
integer function load_0d_r8 (ninp, vinp, nout, vout)
 
integer function load_1d_r8 (ninp, vinp, nout, vout)
 
integer function load_2d_r8 (ninp, vinp, iout, jout, vout)
 
integer function load_3d_r8 (ninp, vinp, iout, jout, kout, vout)
 
integer function load_lbc (ninp, vinp, line, nline, ifield, igrid, itrcstr, itrcend, svname, s)
 
integer function load_s1d1 (nval, fname, fdim, line, label, igrid, mgrids, nfiles, io_type, s)
 
integer function load_s1d2 (nval, fname, fdim, line, label, igrid, mgrids, nfiles, idim, ie, io_type, s)
 
integer function load_s2d (nval, fname, fdim, line, label, ifile, igrid, mgrids, nfiles, ncount, idim, io_type, s)
 
integer function load_tadv (ninp, vinp, line, nline, itrc, igrid, itracer, itrcstr, itrcend, svname, s)
 

Variables

integer, parameter ncval = 200
 
integer, parameter nrval = 100
 

Function/Subroutine Documentation

◆ decode_line()

integer function inp_decode_mod::decode_line ( character (len=*), intent(in) line_text,
character (len=*), intent(inout) keyword,
integer, intent(inout) nval,
character (len=*), dimension(:), intent(inout) cval,
real(dp), dimension(:), intent(inout) rval )

Definition at line 96 of file inp_decode.F.

97!
98!***********************************************************************
99! !
100! This function decodes lines of text from input script files. It is !
101! to evaluate ROMS unique namelist parameters. !
102! !
103! Arguments: !
104! !
105! line_text Input scripts lines as text (string) !
106! KeyWord Input parameter keyword (string) !
107! Nval Number of values processed (integer) !
108! Cval Input values as characters (string array) !
109! Rval Input values as mumbers (real array) !
110! !
111!***********************************************************************
112!
113! Imported variable declarations.
114!
115 character (len=*), intent(in) :: line_text
116
117 character (len=*), intent(inout) :: KeyWord
118
119 integer, intent(inout) :: Nval
120
121 character (len=*), intent(inout) :: Cval(:)
122
123 real(dp), intent(inout) :: Rval(:)
124!
125! Local variable declarations
126!
127 logical :: IsString, Kextract, decode, nested
128 integer :: Iblank, Icomm, Icont, Ipipe, Kstr, Kend, Linp
129 integer :: Lend, LenS, Lstr, Lval, Nmul, Schar
130 integer :: copies, i, ic, ie, is, j, status
131
132 integer, dimension(20) :: Imul
133
134 integer :: decode_line
135
136 character (len=256) :: Vstring, inpline, line, string
137!
138!------------------------------------------------------------------------
139! Decode input line.
140!------------------------------------------------------------------------
141!
142! Initialize. Use CHAR(32) for blank space.
143!
144 line=char(32)
145 inpline=char(32)
146 vstring=char(32)
147 string=char(32)
148!! Lstr=LEN(line)
149!! DO i=1,Lstr
150!! line(i:i)=CHAR(32)
151!! inpline(i:i)=CHAR(32)
152!! Vstring(i:i)=CHAR(32)
153!! string(i:i)=CHAR(32)
154!! END DO
155!
156! Check input line and remove illegal characters. Replace control
157! ASCII characters CHAR(0) to CHAR(31) with a blank space, CHAR(32).
158!
159! Char Dec Key Control Action
160! ----------------------------------------------------------------------
161! NUL 0 ^@ Null character
162! SOH 1 ^A Start of heading, = console interrupt
163! STX 2 ^B Start of text, maintenance mode on HP console
164! ETX 3 ^C End of text
165! EOT 4 ^D End of transmission, not the same as ETB
166! ENQ 5 ^E Enquiry, goes with ACK; old HP flow control
167! ACK 6 ^F Acknowledge, clears ENQ logon hand
168! BEL 7 ^G Bell, rings the bell...
169! BS 8 ^H Backspace, works on HP terminals/computers
170! HT 9 ^I Horizontal tab, move to next tab stop
171! LF 10 ^J Line Feed
172! VT 11 ^K Vertical tab
173! FF 12 ^L Form Feed, page eject
174! CR 13 ^M Carriage Return
175! SO 14 ^N Shift Out, alternate character set
176! SI 15 ^O Shift In, resume defaultn character set
177! DLE 16 ^P Data link escape
178! DC1 17 ^Q XON, with XOFF to pause listings; ":okay to send".
179! DC2 18 ^R Device control 2, block-mode flow control
180! DC3 19 ^S XOFF, with XON is TERM=18 flow control
181! DC4 20 ^T Device control 4
182! NAK 21 ^U Negative acknowledge
183! SYN 22 ^V Synchronous idle
184! ETB 23 ^W End transmission block, not the same as EOT
185! CAN 24 ^X Cancel line, MPE echoes !!!
186! EM 25 ^Y End of medium, Control-Y interrupt
187! SUB 26 ^Z Substitute
188! ESC 27 ^[ Escape, next character is not echoed
189! FS 28 ^\ File separator
190! GS 29 ^] Group separator
191! RS 30 ^^ Record separator, block-mode terminator
192! US 31 ^_ Unit separator
193!
194! SP 32 Space
195! ! 33 Exclamation mark
196! # 35 Number sign, hash, or pound sign
197! * 42 Asterisk (star, multiply)
198! + 43 Plus
199! - 45 Hyphen, dash, minus
200! . 46 Period
201! 0 48 Zero
202! 1 49 One
203! 2 50 Two
204! 3 51 Three
205! 4 52 Four
206! 5 53 Five
207! 6 54 Six
208! 7 55 Seven
209! 8 56 Eight
210! 9 57 Nine
211! : 58 colon sign
212! = 61 Equals sign
213! \ 92 Reverse slant (Backslash)
214! | 124 Vertical line
215!
216 inpline=trim(adjustl(line_text))
217 linp=len_trim(inpline)
218 DO i=1,len_trim(inpline)
219 j=ichar(inpline(i:i))
220 IF (j.lt.32) THEN
221 inpline(i:i)=char(32) ! blank space
222 END IF
223 END DO
224 inpline=trim(inpline)
225!
226! Get length of "line". Remove comment after the KEYWORD, if any.
227! Then, remove leading and trailing blanks.
228!
229 IF ((linp.gt.0).and.(inpline(1:1).ne.char(33))) THEN
230 icomm=index(inpline,char(33),back=.false.)
231 IF (icomm.gt.0) linp=icomm-1
232 line=trim(adjustl(inpline(1:linp)))
233 linp=len_trim(line)
234 ELSE
235 line=trim(adjustl(inpline))
236 linp=len_trim(line)
237 END IF
238!
239! If not a blank or comment line [char(33)=!], decode and extract input
240! values. Find equal sign [char(61)].
241!
242 status=-1
243 nested=.false.
244 IF ((linp.gt.0).and.(line(1:1).ne.char(33))) THEN
245 status=1
246 kstr=1
247 kend=index(line,char(61),back=.false.)-1
248 lstr=index(line,char(61),back=.true.)+1
249!
250! Determine if KEYWORD is followed by double equal sign (==) indicating
251! nested parameter.
252!
253 IF ((lstr-kend).eq.3) nested=.true.
254!
255! Extract KEYWORD, trim leading and trailing blanks.
256!
257 kextract=.false.
258 IF (kend.gt.0) THEN
259 lend=linp
260 keyword=line(kstr:kend)
261 nval=0
262 kextract=.true.
263 ELSE
264 lstr=1
265 lend=linp
266 kextract=.true.
267 END IF
268!
269! Extract parameter values string. Remove continuation symbol
270! [char(92)=\] or multi-line value [char(124)=|], if any. Trim
271! leading trailing blanks.
272!
273 IF (kextract) THEN
274 icont=index(line,char(92 ),back=.false.)
275 ipipe=index(line,char(124),back=.false.)
276 IF (icont.gt.0) lend=icont-1
277 IF (ipipe.gt.0) lend=ipipe-1
278 vstring=adjustl(line(lstr:lend))
279 lval=len_trim(vstring)
280!
281! The TITLE KEYWORD is a special one since it can include strings,
282! numbers, spaces, and continuation symbol.
283!
284 isstring=.false.
285 IF (trim(keyword).eq.'TITLE') THEN
286 nval=nval+1
287 cval(nval)=vstring(1:lval)
288 isstring=.true.
289 ELSE
290!
291! Check if there is a multiplication symbol [char(42)=*] in the variable
292! string indicating repetition of input values.
293!
294 nmul=0
295 DO i=1,lval
296 IF (vstring(i:i).eq.char(42)) THEN
297 nmul=nmul+1
298 imul(nmul)=i
299 END IF
300 END DO
301 ic=1
302!
303! Check for blank spaces [char(32)=' '] between entries and decode.
304!
305 is=1
306 ie=lval
307 iblank=0
308 decode=.false.
309 DO i=1,lval
310 IF (vstring(i:i).eq.char(32)) THEN
311 IF (vstring(i+1:i+1).ne.char(32)) decode=.true.
312 iblank=i
313 ELSE
314 ie=i
315 ENDIF
316 IF (decode.or.(i.eq.lval)) THEN
317 nval=nval+1
318!
319! Processing numeric values. Check starting character to determine
320! if numeric or character values. It is possible to have both when
321! processing repetitions via the multiplication symbol.
322!
323 schar=ichar(vstring(is:is))
324 IF (((48.le.schar).and.(schar.le.57)).or. &
325 & (schar.eq.43).or.(schar.eq.45)) THEN
326 IF ((nmul.gt.0).and. &
327 & (is.lt.imul(ic)).and.(imul(ic).lt.ie)) THEN
328 READ (vstring(is:imul(ic)-1),*) copies
329 schar=ichar(vstring(imul(ic)+1:imul(ic)+1))
330 IF ((43.le.schar).and.(schar.le.57)) THEN
331 READ (vstring(imul(ic)+1:ie),*) rval(nval)
332 DO j=1,copies-1
333 rval(nval+j)=rval(nval)
334 END DO
335 ELSE
336 string=vstring(imul(ic)+1:ie)
337 lens=len_trim(string)
338 cval(nval)=string(1:lens)
339 DO j=1,copies-1
340 cval(nval+j)=cval(nval)
341 END DO
342 END IF
343 nval=nval+copies-1
344 ic=ic+1
345 ELSE
346 string=vstring(is:ie)
347 lens=len_trim(string)
348 READ (string(1:lens),*) rval(nval)
349 END IF
350 ELSE
351!
352! Processing character values (logicals and strings).
353!
354 IF ((nmul.gt.0).and. &
355 & (is.lt.imul(ic)).and.(imul(ic).lt.ie)) THEN
356 READ (vstring(is:imul(ic)-1),*) copies
357 cval(nval)=vstring(imul(ic)+1:ie)
358 DO j=1,copies-1
359 cval(nval+j)=cval(nval)
360 END DO
361 nval=nval+copies-1
362 ic=ic+1
363 ELSE
364 string=vstring(is:ie)
365 cval(nval)=trim(adjustl(string))
366 END IF
367 isstring=.true.
368 END IF
369 is=iblank+1
370 ie=lval
371 decode=.false.
372 END IF
373 END DO
374 END IF
375 END IF
376 status=nval
377 END IF
378 decode_line=status
379!
380 RETURN

References decode_line().

Referenced by decode_line(), and stdinp_mod::getpar_i::getpar_0d_i().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ find_file()

logical function inp_decode_mod::find_file ( integer, intent(in) ng,
integer, intent(in) out,
character (len=*), intent(in) fname,
character (len=*), intent(in) keyword )

Definition at line 383 of file inp_decode.F.

384!
385!***********************************************************************
386! !
387! This function checks if provided input file exits. !
388! !
389! On Input: !
390! !
391! ng Nested grid number !
392! out Standard output unit !
393! fname Filename (path and name) !
394! KeyWord Keyword associated with file name (string,OPTIONAL) !
395! !
396! On Output: !
397! !
398! foundit The value of the result is TRUE/FALSE if the file !
399! was found or not !
400! !
401!***********************************************************************
402!
403! Imported variable declarations.
404!
405 integer, intent(in) :: ng, out
406!
407 character (len=*), intent(in) :: fname
408 character (len=*), intent(in) :: KeyWord
409!
410! Local variable declarations.
411!
412 logical :: foundit, isURL
413!
414 integer :: lstr, ncid
415!
416 character (len=*), parameter :: MyFile = &
417 & __FILE__//", find_file"
418!
419 sourcefile=myfile
420!
421!-----------------------------------------------------------------------
422! Check if the file exit.
423!-----------------------------------------------------------------------
424!
425 foundit=.false.
426!
427! Check for empty file name string.
428!
429 lstr=len_trim(fname)
430 IF (lstr.eq.0) THEN
431 IF (master) THEN
432 WRITE (stdout,10) trim(keyword)
433 10 FORMAT (/,' FIND_FILE - empty file name string ', &
434 & 'for standard input script KeyWord: ',a)
435 END IF
436 exit_flag=5
437 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
438 END IF
439!
440! Check if provided file is a URL. This implies the file is a NetCDF
441! file on Data Access Protocol (DAP) server (like OPeNDAP).
442!
443 isurl=.false.
444 IF (index(trim(fname),'http:').ne.0) THEN
445 isurl=.true.
446 END IF
447!
448! Use F90 intrinsic function for non URL files.
449!
450 IF (.not.isurl) THEN
451 INQUIRE (file=trim(fname), exist=foundit)
452!
453! Use NetCDF library (version 4.1.1 or higher) to check URL NetCDF
454! files.
455!
456 ELSE
457 CALL netcdf_open (ng, inlm, fname, 0, ncid)
458 IF (exit_flag.eq.noerror) THEN
459 foundit=.true.
460 CALL netcdf_close (ng, inlm, ncid, fname, .false.)
461 END IF
462 END IF
463!
464! Report if not found.
465!
466 IF (.not.foundit) THEN
467 IF (master) WRITE (out,20) ng, trim(fname)
468 20 FORMAT (/,' FIND_FILE - Grid ',i2.2, &
469 & ', cannot find input file: ',a)
470 exit_flag=5
471 END IF
472!
473 RETURN

References mod_scalars::exit_flag, strings_mod::founderror(), mod_param::inlm, mod_parallel::master, mod_netcdf::netcdf_close(), mod_netcdf::netcdf_open(), mod_scalars::noerror, mod_iounits::sourcefile, and mod_iounits::stdout.

Here is the call graph for this function:

◆ load_0d_dp()

integer function inp_decode_mod::load_0d_dp ( integer, intent(in) ninp,
real(dp), dimension(:), intent(in) vinp,
integer, intent(in) nout,
real(dp), intent(out) vout )

Definition at line 1007 of file inp_decode.F.

1008!
1009!***********************************************************************
1010! !
1011! It loads input values into a requested model scalar double !
1012! precision variable when numerical kernel is in single precision. !
1013! !
1014! On Input: !
1015! !
1016! Ninp Number of input elements to process in Vinp (integer) !
1017! Vinp Input values (1D real(dp) array) !
1018! Nout Size of output integer variable dimension (not used) !
1019! !
1020! On Output: !
1021! !
1022! Vout Output scalar variable (real, KIND=dp) !
1023! Nval Number of output values processed !
1024! !
1025!=======================================================================
1026!
1027! Imported variable declarations.
1028!
1029 integer, intent(in) :: Ninp, Nout
1030 real(dp), intent(in) :: Vinp(:)
1031!
1032 real(dp), intent(out) :: Vout
1033!
1034! Local variable declarations.
1035!
1036 integer :: ic
1037 integer :: Nval
1038!
1039!-----------------------------------------------------------------------
1040! Load scalar floating-point variable with input value.
1041!-----------------------------------------------------------------------
1042!
1043 ic=1
1044 vout=vinp(ic)
1045 nval=ic
1046!
1047 RETURN

◆ load_0d_i()

integer function inp_decode_mod::load_0d_i ( integer, intent(in) ninp,
real(dp), dimension(:), intent(in) vinp,
integer, intent(in) nout,
integer, intent(out) vout )

Definition at line 476 of file inp_decode.F.

477!
478!***********************************************************************
479! !
480! It loads input values into a requested model scalar integer !
481! variable. !
482! !
483! On Input: !
484! !
485! Ninp Number of input elements to process in Vinp (integer) !
486! Vinp Input values (1D real(dp) array) !
487! Nout Size of output integer variable dimension (not used) !
488! !
489! On Output: !
490! !
491! Vout Output scalar integer variable !
492! Nval Number of output values processed !
493! !
494!***********************************************************************
495!
496! Imported variable declarations.
497!
498 integer, intent(in) :: Ninp, Nout
499 real(dp), intent(in) :: Vinp(:)
500!
501 integer, intent(out) :: Vout
502!
503! Local variable declarations.
504!
505 integer :: ic
506 integer :: Nval
507!
508!-----------------------------------------------------------------------
509! Load scalar integer variable with input value.
510!-----------------------------------------------------------------------
511!
512 ic=1
513 vout=int(vinp(ic))
514 nval=ic
515
516 RETURN

◆ load_0d_l()

integer function inp_decode_mod::load_0d_l ( integer, intent(in) ninp,
character (len=*), dimension(:), intent(in) vinp,
integer, intent(in) nout,
logical, intent(out) vout )

Definition at line 717 of file inp_decode.F.

718!
719!***********************************************************************
720! !
721! It loads input values into a requested model scalar logical !
722! variable. !
723! !
724! On Input: !
725! !
726! Ninp Number of input elements to process in Vinp (integer) !
727! Vinp Input values (character 1D array) !
728! Nout Size of output logical variable dimension (not used) !
729! !
730! On Output: !
731! !
732! Vout Output scalar logical variable !
733! Nval Number of output values processed !
734! !
735!***********************************************************************
736!
737! Imported variable declarations.
738!
739 integer, intent(in) :: Ninp, Nout
740 character (len=*), intent(in) :: Vinp(:)
741!
742 logical, intent(out) :: Vout
743!
744! Local variable declarations.
745!
746 integer :: ic
747 integer :: Nval
748!
749!-----------------------------------------------------------------------
750! Load scalar logical variable with input value.
751!-----------------------------------------------------------------------
752!
753 ic=1
754 IF ((vinp(ic)(1:1).eq.'T').or. &
755 & (vinp(ic)(1:1).eq.'t')) THEN
756 vout=.true.
757 ELSE
758 vout=.false.
759 END IF
760 nval=ic
761!
762 RETURN

◆ load_0d_r8()

integer function inp_decode_mod::load_0d_r8 ( integer, intent(in) ninp,
real(dp), dimension(:), intent(in) vinp,
integer, intent(in) nout,
real(r8), intent(out) vout )

Definition at line 1252 of file inp_decode.F.

1253!
1254!=======================================================================
1255! !
1256! It loads input values into a requested model scalar floating-point !
1257! variable (KIND=r8). !
1258! !
1259! On Input: !
1260! !
1261! Ninp Number of input elements to process in Vinp (integer) !
1262! Vinp Input values (1D real(dp) array) !
1263! Nout Size of output integer variable dimension (not used) !
1264! !
1265! On Output: !
1266! !
1267! Vout Output scalar variable (real, KIND=r8) !
1268! Nval Number of output values processed !
1269! !
1270!=======================================================================
1271!
1272! Imported variable declarations.
1273!
1274 integer, intent(in) :: Ninp, Nout
1275 real(dp), intent(in) :: Vinp(:)
1276!
1277 real(r8), intent(out) :: Vout
1278!
1279! Local variable declarations.
1280!
1281 integer :: ic
1282 integer :: Nval
1283!
1284!-----------------------------------------------------------------------
1285! Load scalar floating-point variable with input value.
1286!-----------------------------------------------------------------------
1287!
1288 ic=1
1289#ifdef SINGLE_PRECISION
1290 vout=real(vinp(ic),r8)
1291#else
1292 vout=vinp(ic)
1293#endif
1294 nval=ic
1295!
1296 RETURN

◆ load_1d_dp()

integer function inp_decode_mod::load_1d_dp ( integer, intent(in) ninp,
real(dp), dimension(:), intent(in) vinp,
integer, intent(in) nout,
real(dp), dimension(:), intent(out) vout )

Definition at line 1050 of file inp_decode.F.

1051!
1052!***********************************************************************
1053! !
1054! It loads input values into a requested model 1D double precision !
1055! array when numerical kernel is in single precision. !
1056! !
1057! On Input: !
1058! !
1059! Ninp Number of input elements to process in Vinp (integer) !
1060! Vinp Input values (1D real(dp) array) !
1061! Nout Size of output integer variable dimension !
1062! !
1063! On Output: !
1064! !
1065! Vout Output 1D variable (real, KIND=dp) !
1066! Nval Number of output values processed !
1067! !
1068!=======================================================================
1069!
1070! Imported variable declarations.
1071!
1072 integer, intent(in) :: Ninp, Nout
1073 real(dp), intent(in) :: Vinp(:)
1074!
1075 real(dp), intent(out) :: Vout(:)
1076!
1077! Local variable declarations.
1078!
1079 integer :: Nstr, i, ic
1080 integer :: Nval
1081!
1082!-----------------------------------------------------------------------
1083! Load 1D floating-point variable with input values.
1084!-----------------------------------------------------------------------
1085!
1086! If not all values are provided for variable, assume the last value
1087! for the rest of the array.
1088!
1089 ic=0
1090 IF (ninp.le.nout) THEN
1091 DO i=1,ninp
1092 ic=ic+1
1093 vout(i)=vinp(i)
1094 END DO
1095 IF (nout.gt.ninp) THEN
1096 nstr=ninp+1
1097 DO i=nstr,nout
1098 ic=ic+1
1099 vout(i)=vinp(ninp)
1100 END DO
1101 END IF
1102 ELSE
1103 DO i=1,nout
1104 ic=ic+1
1105 vout(i)=vinp(i)
1106 END DO
1107 END IF
1108 nval=ic
1109!
1110 RETURN

◆ load_1d_i()

integer function inp_decode_mod::load_1d_i ( integer, intent(in) ninp,
real(dp), dimension(:), intent(in) vinp,
integer, intent(in) nout,
integer, dimension(:), intent(out) vout )

Definition at line 519 of file inp_decode.F.

520!
521!***********************************************************************
522! !
523! It loads input values into a requested model 1D integer array. !
524! !
525! On Input: !
526! !
527! Ninp Number of input elements to process in Vinp (integer) !
528! Vinp Input values (1D real(dp) array) !
529! Nout Size of output integer variable dimension !
530! !
531! On Output: !
532! !
533! Vout Output 1D integer variable !
534! Nval Number of output values processed !
535! !
536!***********************************************************************
537!
538! Imported variable declarations.
539!
540 integer, intent(in) :: Ninp, Nout
541 real(dp), intent(in) :: Vinp(:)
542!
543 integer, intent(out) :: Vout(:)
544!
545! Local variable declarations.
546!
547 integer :: Nstr, i, ic
548 integer :: Nval
549!
550!-----------------------------------------------------------------------
551! Load 1D integer variable with input values.
552!-----------------------------------------------------------------------
553!
554! If not all values are provided for variable, assume the last value
555! for the rest of the array.
556!
557 ic=0
558 IF (ninp.le.nout) THEN
559 DO i=1,ninp
560 ic=ic+1
561 vout(i)=int(vinp(i))
562 END DO
563 IF (nout.gt.ninp) THEN
564 nstr=ninp+1
565 DO i=nstr,nout
566 ic=ic+1
567 vout(i)=int(vinp(ninp))
568 END DO
569 END IF
570 ELSE
571 DO i=1,nout
572 ic=ic+1
573 vout(i)=int(vinp(i))
574 END DO
575 END IF
576 nval=ic
577
578 RETURN

◆ load_1d_l()

integer function inp_decode_mod::load_1d_l ( integer, intent(in) ninp,
character (len=*), dimension(:), intent(in) vinp,
integer, intent(in) nout,
logical, dimension(:), intent(out) vout )

Definition at line 765 of file inp_decode.F.

766!
767!***********************************************************************
768! !
769! It loads input values into a requested model 1D logical array. !
770! !
771! On Input: !
772! !
773! Ninp Number of input elements to process in Vinp (integer) !
774! Vinp Input values (character 1D array) !
775! Nout Size of output logical variable dimension !
776! !
777! On Output: !
778! !
779! Vout Output 1D logical variable !
780! Nval Number of output values processed !
781! !
782!***********************************************************************
783!
784! Imported variable declarations.
785!
786 integer, intent(in) :: Ninp, Nout
787 character (len=*), intent(in) :: Vinp(:)
788!
789 logical, intent(out) :: Vout(:)
790!
791! Local variable declarations.
792!
793 logical :: LastValue
794
795 integer :: Nstr, i, ic
796 integer :: Nval
797!
798!-----------------------------------------------------------------------
799! Load logical variable with input values.
800!-----------------------------------------------------------------------
801!
802! If not all values are provided for variable, assume the last value
803! for the rest of the array.
804!
805 ic=0
806 lastvalue=.false.
807 IF (ninp.le.nout) THEN
808 DO i=1,ninp
809 ic=ic+1
810 IF ((vinp(i)(1:1).eq.'T').or. &
811 & (vinp(i)(1:1).eq.'t')) THEN
812 vout(i)=.true.
813 ELSE
814 vout(i)=.false.
815 END IF
816 lastvalue=vout(i)
817 END DO
818 IF (nout.gt.ninp) THEN
819 nstr=ninp+1
820 DO i=nstr,nout
821 ic=ic+1
822 vout(i)=lastvalue
823 END DO
824 END IF
825 ELSE
826 DO i=1,nout
827 ic=ic+1
828 IF ((vinp(i)(1:1).eq.'T').or. &
829 & (vinp(i)(1:1).eq.'t')) THEN
830 vout(i)=.true.
831 ELSE
832 vout(i)=.false.
833 END IF
834 END DO
835 END IF
836 nval=ic
837!
838 RETURN

◆ load_1d_r8()

integer function inp_decode_mod::load_1d_r8 ( integer, intent(in) ninp,
real(dp), dimension(:), intent(in) vinp,
integer, intent(in) nout,
real(r8), dimension(:), intent(out) vout )

Definition at line 1299 of file inp_decode.F.

1300!
1301!=======================================================================
1302! !
1303! It loads input values into a requested model 1D floating-point !
1304! array (KIND=r8). !
1305! !
1306! On Input: !
1307! !
1308! Ninp Number of input elements to process in Vinp (integer) !
1309! Vinp Input values (1D real(dp) array) !
1310! Nout Size of output integer variable dimension !
1311! !
1312! On Output: !
1313! !
1314! Vout Output 1D variable (real, KIND=r8) !
1315! Nval Number of output values processed !
1316! !
1317!=======================================================================
1318!
1319! Imported variable declarations.
1320!
1321 integer, intent(in) :: Ninp, Nout
1322 real(dp), intent(in) :: Vinp(:)
1323!
1324 real(r8), intent(out) :: Vout(:)
1325!
1326! Local variable declarations.
1327!
1328 integer :: Nstr, i, ic
1329 integer :: Nval
1330!
1331!-----------------------------------------------------------------------
1332! Load 1D floating-point variable with input values.
1333!-----------------------------------------------------------------------
1334!
1335! If not all values are provided for variable, assume the last value
1336! for the rest of the array.
1337!
1338 ic=0
1339 IF (ninp.le.nout) THEN
1340 DO i=1,ninp
1341 ic=ic+1
1342#ifdef SINGLE_PRECISION
1343 vout(i)=real(vinp(i),r8)
1344#else
1345 vout(i)=vinp(i)
1346#endif
1347 END DO
1348 IF (nout.gt.ninp) THEN
1349 nstr=ninp+1
1350 DO i=nstr,nout
1351 ic=ic+1
1352#ifdef SINGLE_PRECISION
1353 vout(i)=real(vinp(ninp),r8)
1354#else
1355 vout(i)=vinp(ninp)
1356#endif
1357 END DO
1358 END IF
1359 ELSE
1360 DO i=1,nout
1361 ic=ic+1
1362#ifdef SINGLE_PRECISION
1363 vout(i)=real(vinp(i),r8)
1364#else
1365 vout(i)=vinp(i)
1366#endif
1367 END DO
1368 END IF
1369 nval=ic
1370!
1371 RETURN

◆ load_2d_dp()

integer function inp_decode_mod::load_2d_dp ( integer, intent(in) ninp,
real(dp), dimension(:), intent(in) vinp,
integer, intent(in) iout,
integer, intent(in) jout,
real(dp), dimension(:,:), intent(out) vout )

Definition at line 1113 of file inp_decode.F.

1114!
1115!***********************************************************************
1116! !
1117! It loads input values into a requested model 2D double precision !
1118! array when numerical kernel is in single precision. !
1119! !
1120! On Input: !
1121! !
1122! Ninp Number of input elements to process in Vinp (integer) !
1123! Vinp Input values (1D real(dp) array) !
1124! Iout Size of output integer variable first I-dimension !
1125! Jout Size of output integer variable second J-dimension !
1126! !
1127! On Output: !
1128! !
1129! Vout Output 2D variable (real, KIND=dp) !
1130! Nval Number of output values processed !
1131! !
1132!=======================================================================
1133!
1134! Imported variable declarations.
1135!
1136 integer, intent(in) :: Ninp, Iout, Jout
1137 real(dp), intent(in) :: Vinp(:)
1138!
1139 real(dp), intent(out) :: Vout(:,:)
1140!
1141! Local variable declarations.
1142!
1143 integer :: Nstr, i, ic
1144 integer :: Nout, Nval
1145!
1146 real(dp), dimension(Iout*Jout) :: Vwrk
1147!
1148!-----------------------------------------------------------------------
1149! Load 2D floating-point variable with input values.
1150!-----------------------------------------------------------------------
1151!
1152! If not all values are provided for variable, assume the last value
1153! for the rest of the array.
1154!
1155 ic=0
1156 nout=iout*jout
1157 IF (ninp.le.nout) THEN
1158 DO i=1,ninp
1159 ic=ic+1
1160 vwrk(i)=vinp(i)
1161 END DO
1162 IF (nout.gt.ninp) THEN
1163 nstr=ninp+1
1164 DO i=nstr,nout
1165 ic=ic+1
1166 vwrk(i)=vinp(ninp)
1167 END DO
1168 END IF
1169 ELSE
1170 DO i=1,nout
1171 ic=ic+1
1172 vwrk(i)=vinp(i)
1173 END DO
1174 END IF
1175 vout=reshape(vwrk,(/iout,jout/))
1176 nval=ic
1177!
1178 RETURN

◆ load_2d_i()

integer function inp_decode_mod::load_2d_i ( integer, intent(in) ninp,
real(dp), dimension(:), intent(in) vinp,
integer, intent(in) iout,
integer, intent(in) jout,
integer, dimension(:,:), intent(out) vout )

Definition at line 581 of file inp_decode.F.

582!
583!***********************************************************************
584! !
585! It loads input values into a requested model 2D integer array. !
586! !
587! On Input: !
588! !
589! Ninp Number of input elements to process in Vinp (integer) !
590! Vinp Input values (1D real(dp) array) !
591! Iout Size of output integer variable first I-dimension !
592! Jout Size of output integer variable second J-dimension !
593! !
594! On Output: !
595! !
596! Vout Output 2D integer variable !
597! Nval Number of output values processed !
598! !
599!***********************************************************************
600!
601! Imported variable declarations.
602!
603 integer, intent(in) :: Ninp, Iout, Jout
604 real(dp), intent(in) :: Vinp(:)
605!
606 integer, intent(out) :: Vout(:,:)
607!
608! Local variable declarations.
609!
610 integer :: Nstr, i, ic
611 integer :: Nout, Nval
612!
613 integer, dimension(Iout*Jout) :: Vwrk
614!
615!-----------------------------------------------------------------------
616! Load 2D integer variable with input values.
617!-----------------------------------------------------------------------
618!
619! If not all values are provided for variable, assume the last value
620! for the rest of the 2D array.
621!
622 ic=0
623 nout=iout*jout
624 IF (ninp.le.nout) THEN
625 DO i=1,ninp
626 ic=ic+1
627 vwrk(i)=int(vinp(i))
628 END DO
629 IF (nout.gt.ninp) THEN
630 nstr=ninp+1
631 DO i=nstr,nout
632 ic=ic+1
633 vwrk(i)=int(vinp(ninp))
634 END DO
635 END IF
636 ELSE
637 DO i=1,nout
638 ic=ic+1
639 vwrk(i)=int(vinp(i))
640 END DO
641 END IF
642 vout=reshape(vwrk,(/iout,jout/))
643 nval=ic
644!
645 RETURN

◆ load_2d_l()

integer function inp_decode_mod::load_2d_l ( integer, intent(in) ninp,
character (len=*), dimension(:), intent(in) vinp,
integer, intent(in) iout,
integer, intent(in) jout,
logical, dimension(:,:), intent(out) vout )

Definition at line 841 of file inp_decode.F.

842!
843!***********************************************************************
844! !
845! It loads input values into a requested model 2D logical array. !
846! !
847! On Input: !
848! !
849! Ninp Number of input elements to process in Vinp (integer) !
850! Vinp Input values (character 1D array) !
851! Iout Size of output logical variable first I-dimension !
852! Jout Size of output logical variable second J-dimension !
853! !
854! On Output: !
855! !
856! Vout Output 2D logical variable !
857! Nval Number of output values processed !
858! !
859!***********************************************************************
860!
861! Imported variable declarations.
862!
863 integer, intent(in) :: Ninp, Iout, Jout
864 character (len=*), intent(in) :: Vinp(:)
865!
866 logical, intent(out) :: Vout(:,:)
867!
868! Local variable declarations.
869!
870 logical :: LastValue
871!
872 logical, dimension(Iout*Jout) :: Vwrk
873!
874 integer :: Nstr, i, ic
875 integer :: Nout, Nval
876!
877!-----------------------------------------------------------------------
878! Load 2D logical variable with input values.
879!-----------------------------------------------------------------------
880!
881! If not all values are provided for variable, assume the last value
882! for the rest of the array.
883!
884 ic=0
885 nout=iout*jout
886 lastvalue=.false.
887 IF (ninp.le.nout) THEN
888 DO i=1,ninp
889 ic=ic+1
890 IF ((vinp(i)(1:1).eq.'T').or. &
891 & (vinp(i)(1:1).eq.'t')) THEN
892 vwrk(i)=.true.
893 ELSE
894 vwrk(i)=.false.
895 END IF
896 lastvalue=vwrk(i)
897 END DO
898 IF (nout.gt.ninp) THEN
899 nstr=ninp+1
900 DO i=nstr,nout
901 ic=ic+1
902 vwrk(i)=lastvalue
903 END DO
904 END IF
905 ELSE
906 DO i=1,nout
907 ic=ic+1
908 IF ((vinp(i)(1:1).eq.'T').or. &
909 & (vinp(i)(1:1).eq.'t')) THEN
910 vwrk(i)=.true.
911 ELSE
912 vwrk(i)=.false.
913 END IF
914 END DO
915 END IF
916 vout=reshape(vwrk,(/iout,jout/))
917 nval=ic
918!
919 RETURN

◆ load_2d_r8()

integer function inp_decode_mod::load_2d_r8 ( integer, intent(in) ninp,
real(dp), dimension(:), intent(in) vinp,
integer, intent(in) iout,
integer, intent(in) jout,
real(r8), dimension(:,:), intent(out) vout )

Definition at line 1374 of file inp_decode.F.

1375!
1376!***********************************************************************
1377! !
1378! It loads input values into a requested model 2D floating-point !
1379! array (KIND=r8). !
1380! !
1381! On Input: !
1382! !
1383! Ninp Number of input elements to process in Vinp (integer) !
1384! Vinp Input values (1D real(dp) array) !
1385! Iout Size of output integer variable first I-dimension !
1386! Jout Size of output integer variable second J-dimension !
1387! !
1388! On Output: !
1389! !
1390! Vout Output 2D variable (real, KIND=r8) !
1391! Nval Number of output values processed !
1392! !
1393!=======================================================================
1394!
1395! Imported variable declarations.
1396!
1397 integer, intent(in) :: Ninp, Iout, Jout
1398 real(dp), intent(in) :: Vinp(:)
1399!
1400 real(r8), intent(out) :: Vout(:,:)
1401!
1402! Local variable declarations.
1403!
1404 integer :: Nstr, i, ic
1405 integer :: Nout, Nval
1406!
1407 real(r8), dimension(Iout*Jout) :: Vwrk
1408!
1409!-----------------------------------------------------------------------
1410! Load 2D floating-point variable with input values.
1411!-----------------------------------------------------------------------
1412!
1413! If not all values are provided for variable, assume the last value
1414! for the rest of the array.
1415!
1416 ic=0
1417 nout=iout*jout
1418 IF (ninp.le.nout) THEN
1419 DO i=1,ninp
1420 ic=ic+1
1421#ifdef SINGLE_PRECISION
1422 vwrk(i)=real(vinp(i),r8)
1423#else
1424 vwrk(i)=vinp(i)
1425#endif
1426 END DO
1427 IF (nout.gt.ninp) THEN
1428 nstr=ninp+1
1429 DO i=nstr,nout
1430 ic=ic+1
1431#ifdef SINGLE_PRECISION
1432 vwrk(i)=real(vinp(ninp),r8)
1433#else
1434 vwrk(i)=vinp(ninp)
1435#endif
1436 END DO
1437 END IF
1438 ELSE
1439 DO i=1,nout
1440 ic=ic+1
1441#ifdef SINGLE_PRECISION
1442 vwrk(i)=real(vinp(i),r8)
1443#else
1444 vwrk(i)=vinp(i)
1445#endif
1446 END DO
1447 END IF
1448 vout=reshape(vwrk,(/iout,jout/))
1449 nval=ic
1450!
1451 RETURN

◆ load_3d_dp()

integer function inp_decode_mod::load_3d_dp ( integer, intent(in) ninp,
real(dp), dimension(:), intent(in) vinp,
integer, intent(in) iout,
integer, intent(in) jout,
integer, intent(in) kout,
real(dp), dimension(:,:,:), intent(out) vout )

Definition at line 1181 of file inp_decode.F.

1183!
1184!***********************************************************************
1185! !
1186! It loads input values into a requested model 3D double precision !
1187! array when numerical kernel is in single precision. !
1188! !
1189! On Input: !
1190! !
1191! Ninp Number of input elements to process in Vinp (integer) !
1192! Vinp Input values (1D real(dp) array) !
1193! Iout Size of output integer variable first I-dimension !
1194! Jout Size of output integer variable second J-dimension !
1195! Kout Size of output integer variable third K-dimension !
1196! !
1197! On Output: !
1198! !
1199! Vout Output 3D variable (real, KIND=dp) !
1200! Nval Number of output values processed !
1201! !
1202!=======================================================================
1203!
1204! Imported variable declarations.
1205!
1206 integer, intent(in) :: Ninp, Iout, Jout, Kout
1207 real(dp), intent(in) :: Vinp(:)
1208!
1209 real(dp), intent(out) :: Vout(:,:,:)
1210!
1211! Local variable declarations.
1212!
1213 integer :: Nstr, i, ic
1214 integer :: Nout, Nval
1215!
1216 real(dp), dimension(Iout*Jout*Kout) :: Vwrk
1217!
1218!-----------------------------------------------------------------------
1219! Load 3D floating-point variable with input values.
1220!-----------------------------------------------------------------------
1221!
1222! If not all values are provided for variable, assume the last value
1223! for the rest of the array.
1224!
1225 ic=0
1226 nout=iout*jout*kout
1227 IF (ninp.le.nout) THEN
1228 DO i=1,ninp
1229 ic=ic+1
1230 vwrk(i)=vinp(i)
1231 END DO
1232 IF (nout.gt.ninp) THEN
1233 nstr=ninp+1
1234 DO i=nstr,nout
1235 ic=ic+1
1236 vwrk(i)=vinp(ninp)
1237 END DO
1238 END IF
1239 ELSE
1240 DO i=1,nout
1241 ic=ic+1
1242 vwrk(i)=vinp(i)
1243 END DO
1244 END IF
1245 vout=reshape(vwrk,(/iout,jout,kout/))
1246 nval=ic
1247!
1248 RETURN

◆ load_3d_i()

integer function inp_decode_mod::load_3d_i ( integer, intent(in) ninp,
real(dp), dimension(:), intent(in) vinp,
integer, intent(in) iout,
integer, intent(in) jout,
integer, intent(in) kout,
integer, dimension(:,:,:), intent(out) vout )

Definition at line 648 of file inp_decode.F.

650!
651!***********************************************************************
652! !
653! It loads input values into a requested model 3D integer array. !
654! !
655! On Input: !
656! !
657! Ninp Number of input elements to process in Vinp (integer) !
658! Vinp Input values (1D real(dp) array) !
659! Iout Size of output integer variable first I-dimension !
660! Jout Size of output integer variable second J-dimension !
661! Kout Size of output integer variable third K-dimension !
662! !
663! On Output: !
664! !
665! Vout Output 3D integer variable !
666! Nval Number of output values processed !
667! !
668!***********************************************************************
669!
670! Imported variable declarations.
671!
672 integer, intent(in) :: Ninp, Iout, Jout, Kout
673 real(dp), intent(in) :: Vinp(:)
674!
675 integer, intent(out) :: Vout(:,:,:)
676!
677! Local variable declarations.
678!
679 integer :: Nstr, i, ic
680 integer :: Nout, Nval
681!
682 integer, dimension(Iout*Jout*Kout) :: Vwrk
683!
684!-----------------------------------------------------------------------
685! Load 3D integer variable with input values.
686!-----------------------------------------------------------------------
687!
688! If not all values are provided for variable, assume the last value
689! for the rest of the 3D array.
690!
691 ic=0
692 nout=iout*jout*kout
693 IF (ninp.le.nout) THEN
694 DO i=1,ninp
695 ic=ic+1
696 vwrk(i)=int(vinp(i))
697 END DO
698 IF (nout.gt.ninp) THEN
699 nstr=ninp+1
700 DO i=nstr,nout
701 ic=ic+1
702 vwrk(i)=int(vinp(ninp))
703 END DO
704 END IF
705 ELSE
706 DO i=1,nout
707 ic=ic+1
708 vwrk(i)=int(vinp(i))
709 END DO
710 END IF
711 vout=reshape(vwrk,(/iout,jout,kout/))
712 nval=ic
713!
714 RETURN

◆ load_3d_l()

integer function inp_decode_mod::load_3d_l ( integer, intent(in) ninp,
character (len=*), dimension(:), intent(in) vinp,
integer, intent(in) iout,
integer, intent(in) jout,
integer, intent(in) kout,
logical, dimension(:,:,:), intent(out) vout )

Definition at line 922 of file inp_decode.F.

924!
925!***********************************************************************
926! !
927! It loads input values into a requested model 3D logical array. !
928! !
929! On Input: !
930! !
931! Ninp Number of input elements to process in Vinp (integer) !
932! Vinp Input values (character 1D array) !
933! Iout Size of output logical variable first I-dimension !
934! Jout Size of output logical variable second J-dimension !
935! Kout Size of output logical variable third K-dimension !
936! !
937! On Output: !
938! !
939! Vout Output 3D logical variable !
940! Nval Number of output values processed !
941! !
942!***********************************************************************
943!
944! Imported variable declarations.
945!
946 integer, intent(in) :: Ninp, Iout, Jout, Kout
947 character (len=*), intent(in) :: Vinp(:)
948!
949 logical, intent(out) :: Vout(:,:,:)
950!
951! Local variable declarations.
952!
953 logical :: LastValue
954!
955 logical, dimension(Iout*Jout*Kout) :: Vwrk
956!
957 integer :: Nstr, i, ic
958 integer :: Nout, Nval
959!
960!-----------------------------------------------------------------------
961! Load 3D logical variable with input values.
962!-----------------------------------------------------------------------
963!
964! If not all values are provided for variable, assume the last value
965! for the rest of the array.
966!
967 ic=0
968 nout=iout*jout*kout
969 lastvalue=.false.
970 IF (ninp.le.nout) THEN
971 DO i=1,ninp
972 ic=ic+1
973 IF ((vinp(i)(1:1).eq.'T').or. &
974 & (vinp(i)(1:1).eq.'t')) THEN
975 vwrk(i)=.true.
976 ELSE
977 vwrk(i)=.false.
978 END IF
979 lastvalue=vwrk(i)
980 END DO
981 IF (nout.gt.ninp) THEN
982 nstr=ninp+1
983 DO i=nstr,nout
984 ic=ic+1
985 vwrk(i)=lastvalue
986 END DO
987 END IF
988 ELSE
989 DO i=1,nout
990 ic=ic+1
991 IF ((vinp(i)(1:1).eq.'T').or. &
992 & (vinp(i)(1:1).eq.'t')) THEN
993 vwrk(i)=.true.
994 ELSE
995 vwrk(i)=.false.
996 END IF
997 END DO
998 END IF
999 vout=reshape(vwrk,(/iout,jout,kout/))
1000 nval=ic
1001!
1002 RETURN

◆ load_3d_r8()

integer function inp_decode_mod::load_3d_r8 ( integer, intent(in) ninp,
real(dp), dimension(:), intent(in) vinp,
integer, intent(in) iout,
integer, intent(in) jout,
integer, intent(in) kout,
real(r8), dimension(:,:,:), intent(out) vout )

Definition at line 1454 of file inp_decode.F.

1456!
1457!***********************************************************************
1458! !
1459! It loads input values into a requested model 3D floating-point !
1460! array (KIND=r8). !
1461! !
1462! On Input: !
1463! !
1464! Ninp Number of input elements to process in Vinp (integer) !
1465! Vinp Input values (1D real(dp) array) !
1466! Iout Size of output integer variable first I-dimension !
1467! Jout Size of output integer variable second J-dimension !
1468! Kout Size of output integer variable third K-dimension !
1469! !
1470! On Output: !
1471! !
1472! Vout Output 3D variable (real, KIND=r8) !
1473! Nval Number of output values processed !
1474! !
1475!=======================================================================
1476!
1477! Imported variable declarations.
1478!
1479 integer, intent(in) :: Ninp, Iout, Jout, Kout
1480 real(dp), intent(in) :: Vinp(:)
1481!
1482 real(r8), intent(out) :: Vout(:,:,:)
1483!
1484! Local variable declarations.
1485!
1486 integer :: Nstr, i, ic
1487 integer :: Nout, Nval
1488!
1489 real(r8), dimension(Iout*Jout*Kout) :: Vwrk
1490!
1491!-----------------------------------------------------------------------
1492! Load 3D floating-point variable with input values.
1493!-----------------------------------------------------------------------
1494!
1495! If not all values are provided for variable, assume the last value
1496! for the rest of the array.
1497!
1498 ic=0
1499 nout=iout*jout*kout
1500 IF (ninp.le.nout) THEN
1501 DO i=1,ninp
1502 ic=ic+1
1503#ifdef SINGLE_PRECISION
1504 vwrk(i)=real(vinp(i),r8)
1505#else
1506 vwrk(i)=vinp(i)
1507#endif
1508 END DO
1509 IF (nout.gt.ninp) THEN
1510 nstr=ninp+1
1511 DO i=nstr,nout
1512 ic=ic+1
1513#ifdef SINGLE_PRECISION
1514 vwrk(i)=real(vinp(ninp),r8)
1515#else
1516 vwrk(i)=vinp(ninp)
1517#endif
1518 END DO
1519 END IF
1520 ELSE
1521 DO i=1,nout
1522 ic=ic+1
1523#ifdef SINGLE_PRECISION
1524 vwrk(i)=real(vinp(i),r8)
1525#else
1526 vwrk(i)=vinp(i)
1527#endif
1528 END DO
1529 END IF
1530 vout=reshape(vwrk,(/iout,jout,kout/))
1531 nval=ic
1532!
1533 RETURN

◆ load_lbc()

integer function inp_decode_mod::load_lbc ( integer, intent(in) ninp,
character (len=256), dimension(ninp), intent(in) vinp,
character (len=256), intent(in) line,
integer, intent(inout) nline,
integer, intent(in) ifield,
integer, intent(inout) igrid,
integer, intent(in) itrcstr,
integer, intent(in) itrcend,
character (len=* ), intent(in) svname,
type(t_lbc), dimension(4,nlbcvar,ngrids), intent(inout) s )

Definition at line 1536 of file inp_decode.F.

1538!
1539!***********************************************************************
1540! !
1541! This function sets lateral boundary conditions logical switches !
1542! according to input string keywords. !
1543! !
1544! On Input: !
1545! !
1546! Ninp Size of input variable (integer) !
1547! Vinp Input values (string) !
1548! line Current input line (string) !
1549! nline Multi-line counter (integer) !
1550! ifield Lateral boundary variable index (integer) !
1551! igrid Nested grid counter (integer) !
1552! iTrcStr Starting tracer index to process (integer) !
1553! iTrcEnd Ending tracer index to process (integer) !
1554! svname State variable name (string) !
1555! S Derived type structure, TYPE(T_LBC) !
1556! !
1557! On Output: !
1558! !
1559! nline Updated multi-line counter (integer) !
1560! igrid Updated nested grid counter (integer) !
1561! S Updated derived type structure, TYPE(T_LBC) !
1562! load_lbc Number of output values processed. !
1563! !
1564!***********************************************************************
1565!
1566! Imported variable declarations.
1567!
1568 integer, intent(in) :: Ninp, ifield, iTrcStr, iTrcEnd
1569 integer, intent(inout) :: igrid, nline
1570
1571 character (len=256), intent(in) :: line
1572 character (len=256), intent(in) :: Vinp(Ninp)
1573 character (len=* ), intent(in) :: svname
1574
1575 TYPE(T_LBC), intent(inout) :: S(4,nLBCvar,Ngrids)
1576!
1577! Local variable declarations.
1578!
1579 integer :: Icont, i, ib, ic
1580 integer :: load_lbc
1581
1582 character (len=10) :: Bstring(4), string
1583!
1584!-----------------------------------------------------------------------
1585! Set lateral boundary conditions switches in structure.
1586!-----------------------------------------------------------------------
1587!
1588! Check current line for the continuation symbol [char(92)=\].
1589!
1590 icont=index(trim(line),char(92) ,back=.false.)
1591!
1592! Extract lateral boundary condition keywords from Vinp. Notice that
1593! additional array elements are added to Vinp during continuation
1594! lines.
1595!
1596 i=nline*4
1597 bstring(1)=trim(vinp(i+1))
1598 bstring(2)=trim(vinp(i+2))
1599 bstring(3)=trim(vinp(i+3))
1600 bstring(4)=trim(vinp(i+4))
1601!
1602! Advance or reset entry lines counter.
1603!
1604 IF (icont.gt.0) THEN
1605 nline=nline+1
1606 ELSE
1607 nline=0
1608 END IF
1609!
1610! Set switches for each boundary segment.
1611!
1612 ic=1
1613 IF ((0.lt.ifield).and.(ifield.le.nlbcvar)) THEN
1614 DO ib=1,4
1615 string=uppercase(bstring(ib))
1616 SELECT CASE (trim(string))
1617 CASE ('CHA')
1618 s(ib,ifield,igrid)%Chapman_implicit = .true.
1619 CASE ('CHE')
1620 s(ib,ifield,igrid)%Chapman_explicit = .true.
1621 CASE ('CLA')
1622 s(ib,ifield,igrid)%clamped = .true.
1623 s(ib,ifield,igrid)%acquire = .true.
1624 CASE ('CLO')
1625 s(ib,ifield,igrid)%closed = .true.
1626 CASE ('FLA')
1627 s(ib,ifield,igrid)%Flather = .true.
1628 s(ib,ifield,igrid)%acquire = .true.
1629 s(ib,isfsur,igrid)%acquire = .true.
1630 CASE ('GRA')
1631 s(ib,ifield,igrid)%gradient = .true.
1632 CASE ('MIX')
1633 s(ib,ifield,igrid)%mixed = .true.
1634 s(ib,ifield,igrid)%acquire = .true.
1635 CASE ('NES')
1636 s(ib,ifield,igrid)%nested = .true.
1637 CASE ('PER')
1638 s(ib,ifield,igrid)%periodic = .true.
1639 IF ((ib.eq.ieast).or.(ib.eq.iwest)) THEN
1640 ewperiodic(igrid)=.true.
1641 ELSE IF ((ib.eq.inorth).or.(ib.eq.isouth)) THEN
1642 nsperiodic(igrid)=.true.
1643 END IF
1644 CASE ('RAD')
1645 s(ib,ifield,igrid)%radiation = .true.
1646 CASE ('RADNUD')
1647 s(ib,ifield,igrid)%radiation = .true.
1648 s(ib,ifield,igrid)%nudging = .true.
1649 s(ib,ifield,igrid)%acquire = .true.
1650 CASE ('RED')
1651 s(ib,ifield,igrid)%reduced = .true.
1652#if defined FSOBC_REDUCED
1653 s(ib,isfsur,igrid)%acquire = .true.
1654#endif
1655 CASE ('SHC')
1656 s(ib,ifield,igrid)%Shchepetkin = .true.
1657 s(ib,ifield,igrid)%acquire = .true.
1658 s(ib,isfsur,igrid)%acquire = .true.
1659 CASE DEFAULT
1660 IF (master) THEN
1661 WRITE (stdout,10) trim(vinp(ib)), trim(line)
1662 END IF
1663 exit_flag=2
1664 RETURN
1665 END SELECT
1666 END DO
1667
1668#ifdef SOLVE3D
1669!
1670! If processing tracers and last standard input entry (Icont=0), set
1671! unspecified tracer values to the last tracer entry.
1672!
1673 IF ((itrcstr.gt.0).and.(itrcend.gt.0)) THEN
1674 IF ((icont.eq.0).and.(ifield.lt.istvar(itrcend))) THEN
1675 DO i=ifield+1,istvar(itrcend)
1676 DO ib=1,4
1677 s(ib,i,igrid)%clamped = s(ib,ifield,igrid)%clamped
1678 s(ib,i,igrid)%closed = s(ib,ifield,igrid)%closed
1679 s(ib,i,igrid)%gradient = s(ib,ifield,igrid)%gradient
1680 s(ib,i,igrid)%nested = s(ib,ifield,igrid)%nested
1681 s(ib,i,igrid)%periodic = s(ib,ifield,igrid)%periodic
1682 s(ib,i,igrid)%radiation = s(ib,ifield,igrid)%radiation
1683 s(ib,i,igrid)%nudging = s(ib,ifield,igrid)%nudging
1684 s(ib,i,igrid)%acquire = s(ib,ifield,igrid)%acquire
1685 END DO
1686 ic=ic+1
1687 END DO
1688 END IF
1689 END IF
1690#endif
1691 END IF
1692!
1693! If appropriate, increase or reset nested grid counter.
1694!
1695 IF ((icont.gt.0).and.(ngrids.gt.1)) THEN
1696 IF ((itrcstr.gt.0).and.(itrcend.gt.0)) THEN
1697 IF ((ifield.eq.istvar(itrcend)).or.(ic.gt.1)) THEN
1698 igrid=igrid+min(1,icont)
1699 END IF
1700 ELSE
1701 igrid=igrid+min(1,icont)
1702 END IF
1703 IF (igrid.gt.ngrids) THEN
1704 IF (master) THEN
1705 WRITE (stdout,20) trim(line)
1706 END IF
1707 exit_flag=2
1708 RETURN
1709 END IF
1710 ELSE
1711 igrid=1
1712 END IF
1713 load_lbc=ic
1714
1715 10 FORMAT (/,' LOAD_LBC - illegal lateral boundary condition ', &
1716 & 'keyword: ',a,/,12x,a)
1717 20 FORMAT (/,' LOAD_LBC - incorrect continuation symbol in line:',/, &
1718 & 12x,a,/,12x,'number of nested grid values exceeded.')
1719!
1720 RETURN

References mod_scalars::ewperiodic, mod_scalars::exit_flag, mod_scalars::ieast, mod_scalars::inorth, mod_ncparam::isfsur, mod_scalars::isouth, mod_ncparam::istvar, mod_scalars::iwest, load_lbc(), mod_parallel::master, mod_param::ngrids, mod_param::nlbcvar, mod_scalars::nsperiodic, mod_iounits::stdout, and strings_mod::uppercase().

Referenced by load_lbc().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ load_s1d1()

integer function inp_decode_mod::load_s1d1 ( integer, intent(in) nval,
character (len=256), dimension(fdim), intent(in) fname,
integer, intent(in) fdim,
character (len=*), intent(in) line,
character (len=*), intent(inout) label,
integer, intent(inout) igrid,
integer, intent(in) mgrids,
integer, dimension(mgrids), intent(inout) nfiles,
integer, intent(in) io_type,
type(t_io), dimension(mgrids), intent(inout) s )

Definition at line 1723 of file inp_decode.F.

1725!
1726!***********************************************************************
1727! !
1728! This function loads input values into requested 1D structure !
1729! S(Mgrids) containing information about I/O files. !
1730! !
1731! On Input: !
1732! !
1733! Nval Number of values processed (integer) !
1734! Fname File name(s) processed (string array) !
1735! Fdim File name(s) dimension in calling program (integer) !
1736! line Current input line (string) !
1737! label I/O structure label (string) !
1738! igrid Nested grid counter (integer) !
1739! Mgrids Number of nested grids (integer) !
1740! Nfiles Number of files per grid (integer array) !
1741! io_type File I/O type (integer) !
1742! S(Mgrids) Derived type structure array, TYPE(T_IO) !
1743! !
1744! On Output: !
1745! !
1746! igrid Updated nested grid counter. !
1747! S(Mgrids) Updated derived type structure array, TYPE(T_IO). !
1748! load_s1d_1 Number of output values processed. !
1749! !
1750!***********************************************************************
1751!
1752! Imported variable declarations.
1753!
1754 integer, intent(in) :: Mgrids, Nval, Fdim, io_type
1755 integer, intent(inout) :: igrid
1756 integer, intent(inout) :: Nfiles(Mgrids)
1757
1758 character (len=*), intent(in) :: line
1759 character (len=256), intent(in) :: Fname(Fdim)
1760 character (len=*), intent(inout) :: label
1761
1762 TYPE(T_IO), intent(inout) :: S(Mgrids)
1763!
1764! Local variable declarations.
1765!
1766 logical :: load, persist
1767
1768 integer :: Icont, Ipipe, i, is, j, lstr, my_Mgrids, ng
1769 integer :: load_s1d1
1770
1771 character (len=1 ), parameter :: blank = ' '
1772!
1773!-----------------------------------------------------------------------
1774! Count files for all grids and activate load switch.
1775!-----------------------------------------------------------------------
1776!
1777! Check current line for the continuation symbol [char(92)=\] or pipe
1778! symbol [char(124)=|]. The continuation symbol is used to separate
1779! string values for different grid, whereas the pipe symbol is used
1780! to separate multi-string values for split input files. User may
1781! split the records for a particular input field into several files.
1782!
1783 icont=index(trim(line),char(92) ,back=.false.)
1784 ipipe=index(trim(line),char(124),back=.false.)
1785 IF ((icont.eq.0).and.(ipipe.eq.0)) THEN
1786 load=.true. ! last input string
1787 ELSE
1788 load=.false. ! process next string
1789 END IF
1790!
1791! Accumulate number of multi-files per each grid.
1792!
1793 nfiles(igrid)=nfiles(igrid)+1
1794!
1795! Set grid counter.
1796!
1797 IF (.not.load) THEN
1798 igrid=igrid+min(1,icont)
1799 END IF
1800 IF (igrid.gt.mgrids) THEN
1801 IF (master) THEN
1802 WRITE (stdout,10) trim(line)
1803 END IF
1804 exit_flag=2
1805 RETURN
1806 END IF
1807!
1808!-----------------------------------------------------------------------
1809! Load I/O information into structure.
1810!-----------------------------------------------------------------------
1811!
1812 IF (load) THEN
1813!
1814! If nesting and the number of file name entries is less than Mgrids,
1815! persist the last values provided. This is the case when not enough
1816! entries are provided by "==" plural symbol after the KEYWORD.
1817!
1818 IF (igrid.lt.mgrids) THEN
1819 DO i=igrid+1,mgrids
1820 nfiles(i)=nfiles(igrid)
1821 END DO
1822 my_mgrids=igrid
1823 persist=.true.
1824 ELSE
1825 my_mgrids=mgrids
1826 persist=.false.
1827 END IF
1828!
1829! Allocate various fields in structure, if not continuation or pipe
1830! symbol is found which indicates end of input data.
1831!
1832 IF (label(1:3).eq.'FLT') THEN
1833#ifdef FLOAT_BIOLOGY
1834 is=-10
1835#else
1836 is=-6
1837#endif
1838 ELSE
1839 is=1
1840 END IF
1841!
1842 DO ng=1,mgrids
1843 allocate ( s(ng)%Nrec(nfiles(ng)) )
1844 allocate ( s(ng)%time_min(nfiles(ng)) )
1845 allocate ( s(ng)%time_max(nfiles(ng)) )
1846 allocate ( s(ng)%Vid(is:nv) )
1847 allocate ( s(ng)%Tid(mt) )
1848#if defined PIO_LIB && defined DISTRIBUTE
1849 allocate ( s(ng)%pioVar(is:nv) )
1850 allocate ( s(ng)%pioTrc(mt) )
1851#endif
1852 allocate ( s(ng)%files(nfiles(ng)) )
1853 END DO
1854!
1855! Intialize strings to blank to facilitate processing.
1856!
1857 DO ng=1,mgrids
1858 lstr=len(s(ng)%name)
1859 DO i=1,lstr
1860 s(ng)%head(i:i)=blank
1861 s(ng)%base(i:i)=blank
1862 s(ng)%name(i:i)=blank
1863 END DO
1864 DO j=1,nfiles(ng)
1865 DO i=1,lstr
1866 s(ng)%files(j)(i:i)=blank
1867 END DO
1868 END DO
1869 END DO
1870!
1871! Initialize and load fields into structure.
1872!
1873 i=0
1874 DO ng=1,my_mgrids
1875 s(ng)%IOtype=io_type ! file IO type
1876 s(ng)%Nfiles=nfiles(ng) ! number of multi-files
1877 s(ng)%Fcount=1 ! multi-file counter
1878 s(ng)%load=1 ! filename load counter
1879 s(ng)%Rindex=0 ! time index
1880 s(ng)%ncid=-1 ! closed NetCDF state
1881 s(ng)%Vid=-1 ! NetCDF variables IDs
1882 s(ng)%Tid=-1 ! NetCDF tracers IDs
1883#if defined PIO_LIB && defined DISTRIBUTE
1884 s(ng)%pioFile%fh=-1 ! closed file handler
1885 DO j=1,nv
1886 s(ng)%pioVar(j)%vd%varID=-1 ! variables IDs
1887 s(ng)%pioVar(j)%dkind=-1 ! variables data kind
1888 s(ng)%pioVar(j)%gtype=0 ! variables C-grid type
1889 END DO
1890 DO j=1,mt
1891 s(ng)%pioTrc(j)%vd%varID=-1 ! tracers IDs
1892 s(ng)%pioTrc(j)%dkind=-1 ! tracers data kind
1893 s(ng)%pioTrc(j)%gtype=0 ! tracers C-grid type
1894 END DO
1895#endif
1896 DO j=1,nfiles(ng)
1897 i=i+1
1898 s(ng)%files(j)=trim(fname(i)) ! load multi-files
1899 s(ng)%Nrec(j)=0 ! record counter
1900 s(ng)%time_min(j)=0.0_dp ! starting time
1901 s(ng)%time_max(j)=0.0_dp ! ending time
1902 END DO
1903 s(ng)%label=trim(label) ! structure label
1904 s(ng)%name=trim(s(ng)%files(1)) ! load first file
1905 lstr=len_trim(s(ng)%name)
1906 s(ng)%head=s(ng)%name(1:lstr-3) ! do not include ".nc"
1907 s(ng)%base=s(ng)%name(1:lstr-3) ! do not include ".nc"
1908 nfiles(ng)=0 ! clean file counter
1909 END DO
1910!
1911! If appropriate, persist last value(s).
1912!
1913 IF (persist) THEN
1914 DO ng=igrid+1,mgrids
1915 s(ng)%IOtype=io_type
1916 s(ng)%Nfiles=s(igrid)%Nfiles
1917 s(ng)%Fcount=1
1918 s(ng)%load=1
1919 s(ng)%Rindex=0
1920 s(ng)%ncid=-1
1921 s(ng)%Vid=-1
1922 s(ng)%Tid=-1
1923#if defined PIO_LIB && defined DISTRIBUTE
1924 s(ng)%pioFile%fh=-1
1925 DO j=is,nv
1926 s(ng)%pioVar(j)%vd%varID=-1
1927 s(ng)%pioVar(j)%dkind=-1
1928 s(ng)%pioVar(j)%gtype=0
1929 END DO
1930 DO j=1,mt
1931 s(ng)%pioTrc(j)%vd%varID=-1
1932 s(ng)%pioTrc(j)%dkind=-1
1933 s(ng)%pioTrc(j)%gtype=0
1934 END DO
1935#endif
1936 DO j=1,s(igrid)%Nfiles
1937 s(ng)%files(j)=s(igrid)%files(j)
1938 s(ng)%Nrec(j)=0
1939 s(ng)%time_min(j)=0.0_dp
1940 s(ng)%time_max(j)=0.0_dp
1941 END DO
1942 s(ng)%label=trim(label)
1943 s(ng)%name=s(igrid)%name
1944 s(ng)%base=s(igrid)%base
1945 nfiles(ng)=0
1946 END DO
1947 END IF
1948!
1949! Reset counters and clean label.
1950!
1951 igrid=1
1952 DO ng=1,mgrids
1953 nfiles(ng)=0
1954 END DO
1955 DO i=1,len(label)
1956 label(i:i)=blank
1957 END DO
1958 END IF
1959 load_s1d1=nval
1960
1961 10 FORMAT (/,' LOAD_S1D1 - incorrect continuation symbol in line:', &
1962 & /,14x,a,/,11x,'number of nested grid values exceeded.')
1963!
1964 RETURN

Referenced by inp_decode_mod::load_s1d::load_s1d1().

Here is the caller graph for this function:

◆ load_s1d2()

integer function inp_decode_mod::load_s1d2 ( integer, intent(in) nval,
character (len=256), dimension(fdim), intent(in) fname,
integer, intent(in) fdim,
character (len=*), intent(in) line,
character (len=*), intent(inout) label,
integer, intent(inout) igrid,
integer, intent(in) mgrids,
integer, dimension(mgrids), intent(inout) nfiles,
integer, intent(in) idim,
integer, intent(in) ie,
integer, intent(in) io_type,
type(t_io), dimension(idim,mgrids), intent(inout) s )

Definition at line 1967 of file inp_decode.F.

1969!
1970!***********************************************************************
1971! !
1972! This function loads input values into requested 2D structure !
1973! S(Ie,:) elemement containing information about I/O files. !
1974! !
1975! On Input: !
1976! !
1977! Nval Number of values processed (integer) !
1978! Fname File name(s) processed (string array) !
1979! Fdim File name(s) dimension in calling program (integer) !
1980! line Current input line (string) !
1981! label I/O structure label (string) !
1982! igrid Nested grid counter (integer) !
1983! Mgrids Number of nested grids (integer) !
1984! Nfiles Number of files per grid (integer array) !
1985! idim Size of structure inner dimension (integer) !
1986! Ie Inner dimension element to process (integer) !
1987! io_type File I/O type (integer) !
1988! S(Ie,Mgrids) Derived type structure array, TYPE(T_IO) !
1989! !
1990! On Output: !
1991! !
1992! igrid Updated nested grid counter. !
1993! S(Ie,Mgrids) Updated derived type structure array, TYPE(T_IO). !
1994! load_s1d_2 Number of output values processed. !
1995! !
1996!***********************************************************************
1997!
1998 USE mod_param
1999 USE mod_parallel
2000 USE mod_iounits
2001 USE mod_ncparam
2002 USE mod_scalars
2003!
2004! Imported variable declarations.
2005!
2006 integer, intent(in) :: Mgrids, Nval, Fdim, Ie, idim, io_type
2007 integer, intent(inout) :: igrid
2008 integer, intent(inout) :: Nfiles(Mgrids)
2009
2010 character (len=*), intent(in) :: line
2011 character (len=256), intent(in) :: Fname(Fdim)
2012 character (len=*), intent(inout) :: label
2013
2014 TYPE(T_IO), intent(inout) :: S(idim,Mgrids)
2015!
2016! Local variable declarations.
2017!
2018 logical :: load, persist
2019
2020 integer :: Icont, Ipipe, i, is, j, lstr, my_Mgrids, ng
2021 integer :: load_s1d2
2022
2023 character (len=1 ), parameter :: blank = ' '
2024!
2025!-----------------------------------------------------------------------
2026! Count files for all grids and activate load switch.
2027!-----------------------------------------------------------------------
2028!
2029! Check current line for the continuation symbol [char(92)=\] or pipe
2030! symbol [char(124)=|]. The continuation symbol is used to separate
2031! string values for different grid, whereas the pipe symbol is used
2032! to separate multi-string values for split input files. User may
2033! split the records for a particular input field into several files.
2034!
2035 icont=index(trim(line),char(92) ,back=.false.)
2036 ipipe=index(trim(line),char(124),back=.false.)
2037 IF ((icont.eq.0).and.(ipipe.eq.0)) THEN
2038 load=.true. ! last input string
2039 ELSE
2040 load=.false. ! process next string
2041 END IF
2042!
2043! Accumulate number of multi-files per each grid.
2044!
2045 nfiles(igrid)=nfiles(igrid)+1
2046!
2047! Set grid counter.
2048!
2049 IF (.not.load) THEN
2050 igrid=igrid+min(1,icont)
2051 END IF
2052 IF (igrid.gt.mgrids) THEN
2053 IF (master) THEN
2054 WRITE (stdout,10) trim(line)
2055 END IF
2056 exit_flag=2
2057 RETURN
2058 END IF
2059!
2060!-----------------------------------------------------------------------
2061! Load I/O information into structure.
2062!-----------------------------------------------------------------------
2063!
2064 IF (load) THEN
2065!
2066! If nesting and the number of file name entries is less than Mgrids,
2067! persist the last values provided. This is the case when not enough
2068! entries are provided by "==" plural symbol after the KEYWORD.
2069!
2070 IF (igrid.lt.mgrids) THEN
2071 DO i=igrid+1,mgrids
2072 nfiles(i)=nfiles(igrid)
2073 END DO
2074 my_mgrids=igrid
2075 persist=.true.
2076 ELSE
2077 my_mgrids=mgrids
2078 persist=.false.
2079 END IF
2080!
2081! Allocate various fields in structure, if not continuation or pipe
2082! symbol is found which indicates end of input data.
2083!
2084 DO ng=1,mgrids
2085 allocate ( s(ie,ng)%Nrec(nfiles(ng)) )
2086 allocate ( s(ie,ng)%time_min(nfiles(ng)) )
2087 allocate ( s(ie,ng)%time_max(nfiles(ng)) )
2088 allocate ( s(ie,ng)%Vid(nv) )
2089 allocate ( s(ie,ng)%Tid(mt) )
2090#if defined PIO_LIB && defined DISTRIBUTE
2091 allocate ( s(ie,ng)%pioVar(nv) )
2092 allocate ( s(ie,ng)%pioTrc(mt) )
2093#endif
2094 allocate ( s(ie,ng)%files(nfiles(ng)) )
2095 END DO
2096!
2097! Intialize strings to blank to facilitate processing.
2098!
2099 DO ng=1,mgrids
2100 lstr=len(s(ie,ng)%name)
2101 DO i=1,lstr
2102 s(ie,ng)%head(i:i)=blank
2103 s(ie,ng)%base(i:i)=blank
2104 s(ie,ng)%name(i:i)=blank
2105 END DO
2106 DO j=1,nfiles(ng)
2107 DO i=1,lstr
2108 s(ie,ng)%files(j)(i:i)=blank
2109 END DO
2110 END DO
2111 END DO
2112!
2113! Initialize and load fields into structure.
2114!
2115 i=0
2116 DO ng=1,my_mgrids
2117 s(ie,ng)%IOtype=io_type ! file IO type
2118 s(ie,ng)%Nfiles=nfiles(ng) ! number of multi-files
2119 s(ie,ng)%Fcount=1 ! multi-file counter
2120 s(ie,ng)%load=1 ! filename load counter
2121 s(ie,ng)%Rindex=0 ! time index
2122 s(ie,ng)%ncid=-1 ! closed NetCDF state
2123 s(ie,ng)%Vid=-1 ! NetCDF variables IDs
2124 s(ie,ng)%Tid=-1 ! NetCDF tracers IDs
2125#if defined PIO_LIB && defined DISTRIBUTE
2126 s(ie,ng)%pioFile%fh=-1 ! closed file handler
2127 DO j=1,nv
2128 s(ie,ng)%pioVar(j)%vd%varID=-1 ! variables IDs
2129 s(ie,ng)%pioVar(j)%dkind=-1 ! variables data kind
2130 s(ie,ng)%pioVar(j)%gtype=0 ! variables C-grid type
2131 END DO
2132 DO j=1,mt
2133 s(ie,ng)%pioTrc(j)%vd%varID=-1 ! tracers IDs
2134 s(ie,ng)%pioTrc(j)%dkind=-1 ! tracers data kind
2135 s(ie,ng)%pioTrc(j)%gtype=0 ! tracers C-grid type
2136 END DO
2137#endif
2138 DO j=1,nfiles(ng)
2139 i=i+1
2140 s(ie,ng)%files(j)=trim(fname(i)) ! load multi-files
2141 s(ie,ng)%Nrec(j)=0 ! record counter
2142 s(ie,ng)%time_min(j)=0.0_dp ! starting time
2143 s(ie,ng)%time_max(j)=0.0_dp ! ending time
2144 END DO
2145 s(ie,ng)%label=trim(label) ! structure label
2146 s(ie,ng)%name=trim(s(ie,ng)%files(1)) ! load first file
2147 lstr=len_trim(s(ie,ng)%name)
2148 s(ie,ng)%head=s(ie,ng)%name(1:lstr-3) ! do not include ".nc"
2149 s(ie,ng)%base=s(ie,ng)%name(1:lstr-3) ! do not include ".nc"
2150 nfiles(ng)=0 ! clean file counter
2151 END DO
2152!
2153! If appropriate, persist last value(s).
2154!
2155 IF (persist) THEN
2156 DO ng=igrid+1,mgrids
2157 s(ie,ng)%IOtype=io_type
2158 s(ie,ng)%Nfiles=s(ie,igrid)%Nfiles
2159 s(ie,ng)%Fcount=1
2160 s(ie,ng)%load=1
2161 s(ie,ng)%Rindex=0
2162 s(ie,ng)%ncid=-1
2163 s(ie,ng)%Vid=-1
2164 s(ie,ng)%Tid=-1
2165#if defined PIO_LIB && defined DISTRIBUTE
2166 s(ie,ng)%pioFile%fh=-1
2167 DO j=1,nv
2168 s(ie,ng)%pioVar(j)%vd%varID=-1
2169 s(ie,ng)%pioVar(j)%dkind=-1
2170 s(ie,ng)%pioVar(j)%gtype=0
2171 END DO
2172 DO j=1,mt
2173 s(ie,ng)%pioTrc(j)%vd%varID=-1
2174 s(ie,ng)%pioTrc(j)%dkind=-1
2175 s(ie,ng)%pioTrc(j)%gtype=0
2176 END DO
2177#endif
2178 DO j=1,s(ie,igrid)%Nfiles
2179 s(ie,ng)%files(j)=s(ie,igrid)%files(j)
2180 s(ie,ng)%Nrec(j)=0
2181 s(ie,ng)%time_min(j)=0.0_dp
2182 s(ie,ng)%time_max(j)=0.0_dp
2183 END DO
2184 s(ie,ng)%label=trim(label)
2185 s(ie,ng)%name=s(ie,igrid)%name
2186 s(ie,ng)%base=s(ie,igrid)%base
2187 nfiles(ng)=0
2188 END DO
2189 END IF
2190!
2191! Reset counters and clean label.
2192!
2193 igrid=1
2194 DO ng=1,mgrids
2195 nfiles(ng)=0
2196 END DO
2197 DO i=1,len(label)
2198 label(i:i)=blank
2199 END DO
2200 END IF
2201 load_s1d2=nval
2202
2203 10 FORMAT (/,' LOAD_S1D2 - incorrect continuation symbol in line:', &
2204 & /,14x,a,/,11x,'number of nested grid values exceeded.')
2205!
2206 RETURN
mod_iounits
Definition mod_iounits.F:2
mod_iounits::stdout
integer stdout
Definition mod_iounits.F:195
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::nv
integer, parameter nv
Definition mod_ncparam.F:105
mod_parallel
Definition mod_parallel.F:2
mod_parallel::master
logical master
Definition mod_parallel.F:40
mod_param
Definition mod_param.F:2
mod_param::mt
integer mt
Definition mod_param.F:490
mod_scalars
Definition mod_scalars.F:2
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559

Referenced by inp_decode_mod::load_s1d::load_s1d2().

Here is the caller graph for this function:

◆ load_s2d()

integer function inp_decode_mod::load_s2d ( integer, intent(in) nval,
character (len=256), dimension(fdim), intent(in) fname,
integer, intent(in) fdim,
character (len=*), intent(in) line,
character (len=*), intent(inout) label,
integer, intent(inout) ifile,
integer, intent(inout) igrid,
integer, intent(in) mgrids,
integer, dimension(mgrids), intent(in) nfiles,
integer, dimension(idim,mgrids), intent(inout) ncount,
integer, intent(in) idim,
integer, intent(in) io_type,
type(t_io), dimension(idim,mgrids), intent(inout) s )

Definition at line 2209 of file inp_decode.F.

2211!
2212!***********************************************************************
2213! !
2214! This function loads input values into requested 2D structure !
2215! containing information about input forcing files. Notice that !
2216! Mgrids is passed for flexibility in coupling algorithms. !
2217! !
2218! On Input: !
2219! !
2220! Nval Number of values processed (integer) !
2221! Fname File name(s) processed (string array) !
2222! Fdim File name(s) dimension in calling program (integer) !
2223! line Current input line (string) !
2224! label I/O structure label (string) !
2225! ifile File structure counter (integer) !
2226! igrid Nested grid counter (integer) !
2227! Mgrids Number of nested grids (integer) !
2228! Nfiles Number of input files per grid (integer vector) !
2229! Ncount Number of files per grid counter (integer array) !
2230! idim Size of structure inner dimension (integer) !
2231! io_type File I/O type (integer) !
2232! S Derived type structure, TYPE(T_IO) !
2233! !
2234! On Output: !
2235! !
2236! ifile Updated file counter. !
2237! igrid Updated nested grid counter. !
2238! S Updated derived type structure, TYPE(T_IO). !
2239! load_s2d Number of output values processed. !
2240! !
2241!***********************************************************************
2242!
2243! Imported variable declarations.
2244!
2245 integer, intent(in) :: Mgrids, Nval, Fdim, idim, io_type
2246 integer, intent(in) :: Nfiles(Mgrids)
2247 integer, intent(inout) :: ifile, igrid
2248 integer, intent(inout) :: Ncount(idim,Mgrids)
2249!
2250 character (len=*), intent(in) :: line
2251 character (len=256), intent(in) :: Fname(Fdim)
2252 character (len=*), intent(inout) :: label
2253!
2254 TYPE(T_IO), intent(inout) :: S(idim,Mgrids)
2255!
2256! Local variable declarations.
2257!
2258 logical :: load, persist
2259!
2260 integer :: Icont, Ipipe, i, is, j, k, lstr, my_Mgrids, ng
2261 integer :: load_s2d
2262!
2263 character (len=1 ), parameter :: blank = ' '
2264!
2265!-----------------------------------------------------------------------
2266! Count files for all grids and activate load switch.
2267!-----------------------------------------------------------------------
2268!
2269! Check current line for the continuation symbol [char(92)=\] or pipe
2270! symbol [char(124)=|]. The continuation symbol is used to separate
2271! string values for different grid, whereas the pipe symbol is used
2272! to separate multi-string values for split input files. User may
2273! split the records for a particular input field into several files.
2274!
2275 icont=index(trim(line),char(92) ,back=.false.)
2276 ipipe=index(trim(line),char(124),back=.false.)
2277 IF ((icont.eq.0).and.(ipipe.eq.0)) THEN
2278 load=.true. ! last input string
2279 ELSE
2280 load=.false. ! process next string
2281 END IF
2282!
2283! Accumulate number of multi-files per each grid.
2284!
2285 ncount(ifile,igrid)=ncount(ifile,igrid)+1
2286!
2287! Set counters for next processing file, if any. The continuation
2288! symbol in the input "line" is used to advance the counters.
2289!
2290 IF (.not.load) THEN
2291 IF ((ifile.lt.nfiles(igrid)).or.(ipipe.ne.0)) THEN
2292 ifile=ifile+min(1,icont)
2293 ELSE
2294 ifile=1
2295 igrid=igrid+min(1,icont)
2296 END IF
2297 END IF
2298 IF (ifile.gt.idim) THEN
2299 IF (master) THEN
2300 WRITE (stdout,10) trim(line)
2301 END IF
2302 exit_flag=2
2303 RETURN
2304 END IF
2305 IF (igrid.gt.mgrids) THEN
2306 IF (master) THEN
2307 WRITE (stdout,20) trim(line)
2308 END IF
2309 exit_flag=2
2310 RETURN
2311 END IF
2312!
2313!-----------------------------------------------------------------------
2314! Load I/O information into structure.
2315!-----------------------------------------------------------------------
2316!
2317 IF (load) THEN
2318!
2319! If nesting and the number of file name entries is less than Mgrids,
2320! persist the last values provided. This is the case when not enough
2321! entries are provided by "==" plural symbol after the KEYWORD.
2322!
2323 IF (igrid.lt.mgrids) THEN
2324 DO j=igrid+1,mgrids
2325 DO i=1,idim
2326 ncount(i,j)=ncount(i,igrid)
2327 END DO
2328 END DO
2329 my_mgrids=igrid
2330 persist=.true.
2331 ELSE
2332 my_mgrids=mgrids
2333 persist=.false.
2334 END IF
2335!
2336! Allocate various fields in structure, if not continuation or pipe
2337! symbol is found which indicates end of input data.
2338!
2339 DO ng=1,mgrids
2340 DO i=1,idim
2341 allocate ( s(i,ng)%Nrec(ncount(i,ng)) )
2342 allocate ( s(i,ng)%time_min(ncount(i,ng)) )
2343 allocate ( s(i,ng)%time_max(ncount(i,ng)) )
2344 allocate ( s(i,ng)%Vid(nv) )
2345 allocate ( s(i,ng)%Tid(mt) )
2346#if defined PIO_LIB && defined DISTRIBUTE
2347 allocate ( s(i,ng)%pioVar(nv) )
2348 allocate ( s(i,ng)%pioTrc(mt) )
2349#endif
2350 allocate ( s(i,ng)%files(ncount(i,ng)) )
2351 END DO
2352 END DO
2353!
2354! Intialize strings to blank to facilitate processing.
2355!
2356 DO ng=1,mgrids
2357 DO i=1,idim
2358 lstr=len(s(i,ng)%name)
2359 DO j=1,lstr
2360 s(i,ng)%head(j:j)=blank
2361 s(i,ng)%base(j:j)=blank
2362 s(i,ng)%name(j:j)=blank
2363 END DO
2364 DO k=1,ncount(i,ng)
2365 DO j=1,lstr
2366 s(i,ng)%files(k)(j:j)=blank
2367 END DO
2368 END DO
2369 END DO
2370 END DO
2371!
2372! Initialize and load fields into structure.
2373!
2374 k=0
2375 DO ng=1,my_mgrids
2376 DO i=1,nfiles(ng)
2377 s(i,ng)%IOtype=io_type ! file IO type
2378 s(i,ng)%Nfiles=ncount(i,ng) ! number of multi-files
2379 s(i,ng)%Fcount=1 ! multi-file counter
2380 s(i,ng)%load=1 ! filename load counter
2381 s(i,ng)%Rindex=0 ! time index
2382 s(i,ng)%ncid=-1 ! closed NetCDF state
2383 s(i,ng)%Vid=-1 ! NetCDF variables IDs
2384 s(i,ng)%Tid=-1 ! NetCDF tracers IDs
2385#if defined PIO_LIB && defined DISTRIBUTE
2386 s(i,ng)%pioFile%fh=-1 ! closed file handler
2387 DO j=1,nv
2388 s(i,ng)%pioVar(j)%vd%varID=-1 ! variables IDs
2389 s(i,ng)%pioVar(j)%dkind=-1 ! variables data kind
2390 s(i,ng)%pioVar(j)%gtype=0 ! variables C-grid type
2391 END DO
2392 DO j=1,mt
2393 s(i,ng)%pioTrc(j)%vd%varID=-1 ! tracers IDs
2394 s(i,ng)%pioTrc(j)%dkind=-1 ! tracers data kind
2395 s(i,ng)%pioTrc(j)%gtype=0 ! tracers C-grid type
2396 END DO
2397#endif
2398 DO j=1,ncount(i,ng)
2399 k=k+1
2400 s(i,ng)%files(j)=trim(fname(k)) ! load multi-files
2401 s(i,ng)%Nrec(j)=0 ! record counter
2402 s(i,ng)%time_min(j)=0.0_dp ! starting time
2403 s(i,ng)%time_max(j)=0.0_dp ! ending time
2404 END DO
2405 s(i,ng)%label=trim(label) ! structure label
2406 s(i,ng)%name=trim(s(i,ng)%files(1)) ! load first file
2407 lstr=len_trim(s(i,ng)%name)
2408 s(i,ng)%head=s(i,ng)%name(1:lstr-3) ! do not include ".nc"
2409 s(i,ng)%base=s(i,ng)%name(1:lstr-3) ! do not include ".nc"
2410 END DO
2411 END DO
2412!
2413! If appropriate, persist last value(s).
2414!
2415 IF (persist) THEN
2416 DO ng=igrid+1,mgrids
2417 DO i=1,nfiles(ng)
2418 s(i,ng)%IOtype=io_type
2419 s(i,ng)%Nfiles=s(i,igrid)%Nfiles
2420 s(i,ng)%Fcount=1
2421 s(i,ng)%load=1
2422 s(i,ng)%Rindex=0
2423 s(i,ng)%ncid=-1
2424 s(i,ng)%Vid=-1
2425 s(i,ng)%Tid=-1
2426#if defined PIO_LIB && defined DISTRIBUTE
2427 s(i,ng)%pioFile%fh=-1
2428 DO j=1,nv
2429 s(i,ng)%pioVar(j)%vd%varID=-1
2430 s(i,ng)%pioVar(j)%dkind=-1
2431 s(i,ng)%pioVar(j)%gtype=0
2432 END DO
2433 DO j=1,mt
2434 s(i,ng)%pioTrc(j)%vd%varID=-1
2435 s(i,ng)%pioTrc(j)%dkind=-1
2436 s(i,ng)%pioTrc(j)%gtype=0
2437 END DO
2438#endif
2439 DO j=1,s(i,igrid)%Nfiles
2440 s(i,ng)%files(j)=s(i,igrid)%files(j)
2441 s(i,ng)%Nrec(j)=0
2442 s(i,ng)%time_min(j)=0.0_dp
2443 s(i,ng)%time_max(j)=0.0_dp
2444 END DO
2445 s(i,ng)%label=trim(label)
2446 s(i,ng)%head=s(i,igrid)%head
2447 s(i,ng)%base=s(i,igrid)%base
2448 s(i,ng)%name=s(i,igrid)%name
2449 ncount(i,ng)=0
2450 END DO
2451 END DO
2452 END IF
2453!
2454! Reset counters and clean label.
2455!
2456 igrid=1
2457 ifile=1
2458 DO ng=1,mgrids
2459 DO i=1,idim
2460 ncount(i,ng)=0
2461 END DO
2462 END DO
2463 DO i=1,len(label)
2464 label(i:i)=blank
2465 END DO
2466 END IF
2467 load_s2d=nval
2468
2469 10 FORMAT (/,' LOAD_S2D - incorrect continuation symbol in line:',/, &
2470 & 12x,a,/,12x,'inner dimension of structure exceeded.')
2471 20 FORMAT (/,' LOAD_S2D - incorrect continuation symbol in line:',/, &
2472 & 12x,a,/,12x,'number of nested grid values exceeded.')
2473!
2474 RETURN

References load_s2d().

Referenced by load_s2d().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ load_tadv()

integer function inp_decode_mod::load_tadv ( integer, intent(in) ninp,
character (len=256), dimension(ninp), intent(in) vinp,
character (len=256), intent(in) line,
integer, intent(inout) nline,
integer, intent(in) itrc,
integer, intent(inout) igrid,
integer, intent(inout) itracer,
integer, intent(in) itrcstr,
integer, intent(in) itrcend,
character (len=* ), intent(in) svname,
type(t_adv), dimension(maxval(nt),ngrids), intent(inout) s )

Definition at line 2478 of file inp_decode.F.

2480!
2481!***********************************************************************
2482! !
2483! This function sets tracers advection logical switches according to !
2484! input string keywords. !
2485! !
2486! On Input: !
2487! !
2488! Ninp Size of input variable (integer) !
2489! Vinp Input values (string) !
2490! line Current input line (string) !
2491! nline Multi-line counter (integer) !
2492! itrc Tracer array index (integer) !
2493! itracer Calling routine tracer counter (integer) !
2494! igrid Nested grid counter (integer) !
2495! iTrcStr Starting tracer index to process (integer) !
2496! iTrcEnd Ending tracer index to process (integer) !
2497! svname State variable name (string) !
2498! S Derived type structure, TYPE(T_ADV) !
2499! !
2500! On Output: !
2501! !
2502! nline Updated multi-line counter (integer) !
2503! itracer Updated calling routine tracer counter (integer) !
2504! igrid Updated nested grid counter (integer) !
2505! S Updated derived type structure, TYPE(T_LBC) !
2506! load_tadv Number of output values processed. !
2507! !
2508!***********************************************************************
2509!
2510! Imported variable declarations.
2511!
2512 integer, intent(in) :: Ninp, itrc, iTrcStr, iTrcEnd
2513 integer, intent(inout) :: igrid, itracer, nline
2514
2515 character (len=256), intent(in) :: line
2516 character (len=256), intent(in) :: Vinp(Ninp)
2517 character (len=* ), intent(in) :: svname
2518
2519 TYPE(T_ADV), intent(inout) :: S(MAXVAL(NT),Ngrids)
2520!
2521! Local variable declarations.
2522!
2523 integer :: Icont, i, ic
2524 integer :: load_tadv
2525
2526 character (len=10) :: Astring, string
2527!
2528!-----------------------------------------------------------------------
2529! Set tracers advection switches in structure.
2530!-----------------------------------------------------------------------
2531!
2532! Check current line for the continuation symbol [char(92)=\].
2533!
2534 icont=index(trim(line),char(92) ,back=.false.)
2535!
2536! Extract tracer advection scheme keywords from Vinp. Notice that
2537! additional array elements are added to Vinp during continuation
2538! lines.
2539!
2540 i=nline
2541 astring=trim(vinp(i+1))
2542!
2543! Advance or reset entry lines counter.
2544!
2545 IF (icont.gt.0) THEN
2546 nline=nline+1
2547 ELSE
2548 nline=0
2549 END IF
2550!
2551! Set advection switches for each tracer.
2552!
2553 ic=1
2554 IF ((0.lt.itrc).and.(itrc.le.itrcend)) THEN
2555 string=uppercase(astring)
2556 SELECT CASE (trim(string))
2557 CASE ('A4', 'AKIMA4')
2558 s(itrc,igrid) % AKIMA4 = .true.
2559 CASE ('C2', 'CENTERED2')
2560 s(itrc,igrid) % CENTERED2 = .true.
2561 CASE ('C4', 'CENTERED4')
2562 s(itrc,igrid) % CENTERED4 = .true.
2563 CASE ('HS', 'HSIMT')
2564 s(itrc,igrid) % HSIMT = .true.
2565 CASE ('MP', 'MPDATA')
2566 s(itrc,igrid) % MPDATA = .true.
2567 CASE ('SP', 'SPLINES')
2568 s(itrc,igrid) % SPLINES = .true.
2569 CASE ('SU', 'SU3', 'SPLIT_U3')
2570 s(itrc,igrid) % SPLIT_U3 = .true.
2571 CASE ('U3', 'UPSTREAM3')
2572 s(itrc,igrid) % UPSTREAM3 = .true.
2573 CASE DEFAULT
2574 IF (master) THEN
2575 WRITE (stdout,10) trim(astring)
2576 END IF
2577 exit_flag=2
2578 RETURN
2579 END SELECT
2580!
2581! If processing tracers and last standard input entry (Icont=0), set
2582! unspecified tracer values to the last tracer entry.
2583!
2584 IF ((itrcstr.gt.0).and.(itrcend.gt.0)) THEN
2585 IF ((icont.eq.0).and.(itracer.lt.itrcend)) THEN
2586 DO i=itrc+1,itrcend
2587 s(i,igrid) % AKIMA4 = s(itrc,igrid) % AKIMA4
2588 s(i,igrid) % CENTERED2 = s(itrc,igrid) % CENTERED2
2589 s(i,igrid) % CENTERED4 = s(itrc,igrid) % CENTERED4
2590 s(i,igrid) % HSIMT = s(itrc,igrid) % HSIMT
2591 s(i,igrid) % MPDATA = s(itrc,igrid) % MPDATA
2592 s(i,igrid) % SPLINES = s(itrc,igrid) % SPLINES
2593 s(i,igrid) % SPLIT_U3 = s(itrc,igrid) % SPLIT_U3
2594 s(i,igrid) % UPSTREAM3 = s(itrc,igrid) % UPSTREAM3
2595 END DO
2596 ic=ic+1
2597 END IF
2598 END IF
2599 END IF
2600!
2601! If appropriate, reset tracer grid counter. It is done to process
2602! other keywords using this function.
2603!
2604 IF ((itrc.eq.itrcend).or.(ic.gt.1)) THEN
2605 itracer=0
2606 END IF
2607!
2608! If appropriate, increase or reset nested grid counter.
2609!
2610 IF ((icont.gt.0).and.(ngrids.gt.1)) THEN
2611 IF ((itrcstr.gt.0).and.(itrcend.gt.0)) THEN
2612 IF ((itrc.eq.itrcend).or.(ic.gt.1)) THEN
2613 igrid=igrid+min(1,icont)
2614 END IF
2615 ELSE
2616 igrid=igrid+min(1,icont)
2617 END IF
2618 IF (igrid.gt.ngrids) THEN
2619 IF (master) THEN
2620 WRITE (stdout,20) trim(line)
2621 END IF
2622 exit_flag=2
2623 RETURN
2624 END IF
2625 ELSE
2626 igrid=1
2627 END IF
2628 load_tadv=ic
2629
2630 10 FORMAT (/,' LOAD_TADV - illegal tracer advection scheme ', &
2631 & 'keyword: ',a,/,13x,'Correct standard input file.',/)
2632 20 FORMAT (/,' LOAD_TADV - incorrect continuation symbol in line:', &
2633 & /,13x,a,/,13x,'number of nested grid values exceeded.')
2634!
2635 RETURN

References load_tadv(), and strings_mod::uppercase().

Referenced by load_tadv().

Here is the call graph for this function:
Here is the caller graph for this function:

Variable Documentation

◆ ncval

integer, parameter inp_decode_mod::ncval = 200

Definition at line 91 of file inp_decode.F.

91 integer, parameter :: nCval = 200 ! size of Cval character vector

◆ nrval

integer, parameter inp_decode_mod::nrval = 100

Definition at line 92 of file inp_decode.F.

92 integer, parameter :: nRval = 100 ! size of Rval real vector