ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
inp_par_mod Module Reference

Functions/Subroutines

subroutine, public inp_par (model)
 

Function/Subroutine Documentation

◆ inp_par()

subroutine, public inp_par_mod::inp_par ( integer, intent(in) model)

Definition at line 55 of file inp_par.F.

56!***********************************************************************
57!
58! Imported variable declarations.
59!
60 integer, intent(in) :: model
61!
62! Local variable declarations.
63!
64 logical :: GotFile, Lwrite
65!
66 integer :: Nghost, tile
67 integer :: Imin, Imax, Jmin, Jmax
68#ifdef GRID_EXTRACT
69 integer :: I_padd, J_padd
70#endif
71#ifdef DISTRIBUTE
72 integer :: MaxHaloLenI, MaxHaloLenJ
73#endif
74 integer :: ibry, inp, out, i, ic, ifield, itrc, j, ng, npts
75 integer :: sequence, varid
76!
77 real(r8) :: cff
78 real(r8), parameter :: spv = 0.0_r8
79!
80 character (len=*), parameter :: MyFile = &
81 & __FILE__
82!
83 sourcefile=myfile
84!
85!-----------------------------------------------------------------------
86! Read in and report input model parameters.
87!-----------------------------------------------------------------------
88!
89#ifdef DISTRIBUTE
90!
91! Get in ROMS standard input script filename (Iname) and and open it
92! as a regular formatted file in distributed-memory configurations.
93!
94 inp=stdinp_unit(master, gotfile)
95 out=stdout
96 lwrite=master
97!
98 IF (.not.gotfile) THEN
99 IF (master) WRITE (out,10)
100 10 FORMAT (/,' INP_PAR - Unable to ROMS standard input file, ', &
101 'Iname')
102 exit_flag=2
103 END IF
104 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
105#else
106!
107! Set standard inpur and output units.
108!
109 inp=stdinp
110 out=stdout
111 lwrite=master
112#endif
113#if defined SPLIT_4DVAR && SUPPRESS_REPORT
114!
115! Supress reporting the information in the split 4D-Var algorithm when
116! appending into standard output.
117!
118 IF (lappend) THEN
119 lwrite=.false.
120 END IF
121#endif
122!
123! Get current date.
124!
125#ifdef DISTRIBUTE
126 IF (master) CALL get_date (date_str)
127 CALL mp_bcasts (1, model, date_str)
128#else
129 CALL get_date (date_str)
130#endif
131!
132!-----------------------------------------------------------------------
133! Read in physical model input parameters.
134!-----------------------------------------------------------------------
135!
136 IF (master.and.lwrite) WRITE (out,20) version, trim(date_str)
137 20 FORMAT (80('-'),/, &
138 ' Model Input Parameters: ROMS version ',a,/, &
139 & 26x,a,/,80('-'))
140!
141! Process ROMS standard input Iname script.
142!
143 CALL read_phypar (model, inp, out, lwrite)
144#ifdef DISTRIBUTE
145 CALL mp_bcasti (1, model, exit_flag)
146#endif
147 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
148
149#if defined SPLIT_4DVAR && SUPPRESS_REPORT
150!
151! If appending into standard output file, supress the reporting of
152! information. Turn of "LwrtInfo" switch.
153!
154 IF (lappend) THEN
155 DO ng=1,ngrids
156 lwrtinfo(ng)=.false.
157 END DO
158 END IF
159#endif
160#ifdef SEAICE
161!
162!-----------------------------------------------------------------------
163! Read in sea-ice model input parameters.
164!-----------------------------------------------------------------------
165!
166 OPEN (15, file=trim(iparnam), form='formatted', status='old')
167
168 CALL read_icepar (model, 15, out, lwrite)
169 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
170#endif
171#ifdef BIOLOGY
172!
173!-----------------------------------------------------------------------
174! Read in biological model input parameters.
175!-----------------------------------------------------------------------
176!
177 OPEN (25, file=trim(bparnam), form='formatted', status='old')
178
179 CALL read_biopar (model, 25, out, lwrite)
180 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
181#endif
182#ifdef SEDIMENT
183!
184!-----------------------------------------------------------------------
185! Read in sediment model input parameters.
186!-----------------------------------------------------------------------
187!
188 OPEN (35, file=trim(sparnam), form='formatted', status='old')
189
190 CALL read_sedpar (model, 35, out, lwrite)
191 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
192#endif
193#ifdef NESTING
194!
195!-----------------------------------------------------------------------
196! Read in nesting contact points NetCDF file and allocate and
197! initialize several structures and variables.
198!-----------------------------------------------------------------------
199!
200 CALL set_contact (1, model)
201 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
202#endif
203!
204!-----------------------------------------------------------------------
205! Set application domain parameters and switches.
206!-----------------------------------------------------------------------
207!
208! Set switch for three ghost-points in the halo region.
209!
210#ifdef SOLVE3D
211 threeghostpoints=any(hadvection(:,:)%MPDATA).or. &
212 & any(hadvection(:,:)%HSIMT)
213#endif
214#ifdef UV_VIS4
215 threeghostpoints=.true.
216#endif
217!
218! Determine the number of ghost-points in the halo region.
219!
220 IF (threeghostpoints) THEN
221 nghostpoints=3
222 ELSE
223 nghostpoints=2
224 END IF
225 IF (any(compositegrid).or.any(refinedgrid)) THEN
226 nghostpoints=max(3,nghostpoints)
227 END IF
228!
229! Determine the switch to process input open boundary conditions data.
230!
231! In nesting applications, the lateral boundary conditions data is
232! is needed only by the main coarser grid (RefineScale(ng)=0).
233!
234 DO ng=1,ngrids
235 IF (.not.(refinedgrid(ng).and.refinescale(ng).gt.0)) THEN
236 lprocessobc(ng)=.true.
237 END IF
238 END DO
239
240#if defined SSH_TIDES || defined UV_TIDES
241!
242! Determine the switch to process input tidal forcing data.
243!
244! In nesting applications, the tides are processed only by the main
245! coarser grid (RefineScale(ng)=0) and the other grids get tidal
246! forcing from the contact areas.
247!
248 DO ng=1,ngrids
249 IF (.not.(refinedgrid(ng).and.refinescale(ng).gt.0)) THEN
250 lprocesstides(ng)=.true.
251 END IF
252 END DO
253#endif
254 CALL tile_indices (model, im, jm, lm, mm, &
255 & bounds, domain, iobounds)
256
257#ifdef GRID_EXTRACT
258!
259!-----------------------------------------------------------------------
260! If extracting output solution, set application domain decomposition
261! bounds, indices, and switches per tile partition for all grids.
262!-----------------------------------------------------------------------
263!
264! Inquire about the extract grid dimensions.
265!
266 DO ng=1,ngrids
267 SELECT CASE (grx(ng)%IOtype)
268 CASE (io_nf90)
269 CALL netcdf_get_dim (ng, inlm, trim(grx(ng)%name))
270# if defined PIO_LIB && defined DISTRIBUTE
271 CASE (io_pio)
272 CALL pio_netcdf_get_dim (ng, inlm, trim(grx(ng)%name))
273# endif
274 CASE DEFAULT
275 IF (master) WRITE (stdout,40) grx(ng)%IOtype
276 40 FORMAT (/,' INP_PAR - Illegal output type,', &
277 & ' io_type = ',i0)
278 exit_flag=3
279 END SELECT
280 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
281!
282 xtr_lm(ng)=0
283 xtr_mm(ng)=0
284 DO i=1,n_dim
285 IF (trim(dim_name(i)).eq.'xi_rho') THEN
286 xtr_lm(ng)=dim_size(i)-2 ! I-computational points
287 i_padd=(lm(ng)+2)/2-(lm(ng)+1)/2
288 xtr_im(ng)=xtr_lm(ng)+i_padd
289 ELSE IF (trim(dim_name(i)).eq.'eta_rho') THEN
290 xtr_mm(ng)=dim_size(i)-2 ! J-computational points
291 j_padd=(mm(ng)+2)/2-(mm(ng)+1)/2
292 xtr_jm(ng)=xtr_mm(ng)+j_padd
293 END IF
294 END DO
295 IF (xtr_lm(ng).eq.0) THEN
296 WRITE (stdout,20) 'xi_rho', trim(grx(ng)%name)
297 exit_flag=2
298 RETURN
299 END IF
300 IF (xtr_jm(ng).eq.0) THEN
301 WRITE (stdout,20) 'eta_rho', trim(grx(ng)%name)
302 exit_flag=2
303 RETURN
304 END IF
305 45 FORMAT (/,' INP_PAR - error inquiring dimension: ',a,2x, &
306 & 'in input NetCDF file: ',a)
307 END DO
308!
309! Set decomposition bounds, indices, and switches per tile partition
310! for all grids.
311!
312 CALL tile_indices (model, xtr_im, xtr_jm, xtr_lm, xtr_mm, &
313 & xtr_bounds, xtr_domain, xtr_iobounds)
314#endif
315!
316!-----------------------------------------------------------------------
317! Set minimum and maximum fractional coordinates for processing
318! observations.
319!-----------------------------------------------------------------------
320!
321 CALL tile_obs_bounds (model, im, jm, lm, mm, &
322 & domain)
323!
324!-----------------------------------------------------------------------
325! Check tile partition starting and ending (I,J) indices for illegal
326! domain decomposition parameters NtileI and NtileJ in standard input
327! file.
328!-----------------------------------------------------------------------
329!
330 IF (master.and.lwrite) THEN
331 DO ng=1,ngrids
332#ifdef SOLVE3D
333 WRITE (stdout,50) ng, lm(ng), mm(ng), n(ng), &
334 & ntilei(ng), ntilej(ng)
335#else
336 WRITE (stdout,50) ng, lm(ng), mm(ng), &
337 & ntilei(ng), ntilej(ng)
338#endif
339#if !defined DISTRIBUTE && defined ADJOINT
340 IF ((ntilei(ng).ne.1).or.(ntilej(ng).ne.1)) THEN
341 WRITE (stdout,60)
342 exit_flag=6
343 RETURN
344 END IF
345#endif
346 DO tile=0,ntilei(ng)*ntilej(ng)-1
347#ifdef SOLVE3D
348 npts=(bounds(ng)%Iend(tile)- &
349 & bounds(ng)%Istr(tile)+1)* &
350 & (bounds(ng)%Jend(tile)- &
351 & bounds(ng)%Jstr(tile)+1)*n(ng)
352#else
353 npts=(bounds(ng)%Iend(tile)- &
354 & bounds(ng)%Istr(tile)+1)* &
355 & (bounds(ng)%Jend(tile)- &
356 & bounds(ng)%Jstr(tile)+1)
357#endif
358 WRITE (stdout,70) tile, &
359 & bounds(ng)%Istr(tile), &
360 & bounds(ng)%Iend(tile), &
361 & bounds(ng)%Jstr(tile), &
362 & bounds(ng)%Jend(tile), &
363 & npts
364 IF ((bounds(ng)%Iend(tile)- &
365 & bounds(ng)%Istr(tile)+1).lt.2) THEN
366 WRITE (stdout,80) ng, 'NtileI = ', ntilei(ng), &
367 & 'Lm = ', lm(ng), &
368 & 'Istr = ', bounds(ng)%Istr(tile), &
369 & ' Iend = ', bounds(ng)%Iend(tile), &
370 & 'NtileI'
371 exit_flag=6
372 RETURN
373 END IF
374 IF ((bounds(ng)%Jend(tile)- &
375 & bounds(ng)%Jstr(tile)+1).lt.2) THEN
376 WRITE (stdout,80) ng, 'NtileJ = ', ntilej(ng), &
377 & 'Mm = ', mm(ng), &
378 & 'Jstr = ', bounds(ng)%Jstr(tile), &
379 & ' Jend = ', bounds(ng)%Jend(tile), &
380 & 'NtileJ'
381 exit_flag=6
382 RETURN
383 END IF
384 END DO
385 END DO
386#ifdef SOLVE3D
387 50 FORMAT (/,' Tile partition information for Grid ',i2.2,':',2x, &
388 & i0,'x',i0,'x',i0,2x,'tiling: ',i0,'x',i0,/,/, &
389 & 5x,'tile',5x,'Istr',5x,'Iend',5x,'Jstr',5x,'Jend', &
390 & 5x,'Npts',/)
391#else
392 50 FORMAT (/,' Tile partition information for Grid ',i2.2,':',2x, &
393 & i0,'x',i0,2x,'tiling: ',i0,'x',i0,/,/, &
394 & 5x,'tile',5x,'Istr',5x,'Iend',5x,'Jstr',5x,'Jend', &
395 & 5x,'Npts',/)
396#endif
397#if !defined DISTRIBUTE && defined ADJOINT
398 60 FORMAT (/,' INP_PAR - illegal domain decomposition for the ', &
399 & 'Adjoint model.',/,11x,'Partitions are ', &
400 & 'allowed in distributed-menory (MPI) applications.'/)
401#endif
402 70 FORMAT (5(4x,i5),1x,i8)
403 80 FORMAT (/,' INP_PAR - domain decomposition error in input ', &
404 & 'script file for grid: ',i2.2,/, &
405 & /,11x,'The domain partition parameter, ',a,i0, &
406 & /,11x,'is incompatible with grid size, ',a,i0, &
407 & /,11x,'because it yields too small tile, ',a,i0,a,i0, &
408 & /,11x,'Decrease partition parameter: ',a)
409 END IF
410#ifdef DISTRIBUTE
411 CALL mp_bcasti (1, model, exit_flag)
412#endif
413 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
414!
415! Report tile minimum and maximum fractional grid coordinates.
416!
417 DO ng=1,ngrids
418 IF (master.and.lwrite) THEN
419 WRITE (stdout,90) ng
420 DO tile=0,ntilei(ng)*ntilej(ng)-1
421 WRITE (stdout,100) tile, &
422 & domain(ng)%Xmin_rho(tile), &
423 & domain(ng)%Xmax_rho(tile), &
424 & domain(ng)%Ymin_rho(tile), &
425 & domain(ng)%Ymax_rho(tile), 'RHO-points'
426 END DO
427 WRITE (stdout,'(1x)')
428 DO tile=0,ntilei(ng)*ntilej(ng)-1
429 WRITE (stdout,100) tile, &
430 & domain(ng)%Xmin_u(tile), &
431 & domain(ng)%Xmax_u(tile), &
432 & domain(ng)%Ymin_u(tile), &
433 & domain(ng)%Ymax_u(tile), ' U-points'
434 END DO
435 WRITE (stdout,'(1x)')
436 DO tile=0,ntilei(ng)*ntilej(ng)-1
437 WRITE (stdout,100) tile, &
438 & domain(ng)%Xmin_v(tile), &
439 & domain(ng)%Xmax_v(tile), &
440 & domain(ng)%Ymin_v(tile), &
441 & domain(ng)%Ymax_v(tile), ' V-points'
442 END DO
443 90 FORMAT (/,' Tile minimum and maximum fractional coordinates', &
444 & ' for Grid ',i2.2,':'/, &
445#ifdef FULL_GRID
446 & ' (interior and boundary points)',/,/, &
447#else
448 & ' (interior points only)',/,/, &
449#endif
450 & 5x,'tile',5x,'Xmin',5x,'Xmax',5x,'Ymin',5x,'Ymax', &
451 & 5x,'grid',/)
452 100 FORMAT (5x,i4,4f9.2,2x,a)
453 END IF
454 END DO
455
456#ifdef DISTRIBUTE
457!
458!-----------------------------------------------------------------------
459! Determine the maximum tile lengths in XI and ETA directions for
460! distributed-memory communications. Notice that halo size are
461! increased by few points to allow exchanging of private arrays.
462!-----------------------------------------------------------------------
463!
464 IF (any(ewperiodic).or.any(nsperiodic)) THEN
465 nghost=nghostpoints+1
466 ELSE
467 nghost=nghostpoints
468 END IF
469
470 DO ng=1,ngrids
471 maxhaloleni=0
472 maxhalolenj=0
473 halobry(ng)=nghost
474 DO tile=0,ntilei(ng)*ntilej(ng)-1
475 imin=bounds(ng)%LBi(tile)-1
476 imax=bounds(ng)%UBi(tile)+1
477 jmin=bounds(ng)%LBj(tile)-1
478 jmax=bounds(ng)%UBj(tile)+1
479 maxhaloleni=max(maxhaloleni,(imax-imin+1))
480 maxhalolenj=max(maxhalolenj,(jmax-jmin+1))
481 END DO
482 halosizei(ng)=nghost*maxhaloleni+6*nghost
483 halosizej(ng)=nghost*maxhalolenj+6*nghost
484 tileside(ng)=max(maxhaloleni,maxhalolenj)
485 tilesize(ng)=maxhaloleni*maxhalolenj
486 IF (master.and.lwrite) THEN
487 WRITE (stdout,110) ng, halosizei(ng), ng, halosizej(ng), &
488 & ng, tileside(ng), ng, tilesize(ng)
489 110 FORMAT (/,' Maximum halo size in XI and ETA directions:',/, &
490 & /,' HaloSizeI(',i1,') = ',i7, &
491 & /,' HaloSizeJ(',i1,') = ',i7, &
492 & /,' TileSide(',i1,') = ',i7, &
493 & /,' TileSize(',i1,') = ',i7,/)
494 END IF
495 END DO
496#endif
497
498#if defined FOUR_DVAR || defined VERIFICATION
499!
500!-----------------------------------------------------------------------
501! Read in input assimilation parameters.
502!-----------------------------------------------------------------------
503!
504 OPEN (35, file=trim(aparnam), form='formatted', status='old')
505
506 CALL read_asspar (model, 35, out, lwrite)
507 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
508#endif
509#ifdef FLOATS
510!
511!-----------------------------------------------------------------------
512! Read in floats input parameters.
513!-----------------------------------------------------------------------
514!
515 OPEN (45, file=trim(fposnam), form='formatted', status='old')
516
517 CALL read_fltpar (model, 45, out, lwrite)
518 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
519#endif
520#if defined FLOATS && defined FLOAT_BIOLOGY
521!
522!-----------------------------------------------------------------------
523! Read in biological float behavior model input parameters.
524!-----------------------------------------------------------------------
525!
526 OPEN (50, file=trim(fbionam), form='formatted', status='old')
527
528 CALL read_fltbiopar (model, 50, out, lwrite)
529 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
530#endif
531#ifdef STATIONS
532!
533!-----------------------------------------------------------------------
534! Read in stations input parameters.
535!-----------------------------------------------------------------------
536!
537 OPEN (55, file=trim(sposnam), form='formatted', status='old')
538
539 CALL read_stapar (model, 55, out, lwrite)
540 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
541#endif
542#ifdef SOLVE3D
543!
544!-----------------------------------------------------------------------
545! Report tracer advection scheme.
546!-----------------------------------------------------------------------
547!
548 IF (master.and.lwrite) THEN
549 WRITE (out,120) 'NLM'
550 120 FORMAT (/,1x,'Tracer Advection Scheme: ',a,/,1x,24('='),/, &
551 & /,1x,'Variable',t25,'Grid',t31,'Horizontal', &
552 & t50,'Vertical', /,1x,'---------',t25,'----', &
553 & t31,2('------------',7x))
554 END IF
555 CALL tadv_report (out, inlm, hadvection, vadvection, lwrite)
556 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
557
558# if defined ADJOINT || defined TANGENT || defined TL_IOMS
559!
560 IF (master.and.lwrite) THEN
561 WRITE (out,120) 'TLM, RPM, and ADM'
562 END IF
563 CALL tadv_report (out, iadm, ad_hadvection, ad_vadvection, lwrite)
564 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
565# endif
566#endif
567#if defined TANGENT || defined TL_IOMS
568!
569! Set tracer advection scheme switches for the tangent linear models
570! (TLM and RPM) to the same values as the adjoint model.
571!
572 DO ng=1,ngrids
573 DO i=1,nt(ng)
574 tl_hadvection(i,ng)%AKIMA4 = ad_hadvection(i,ng)%AKIMA4
575 tl_hadvection(i,ng)%CENTERED2 = ad_hadvection(i,ng)%CENTERED2
576 tl_hadvection(i,ng)%CENTERED4 = ad_hadvection(i,ng)%CENTERED4
577 tl_hadvection(i,ng)%HSIMT = ad_hadvection(i,ng)%HSIMT
578 tl_hadvection(i,ng)%MPDATA = ad_hadvection(i,ng)%MPDATA
579 tl_hadvection(i,ng)%SPLINES = ad_hadvection(i,ng)%SPLINES
580 tl_hadvection(i,ng)%SPLIT_U3 = ad_hadvection(i,ng)%SPLIT_U3
581 tl_hadvection(i,ng)%UPSTREAM3 = ad_hadvection(i,ng)%UPSTREAM3
582!
583 tl_vadvection(i,ng)%AKIMA4 = ad_vadvection(i,ng)%AKIMA4
584 tl_vadvection(i,ng)%CENTERED2 = ad_vadvection(i,ng)%CENTERED2
585 tl_vadvection(i,ng)%CENTERED4 = ad_vadvection(i,ng)%CENTERED4
586 tl_vadvection(i,ng)%HSIMT = ad_vadvection(i,ng)%HSIMT
587 tl_vadvection(i,ng)%MPDATA = ad_vadvection(i,ng)%MPDATA
588 tl_vadvection(i,ng)%SPLINES = ad_vadvection(i,ng)%SPLINES
589 tl_vadvection(i,ng)%SPLIT_U3 = ad_vadvection(i,ng)%SPLIT_U3
590 tl_vadvection(i,ng)%UPSTREAM3 = ad_vadvection(i,ng)%UPSTREAM3
591 END DO
592 END DO
593#endif
594!
595!-----------------------------------------------------------------------
596! Report lateral boundary conditions.
597!-----------------------------------------------------------------------
598!
599 IF (master.and.lwrite) THEN
600 WRITE (out,130) 'NLM'
601 130 FORMAT (/,1x,'Lateral Boundary Conditions: ',a,/,1x,28('='),/, &
602 & /,1x,'Variable',t25,'Grid',t31,'West Edge', &
603 & t44,'South Edge', t57,'East Edge',t70,'North Edge', &
604 & /,1x,'---------',t25,'----',t31,4('----------',3x))
605 DO ifield=1,nlbcvar
606 IF (idbvar(ifield).gt.0) THEN
607 CALL lbc_report (out, ifield, lbc)
608 END IF
609 END DO
610
611#if defined ADJOINT || defined TANGENT || defined TL_IOMS
612!
613 WRITE (out,130) 'TLM, RPM, and ADM'
614 DO ifield=1,nlbcvar
615 IF (idbvar(ifield).gt.0) THEN
616 CALL lbc_report (out, ifield, ad_lbc)
617 END IF
618 END DO
619#endif
620 END IF
621 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
622!
623!-----------------------------------------------------------------------
624! Compute various constants.
625!-----------------------------------------------------------------------
626!
627 gorho0=g/rho0
628 DO ng=1,ngrids
629 dtfast(ng)=dt(ng)/real(ndtfast(ng),r8)
630!
631! Take the square root of the biharmonic coefficients so it can
632! be applied to each harmonic operator.
633!
634 nl_visc4(ng)=sqrt(abs(nl_visc4(ng)))
635#ifdef ADJOINT
636 ad_visc4(ng)=sqrt(abs(ad_visc4(ng)))
637#endif
638#if defined TANGENT || defined TL_IOMS
639 tl_visc4(ng)=sqrt(abs(tl_visc4(ng)))
640#endif
641 tkenu4(ng)=sqrt(abs(tkenu4(ng)))
642!
643! Set internal switch for activating sponge areas.
644!
645#ifdef SOLVE3D
646 IF (luvsponge(ng).or. &
647 & any(ltracersponge(:,ng))) THEN
648 lsponge(ng)=.true.
649 END IF
650#else
651 IF (luvsponge(ng)) THEN
652 lsponge(ng)=.true.
653 END IF
654#endif
655!
656! Set switch to processing nudging coefficients for passive/active
657! boundary conditions.
658!
659 nudgingcoeff(ng)=any(lbc(:,:,ng)%nudging)
660#if defined ADJOINT || defined TANGENT || defined TL_IOMS
661 nudgingcoeff(ng)=nudgingcoeff(ng).or.any(ad_lbc(:,:,ng)%nudging)
662#endif
663!
664! Set internal switch for processing climatology data.
665!
666#ifdef SOLVE3D
667# if defined TS_MIX_CLIMA && (defined TS_DIF2 || defined TS_DIF4)
668 lclimatology(ng)=.true.
669# endif
670 IF (lsshclm(ng).or. &
671 lm2clm(ng).or.lnudgem2clm(ng).or. &
672 lm3clm(ng).or.lnudgem3clm(ng).or. &
673 any(ltracerclm(:,ng)).or.any(lnudgetclm(:,ng))) THEN
674 lclimatology(ng)=.true.
675 END IF
676#else
677 IF (lsshclm(ng).or. &
678 lm2clm(ng).or.lnudgem2clm(ng)) THEN
679 lclimatology(ng)=.true.
680 END IF
681#endif
682!
683! Set internal switch for nudging to climatology fields.
684!
685#ifdef SOLVE3D
686 IF (lnudgem2clm(ng).or. &
687 & lnudgem3clm(ng).or. &
688 & any(lnudgetclm(:,ng))) THEN
689 lnudging(ng)=.true.
690 END IF
691#else
692 IF (lnudgem2clm(ng)) THEN
693 lnudging(ng)=.true.
694 END IF
695#endif
696!
697! Compute inverse nudging coefficients (1/s) used in various tasks.
698!
699 IF (znudg(ng).gt.0.0_r8) THEN
700 znudg(ng)=1.0_r8/(znudg(ng)*86400.0_r8)
701 ELSE
702 znudg(ng)=0.0_r8
703 END IF
704!
705 IF (m2nudg(ng).gt.0.0_r8) THEN
706 m2nudg(ng)=1.0_r8/(m2nudg(ng)*86400.0_r8)
707 ELSE
708 m2nudg(ng)=0.0_r8
709 END IF
710#ifdef SOLVE3D
711!
712 IF (m3nudg(ng).gt.0.0_r8) THEN
713 m3nudg(ng)=1.0_r8/(m3nudg(ng)*86400.0_r8)
714 ELSE
715 m3nudg(ng)=0.0_r8
716 END IF
717#endif
718!
719! Set nudging coefficients (1/s) for passive/active (outflow/inflow)
720! open boundary conditions. Weak nudging is expected in passive
721! outflow conditions and strong nudging is expected in active inflow
722! conditions. If nudging to climatology fields, these values are
723! replaced by spatial nudging coefficients distribution in the
724! open boundary condition routines.
725!
726 IF (nudgingcoeff(ng)) THEN
727 DO ibry=1,4
728 IF (lbc(ibry,isfsur,ng)%nudging) THEN
729 fsobc_out(ng,ibry)=znudg(ng)
730 fsobc_in(ng,ibry)=obcfac(ng)*znudg(ng)
731 END IF
732!
733 IF (lbc(ibry,isubar,ng)%nudging.or. &
734 & lbc(ibry,isvbar,ng)%nudging) THEN
735 m2obc_out(ng,ibry)=m2nudg(ng)
736 m2obc_in(ng,ibry)=obcfac(ng)*m2nudg(ng)
737 END IF
738#ifdef SOLVE3D
739!
740 IF (lbc(ibry,isuvel,ng)%nudging.or. &
741 & lbc(ibry,isvvel,ng)%nudging) THEN
742 m3obc_out(ng,ibry)=m3nudg(ng)
743 m3obc_in(ng,ibry)=obcfac(ng)*m3nudg(ng)
744 END IF
745!
746 DO itrc=1,nt(ng)
747 IF (lbc(ibry,istvar(itrc),ng)%nudging) THEN
748 tobc_out(itrc,ng,ibry)=tnudg(itrc,ng)
749 tobc_in(itrc,ng,ibry)=obcfac(ng)*tnudg(itrc,ng)
750 END IF
751 END DO
752#endif
753 END DO
754 END IF
755
756#if defined SO_SEMI || \
757 (defined stochastic_opt && !defined STOCH_OPT_WHITE)
758 so_decay(ng)=so_decay(ng)*86400.0_r8
759#endif
760!
761! Convert momentum stresses and tracer flux scales to kinematic
762! Values. Recall, that all the model fluxes are kinematic.
763!
764 cff=1.0_r8/rho0
765 fscale(idusms,ng)=cff*fscale(idusms,ng)
766 fscale(idvsms,ng)=cff*fscale(idvsms,ng)
767 fscale(idubms,ng)=cff*fscale(idubms,ng)
768 fscale(idvbms,ng)=cff*fscale(idvbms,ng)
769 fscale(idubrs,ng)=cff*fscale(idubrs,ng)
770 fscale(idvbrs,ng)=cff*fscale(idvbrs,ng)
771 fscale(idubws,ng)=cff*fscale(idubws,ng)
772 fscale(idvbws,ng)=cff*fscale(idvbws,ng)
773 fscale(idubcs,ng)=cff*fscale(idubcs,ng)
774 fscale(idvbcs,ng)=cff*fscale(idvbcs,ng)
775 cff=1.0_r8/(rho0*cp)
776 fscale(idtsur(itemp),ng)=cff*fscale(idtsur(itemp),ng)
777 fscale(idtbot(itemp),ng)=cff*fscale(idtbot(itemp),ng)
778 fscale(idsrad,ng)=cff*fscale(idsrad,ng)
779 fscale(idldwn,ng)=cff*fscale(idldwn,ng)
780 fscale(idlrad,ng)=cff*fscale(idlrad,ng)
781 fscale(idlhea,ng)=cff*fscale(idlhea,ng)
782 fscale(idshea,ng)=cff*fscale(idshea,ng)
783 fscale(iddqdt,ng)=cff*fscale(iddqdt,ng)
784
785#ifdef SOLVE3D
786!
787! Determine the number of climatology tracers to process.
788!
789 IF (any(ltracerclm(:,ng)).or.any(lnudgetclm(:,ng))) THEN
790 ic=0
791 DO itrc=1,nt(ng)
792 IF (ltracerclm(itrc,ng)) THEN
793 ic=ic+1
794 END IF
795 END DO
796 ntclm(ng)=ic
797 END IF
798#endif
799
800#if defined TANGENT || defined TL_IOMS
801!
802! Set lateral boundary condition switches for the tangent linear
803! models (TLM and RPM) to the same values as the adjoint model.
804!
805 DO j=1,nlbcvar
806 DO i=1,4
807 tl_lbc(i,j,ng)%acquire = ad_lbc(i,j,ng)%acquire
808 tl_lbc(i,j,ng)%Chapman_explicit = &
809 & ad_lbc(i,j,ng)%Chapman_explicit
810 tl_lbc(i,j,ng)%Chapman_implicit = &
811 & ad_lbc(i,j,ng)%Chapman_implicit
812 tl_lbc(i,j,ng)%clamped = ad_lbc(i,j,ng)%clamped
813 tl_lbc(i,j,ng)%closed = ad_lbc(i,j,ng)%closed
814 tl_lbc(i,j,ng)%Flather = ad_lbc(i,j,ng)%Flather
815 tl_lbc(i,j,ng)%gradient = ad_lbc(i,j,ng)%gradient
816 tl_lbc(i,j,ng)%nested = ad_lbc(i,j,ng)%nested
817 tl_lbc(i,j,ng)%nudging = ad_lbc(i,j,ng)%nudging
818 tl_lbc(i,j,ng)%periodic = ad_lbc(i,j,ng)%periodic
819 tl_lbc(i,j,ng)%radiation = ad_lbc(i,j,ng)%radiation
820 tl_lbc(i,j,ng)%reduced = ad_lbc(i,j,ng)%reduced
821 tl_lbc(i,j,ng)%Shchepetkin = ad_lbc(i,j,ng)%Shchepetkin
822 END DO
823 END DO
824#endif
825
826 END DO
827
828#ifdef SOLVE3D
829!
830!-----------------------------------------------------------------------
831! Set climatology tracers (active and passive) metadata. It needs to
832! be done here because information is needed from all input scripts.
833! The variable name and units are the same as the basic tracers. The
834! default time-variable name is the same as the variable name but with
835! the "_time" suffix. Recall that other time-variables names are
836! allowed provided that the input NetCDF variable has the "time"
837! attribute with the appropriate value.
838!-----------------------------------------------------------------------
839!
840 varid=last_varid
841 IF (any(ltracerclm).or.any(lnudgetclm)) THEN
842 DO i=1,mt
843 varid=varid+1
844 IF (varid.gt.mv) THEN
845 WRITE (stdout,130) mv, varid
846 stop
847 END IF
848 idtclm(i)=varid
849 DO ng=1,ngrids
850 fscale(varid,ng)=1.0_r8
851 iinfo(1,varid,ng)=r3dvar
852 END DO
853 WRITE (vname(1,varid),'(a)') &
854 & trim(adjustl(vname(1,idtvar(i))))
855 WRITE (vname(2,varid),'(a,a)') &
856 & trim(adjustl(vname(2,idtvar(i)))), ' climatology'
857 WRITE (vname(3,varid),'(a)') &
858 & trim(adjustl(vname(3,idtvar(i))))
859 WRITE (vname(4,varid),'(a,a)') &
860 & trim(vname(1,varid)), ', scalar, series'
861 WRITE (vname(5,varid),'(a,a)') &
862 & trim(adjustl(vname(1,idtvar(i)))), '_time'
863 END DO
864 END IF
865!
866!-----------------------------------------------------------------------
867! Set tracers inverse nudging coeffcients metadata. It needs to be
868! done here because information is needed from all input scripts.
869! The variable name is the same as the basic tracer but with the
870! "_NudgeCoef" suffix.
871!-----------------------------------------------------------------------
872!
873 DO i=1,mt
874 IF (any(lnudgetclm(i,:))) THEN
875 varid=varid+1
876 IF (varid.gt.mv) THEN
877 WRITE (stdout,140) mv, varid
878 140 FORMAT (/,' INP_PAR - too small dimension ', &
879 & 'parameter, MV = ',2i5,/,15x, &
880 & 'change file mod_ncparam.F and recompile.')
881 stop
882 END IF
883 idtnud(i)=varid
884 DO ng=1,ngrids
885 fscale(varid,ng)=1.0_r8/86400 ! default units: 1/day
886 iinfo(1,varid,ng)=r3dvar
887 END DO
888 WRITE (vname(1,varid),'(a,a)') &
889 & trim(adjustl(vname(1,idtvar(i)))), '_NudgeCoef'
890 WRITE (vname(2,varid),'(a,a)') &
891 & trim(adjustl(vname(2,idtvar(i)))), &
892 & ', inverse nudging coefficients'
893 WRITE (vname(3,varid),'(a,1x,a)') &
894 & trim(adjustl(vname(3,idtvar(i)))), 'day-1'
895 WRITE (vname(4,varid),'(a,a)') &
896 & trim(vname(1,varid)), ', scalar'
897 WRITE (vname(5,varid),'(a)') 'nulvar'
898 ELSE
899 idtnud(i)=0
900 END IF
901 END DO
902#endif
903!
904!-----------------------------------------------------------------------
905! Check C-preprocessing options and definitions.
906!-----------------------------------------------------------------------
907!
908 IF (master.and.lwrite) THEN
909 CALL checkdefs
910 FLUSH (out)
911 END IF
912#ifdef DISTRIBUTE
913 CALL mp_bcasti (1, model, exit_flag)
914 CALL mp_bcasts (1, model, coptions)
915#endif
916 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
917!
918!-----------------------------------------------------------------------
919! Initialize random number sequence so we can get identical results
920! everytime that we run the same solution.
921!-----------------------------------------------------------------------
922!
923 sequence=759
924 CALL ran_seed (sequence)
925!
926 RETURN
checkdefs
subroutine checkdefs
Definition checkdefs.F:3
read_biopar
subroutine read_biopar(model, inp, out, lwrite)
Definition ecosim_inp.h:2
read_icepar
subroutine read_icepar(model, inp, out, lwrite)
Definition ice_inp.h:2
read_fltbiopar
subroutine read_fltbiopar(model, inp, out, lwrite)
Definition oyster_floats_inp.h:2
read_asspar
subroutine read_asspar(model, inp, out, lwrite)
Definition read_asspar.F:4
read_fltpar
subroutine read_fltpar(model, inp, out, lwrite)
Definition read_fltpar.F:4
read_phypar
subroutine read_phypar(model, inp, out, lwrite)
Definition read_phypar.F:3
read_stapar
subroutine read_stapar(model, inp, out, lwrite)
Definition read_stapar.F:4
read_sedpar
subroutine read_sedpar(model, inp, out, lwrite)
Definition sediment_inp.h:2

References mod_param::ad_hadvection, mod_param::ad_lbc, mod_param::ad_vadvection, mod_scalars::ad_visc4, mod_iounits::aparnam, mod_param::bounds, mod_iounits::bparnam, checkdefs(), mod_scalars::compositegrid, mod_strings::coptions, mod_scalars::cp, mod_ncparam::date_str, mod_netcdf::dim_name, mod_netcdf::dim_size, mod_param::domain, mod_scalars::dt, mod_scalars::dtfast, mod_scalars::ewperiodic, mod_scalars::exit_flag, mod_iounits::fbionam, strings_mod::founderror(), mod_iounits::fposnam, mod_ncparam::fscale, mod_scalars::fsobc_in, mod_scalars::fsobc_out, mod_scalars::g, dateclock_mod::get_date(), mod_scalars::gorho0, mod_iounits::grx, mod_param::hadvection, mod_param::halobry, mod_param::halosizei, mod_param::halosizej, mod_param::iadm, mod_ncparam::idbvar, mod_ncparam::iddqdt, mod_ncparam::idldwn, mod_ncparam::idlhea, mod_ncparam::idlrad, mod_ncparam::idshea, mod_ncparam::idsrad, mod_ncparam::idtbot, mod_ncparam::idtclm, mod_ncparam::idtnud, mod_ncparam::idtsur, mod_ncparam::idtvar, mod_ncparam::idubcs, mod_ncparam::idubms, mod_ncparam::idubrs, mod_ncparam::idubws, mod_ncparam::idusms, mod_ncparam::idvbcs, mod_ncparam::idvbms, mod_ncparam::idvbrs, mod_ncparam::idvbws, mod_ncparam::idvsms, mod_ncparam::iinfo, mod_param::im, mod_param::inlm, mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_param::iobounds, mod_iounits::iparnam, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::itemp, mod_param::jm, mod_scalars::lappend, mod_ncparam::last_varid, mod_param::lbc, lbc_mod::lbc_report(), mod_scalars::lclimatology, mod_param::lm, mod_scalars::lm2clm, mod_scalars::lm3clm, mod_scalars::lnudgem2clm, mod_scalars::lnudgem3clm, mod_scalars::lnudgetclm, mod_scalars::lnudging, mod_scalars::lprocessobc, mod_scalars::lprocesstides, mod_scalars::lsponge, mod_scalars::lsshclm, mod_scalars::ltracerclm, mod_scalars::ltracersponge, mod_scalars::luvsponge, mod_scalars::lwrtinfo, mod_scalars::m2nudg, mod_scalars::m2obc_in, mod_scalars::m2obc_out, mod_scalars::m3nudg, mod_scalars::m3obc_in, mod_scalars::m3obc_out, mod_parallel::master, mod_param::mm, mod_param::mt, mod_ncparam::mv, mod_param::n, mod_netcdf::n_dim, mod_scalars::ndtfast, mod_netcdf::netcdf_get_dim(), mod_param::nghostpoints, mod_param::ngrids, mod_scalars::nl_visc4, mod_param::nlbcvar, mod_scalars::noerror, mod_scalars::nsperiodic, mod_param::nt, mod_param::ntclm, mod_param::ntilei, mod_param::ntilej, mod_scalars::nudgingcoeff, mod_scalars::obcfac, mod_pio_netcdf::pio_netcdf_get_dim(), mod_param::r3dvar, mod_kinds::r8, ran_state::ran_seed(), read_asspar(), read_biopar(), read_fltbiopar(), read_fltpar(), read_icepar(), read_phypar(), read_sedpar(), read_stapar(), mod_scalars::refinedgrid, mod_scalars::refinescale, mod_scalars::rho0, set_contact_mod::set_contact(), mod_scalars::so_decay, mod_iounits::sourcefile, mod_iounits::sparnam, mod_iounits::sposnam, mod_iounits::stdinp, stdinp_mod::stdinp_unit(), mod_iounits::stdout, tadv_mod::tadv_report(), mod_scalars::threeghostpoints, tile_indices_mod::tile_indices(), tile_indices_mod::tile_obs_bounds(), mod_param::tileside, mod_param::tilesize, mod_scalars::tkenu4, mod_param::tl_hadvection, mod_param::tl_lbc, mod_param::tl_vadvection, mod_scalars::tl_visc4, mod_scalars::tnudg, mod_scalars::tobc_in, mod_scalars::tobc_out, mod_param::vadvection, mod_ncparam::version, mod_ncparam::vname, and mod_scalars::znudg.

Referenced by roms_kernel_mod::roms_initialize(), and roms_kernel_mod::roms_initializep1().

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