58# if defined PIO_LIB && defined DISTRIBUTE
64# ifdef ADJUST_BOUNDARY
85# if defined POSTERIOR_ERROR_I || defined POSTERIOR_ERROR_F
88# if defined POSTERIOR_EOFS || defined POSTERIOR_ERROR_I || \
89 defined posterior_error_f
103# if defined POSTERIOR_ERROR_I || defined POSTERIOR_ERROR_F || \
104 defined posterior_eofs
107# if defined POSTERIOR_ERROR_I || defined POSTERIOR_ERROR_F
110# if defined POSTERIOR_ERROR_I || defined POSTERIOR_ERROR_F || \
117# ifdef POSTERIOR_EOFS
120# ifdef POSTERIOR_ERROR_F
128# if defined BALANCE_OPERATOR && defined ZETA_ELLIPTIC
139# if defined POSTERIOR_ERROR_I || defined POSTERIOR_ERROR_F || \
176 integer,
intent(in) :: my_outer
178 real(dp),
intent(in) :: runinterval
183 integer :: fcount, tindex
187# if defined MODEL_COUPLING && !defined MCT_LIB
188 integer :: nstrstep, nendstep, extra
190 real(dp) :: endtime, nexttime
193 character (len=*),
parameter :: myfile = &
194 & __FILE__//
", background"
207 DO thread=thread_range
239 ini(ng)%Nrec(fcount)=1
257 IF (my_outer.eq.0)
THEN
261 CALL background_std (ng, tile, tindex, lstd)
268 IF (lwrtstd(ng))
THEN
270 fcount=
std(5,ng)%load
271 std(5,ng)%Nrec(fcount)=1
273 CALL wrt_std (ng,
myrank, lstd)
275 CALL wrt_std (ng, -1, lstd)
289 WRITE (
his(ng)%name,10) trim(
fwd(ng)%head), my_outer
290 lstr=len_trim(
his(ng)%name)
291 his(ng)%base=
his(ng)%name(1:lstr-3)
307# if defined MODEL_COUPLING && !defined MCT_LIB
323 WRITE (
avg(ng)%name,10) trim(
avg(ng)%head), my_outer
324 lstr=len_trim(
avg(ng)%name)
325 avg(ng)%base=
avg(ng)%name(1:lstr-3)
328# if defined MODEL_COUPLING && !defined MCT_LIB
330 nexttime=
time(ng)+runinterval
332 IF ((nexttime.eq.endtime).and.(ng.eq.1))
THEN
365 DO thread=thread_range
371 10
FORMAT (a,
'_outer',i0,
'.nc')
372 20
FORMAT (/,1x,a,1x,
'ROMS: started time-stepping:', &
373 &
' (Grid: ',i0,
', Outer: ',i2.2,
', Inner: ',i3.3, &
374 ', TimeSteps: ',i0,
' - ',i0,
')',/)
424 integer,
intent(in) :: my_outer
426 real(dp),
intent(in) :: runinterval
430 logical :: lcgini, linner, lposterior, add
432 integer :: i, ifile, lstr, my_inner, ng, tile
433 integer :: fcount, inprec, tindex
442 character (len=6 ) :: driver =
'r4dvar'
443 character (len=10 ) :: suffix
444 character (len=20 ) :: string
446 character (len=256) :: ncname
448 character (len=*),
parameter :: myfile = &
449 & __FILE__//
", increment"
464 DO thread=thread_range
479 IF (my_outer.gt.1)
THEN
495 IF (my_outer.gt.1)
THEN
506 IF (my_outer.gt.1)
THEN
517 IF (my_outer.gt.1)
THEN
528 IF (my_outer.gt.1)
THEN
533 fcount=
adm(ng)%Fcount
554 IF (my_outer.gt.1)
THEN
568 IF (my_outer.eq.1)
THEN
570 SELECT CASE (
dav(ng)%IOtype)
574 & ncid =
dav(ng)%ncid)
576# if defined PIO_LIB && defined DISTRIBUTE
580 & piofile =
dav(ng)%pioFile)
587 SELECT CASE (
dav(ng)%IOtype)
591 & ncid =
dav(ng)%ncid)
593# if defined PIO_LIB && defined DISTRIBUTE
597 & piofile =
dav(ng)%pioFile)
608 SELECT CASE (
obs(ng)%IOtype)
618# if defined PIO_LIB && defined DISTRIBUTE
636 WRITE (
his(ng)%name,10) trim(
fwd(ng)%head), 0
637 lstr=len_trim(
his(ng)%name)
638 his(ng)%base=
his(ng)%name(1:lstr-3)
639 IF (
his(ng)%Nfiles.gt.1)
THEN
640 DO ifile=1,
his(ng)%Nfiles
641 WRITE (suffix,
"('_',i4.4,'.nc')") ifile
642 his(ng)%files(ifile)=trim(
his(ng)%base)//trim(suffix)
644 his(ng)%name=trim(
his(ng)%files(1))
646 his(ng)%files(1)=trim(
his(ng)%name)
656 SELECT CASE (
his(ng)%IOtype)
660 & start = (/inprec/), &
663# if defined PIO_LIB && defined DISTRIBUTE
667 & start = (/inprec/), &
674# ifdef ADJUST_BOUNDARY
684# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
695# if defined ADJUST_BOUNDARY || \
696 defined adjust_stflux || defined adjust_wstress
706 IF (my_outer.gt.1)
THEN
718 IF (my_outer.gt.1)
THEN
720 WRITE (
tlm(ng)%name,10) trim(
fwd(ng)%head), my_outer-1
721 lstr=len_trim(
tlm(ng)%name)
722 tlm(ng)%base=
tlm(ng)%name(1:lstr-3)
732 check_outer1 :
IF (my_outer.eq.1)
THEN
751# if defined POSTERIOR_EOFS || defined POSTERIOR_ERROR_I || \
752 defined posterior_error_f
765# if defined POSTERIOR_ERROR_I || defined POSTERIOR_ERROR_F
800 IF (my_outer.eq.1)
THEN
810# ifdef FORWARD_FLUXES
839 WRITE (
tlm(ng)%name,10) trim(
fwd(ng)%head), my_outer
840 lstr=len_trim(
tlm(ng)%name)
841 tlm(ng)%base=
tlm(ng)%name(1:lstr-3)
853# ifndef DATALESS_LOOPS
874 WRITE (
stdout,20)
'RP', ng, my_outer, 0, &
896 IF (
fourdvar(ng)%DataPenalty(i).ne.0.0_r8)
THEN
907 SELECT CASE (
dav(ng)%IOtype)
910 &
'RP_iDataPenalty', &
914 & ncid =
dav(ng)%ncid)
916# if defined PIO_LIB && defined DISTRIBUTE
919 &
'RP_iDataPenalty', &
923 & piofile =
dav(ng)%pioFile)
949# ifdef ADJUST_BOUNDARY
955# if defined BALANCE_OPERATOR && defined ZETA_ELLIPTIC
978 inner_loop :
DO my_inner=0,
ninner
984 IF (my_inner.eq.0)
THEN
994 IF ((my_inner.ne.0).or.(
nrun.ne.1))
THEN
995 IF (((my_inner.eq.0).and.
lhotstart).or.(my_inner.ne.0))
THEN
1002 inner_compute :
IF (linner)
THEN
1017# ifdef RPM_RELAXATION
1034 adm(ng)%Nrec(fcount)=0
1042 WRITE (
stdout,20)
'AD', ng, my_outer, my_inner, &
1097# ifdef POSTERIOR_ERROR_I
1114 WRITE (
stdout,40) my_outer, my_inner
1141 IF (
frcrec(ng).gt.3)
THEN
1157 IF ((my_outer.eq.1).and.(my_inner.eq.1))
THEN
1168 IF (my_inner.gt.1)
ldeftlm(ng)=.false.
1170 tlm(ng)%Nrec(fcount)=0
1180 WRITE (
stdout,20)
'TL', ng, my_outer, my_inner, &
1197# ifdef POSTERIOR_ERROR_F
1205 CALL load_tltoad (ng, tile,
lold(ng),
lold(ng), add)
1212 IF (my_inner.ne.0)
THEN
1220 & __line__, myfile))
RETURN
1237 END IF inner_compute
1264# ifdef RPM_RELAXATION
1281 adm(ng)%Nrec(fcount)=0
1358# endif /* !DATALESS_LOOPS */
1365 DO thread=thread_range
1371 10
FORMAT (a,
'_outer',i0,
'.nc')
1372 20
FORMAT (/,1x,a,1x,
'ROMS: started time-stepping:', &
1373 &
' (Grid: ',i0,
', Outer: ',i2.2,
', Inner: ',i3.3, &
1374 ', TimeSteps: ',i0,
' - ',i0,
')',/)
1375 30
FORMAT (
' (',i3.3,
',',i3.3,
'): ',a,
' data penalty, Jdata = ', &
1376 & 1p,e17.10,0p,t68,a)
1377 40
FORMAT (/,
' Converting Convolved Adjoint Trajectory to', &
1378 &
' Impulses: Outer = ',i3.3,
' Inner = ',i3.3,/)
1400 integer,
intent(in) :: my_outer
1402 real(dp),
intent(in) :: runinterval
1406 integer :: i, ifile, lstr, ng
1416 character (len=10) :: suffix
1417 character (len=20) :: string
1419 character (len=*),
parameter :: myfile = &
1420 & __FILE__//
", analysis"
1434 DO thread=thread_range
1472 SELECT CASE (
dav(ng)%IOtype)
1476 & ncid =
dav(ng)%ncid)
1478# if defined PIO_LIB && defined DISTRIBUTE
1482 & piofile =
dav(ng)%pioFile)
1492 WRITE (
his(ng)%name,10) trim(
fwd(ng)%head), 0
1493 lstr=len_trim(
his(ng)%name)
1494 his(ng)%base=
his(ng)%name(1:lstr-3)
1495 IF (
his(ng)%Nfiles.gt.1)
THEN
1496 DO ifile=1,
his(ng)%Nfiles
1497 WRITE (suffix,
"('_',i4.4,'.nc')") ifile
1498 his(ng)%files(ifile)=trim(
his(ng)%base)//trim(suffix)
1500 his(ng)%name=trim(
his(ng)%files(1))
1502 his(ng)%files(1)=trim(
his(ng)%name)
1512 SELECT CASE (
his(ng)%IOtype)
1516 & start = (/inprec/), &
1519# if defined PIO_LIB && defined DISTRIBUTE
1523 & start = (/inprec/), &
1530# ifdef ADJUST_BOUNDARY
1540# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1553 IF (my_outer.gt.1)
THEN
1555 WRITE (
tlm(ng)%name,10) trim(
fwd(ng)%head), my_outer-1
1556 lstr=len_trim(
tlm(ng)%name)
1557 tlm(ng)%base=
tlm(ng)%name(1:lstr-3)
1567 IF (my_outer.eq.1)
THEN
1577# ifdef FORWARD_FLUXES
1614 WRITE (
tlm(ng)%name,10) trim(
fwd(ng)%head), my_outer
1615 lstr=len_trim(
tlm(ng)%name)
1616 tlm(ng)%base=
tlm(ng)%name(1:lstr-3)
1623 IF (
frcrec(ng).gt.3)
THEN
1631# ifdef DATALESS_LOOPS
1643 IF (my_outer.eq.
nouter)
THEN
1657 WRITE (
avg(ng)%name,10) trim(
avg(ng)%head), my_outer
1658 lstr=len_trim(
avg(ng)%name)
1659 avg(ng)%base=
avg(ng)%name(1:lstr-3)
1691 IF (
fourdvar(ng)%DataPenalty(i).ne.0.0_r8)
THEN
1695# ifdef DATALESS_LOOPS
1709 SELECT CASE (
dav(ng)%IOtype)
1712 &
'RP_fDataPenalty', &
1716 & ncid =
dav(ng)%ncid)
1718# if defined PIO_LIB && defined DISTRIBUTE
1721 &
'RP_fDataPenalty', &
1725 & piofile =
dav(ng)%pioFile)
1735# ifdef DATALESS_LOOPS
1749 IF (my_outer.eq.
nouter)
THEN
1752# if defined PIO_LIB && defined DISTRIBUTE
1754 his(ng)%pioFile%fh=-1
1765 DO thread=thread_range
1771 10
FORMAT (a,
'_outer',i0,
'.nc')
1772 20
FORMAT (/,1x,a,1x,
'ROMS: started time-stepping:', &
1773 &
' (Grid: ',i0,
', Outer: ',i2.2,
', Inner: ',i3.3, &
1774 ', TimeSteps: ',i0,
' - ',i0,
')',/)
1775 30
FORMAT (
' (',i3.3,
',',i3.3,
'): ',a,
' data penalty, Jdata = ', &
1776 & 1p,e17.10,0p,t68,a)
1796 integer,
intent(in) :: ng
1801 integer :: nrmrec, stdrec, tindex
1803 character (len=*),
parameter :: myfile = &
1804 & __FILE__//
", prior_error"
1851# ifdef ADJUST_BOUNDARY
1861# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
1878 IF (ldefstd(ng))
THEN
1902# ifdef ADJUST_BOUNDARY
1907# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
1928# ifdef ADJUST_BOUNDARY
1933# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
1942# if defined POSTERIOR_ERROR_I || defined POSTERIOR_ERROR_F || \
1964 real(dp),
intent(in) :: runinterval
1970 integer :: my_inner, my_outer, ng, tile
1971 integer :: fcount, rec
1973 character (len=6) :: driver =
'w4dvar'
1975 character (len=*),
parameter :: myfile = &
1976 & __FILE__//
", posterior_error"
1980# if defined POSTERIOR_ERROR_I || defined POSTERIOR_ERROR_F
1995# ifdef ADJUST_BOUNDARY
2005 var_oloop :
DO my_outer=1,
nouter
2022 CALL wrt_error (ng, -1,
rec1,
rec1)
2036# ifdef ADJUST_BOUNDARY
2044# ifdef POSTERIOR_EOFS
2062 trace_oloop :
DO my_outer=1,
nouter
2066 trace_iloop :
DO my_inner=1,
nposti
2103 post_oloop :
DO my_outer=1,
nouter
2113 adm(ng)%Nrec(fcount)=0
2116 post_iloop :
DO my_inner=0,
nposti
2124 IF (my_inner.ne.0)
THEN
2129 & __line__, myfile))
RETURN
2138 & __line__, myfile))
RETURN
2161# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
2164# ifdef ADJUST_BOUNDARY
2198# endif /* POSTERIOR_EOFS */
2207# ifdef POSTERIOR_EOFS
2209 10
FORMAT (/,
' <<<< Posterior Analysis Error Covariance Matrix', &
2210 &
' Estimation >>>>',/)
subroutine ad_initial(ng)
subroutine ad_main3d(runinterval)
subroutine edit_multifile(task)
subroutine main3d(runinterval)
subroutine, public ad_def_his(ng, ldef)
subroutine, public ad_wrt_his(ng, tile)
subroutine, public close_file(ng, model, s, ncname, lupdate)
subroutine, public congrad(ng, model, outloop, innloop, ninnloop, lcgini)
subroutine, public cg_read_congrad(ng, model, outloop)
subroutine, public convolve(driver, rini, rold, rnew)
subroutine, public error_covariance(model, driver, outloop, innloop, rbck, rini, rold, rnew, rec1, rec2, lposterior)
subroutine, public def_dai(ng)
subroutine, public def_error(ng)
subroutine, public def_hessian(ng)
subroutine, public def_impulse(ng)
subroutine, public def_ini(ng)
subroutine, public def_mod(ng)
subroutine, public def_norm(ng, model, ifile)
subroutine, public get_state(ng, model, msg, s, inirec, tindex)
subroutine, public initialize_boundary(ng, tile, model)
subroutine, public initialize_forces(ng, tile, model)
type(t_fourdvar), dimension(:), allocatable fourdvar
logical, dimension(:), allocatable wrtmisfit
logical, dimension(:), allocatable wrtrpmod
real(r8), dimension(:), allocatable obsval
logical, dimension(:), allocatable havenlmod
logical, dimension(:), allocatable wrttlmod
logical, dimension(:), allocatable wrtnlmod
logical, dimension(:), allocatable wrtforce
real(r8), dimension(:), allocatable obsscale
real(r8), dimension(:), allocatable obserr
logical, dimension(:), allocatable wrtobsscale
real(r8), dimension(:), allocatable nlmodval
logical, dimension(:), allocatable lweakrelax
logical, dimension(:), allocatable wrtzetaref
integer, dimension(:), allocatable nstatevar
type(t_io), dimension(:,:), allocatable std
type(t_io), dimension(:), allocatable his
type(t_io), dimension(:,:), allocatable nrm
type(t_io), dimension(:), allocatable adm
type(t_io), dimension(:), allocatable irp
type(t_io), dimension(:), allocatable obs
type(t_io), dimension(:), allocatable tlf
type(t_io), dimension(:), allocatable tlm
type(t_io), dimension(:), allocatable itl
type(t_io), dimension(:), allocatable dav
type(t_io), dimension(:), allocatable fwd
type(t_io), dimension(:), allocatable ini
type(t_io), dimension(:), allocatable avg
character(len=256) sourcefile
integer, parameter io_nf90
integer, dimension(:), allocatable idefavg
integer, parameter io_pio
integer, dimension(:), allocatable ideftlm
character(len=maxlen), dimension(6, 0:nv) vname
integer, dimension(:), allocatable idsvar
subroutine, public initialize_ocean(ng, tile, model)
integer, dimension(:), allocatable first_tile
integer, dimension(:), allocatable last_tile
logical, dimension(:,:), allocatable lwrtnrm
integer, dimension(:), allocatable ntimes
logical, dimension(:), allocatable ldefitl
integer, dimension(:), allocatable iic
logical, dimension(:), allocatable ldeferr
logical, dimension(:), allocatable lreadstd
real(dp), dimension(:), allocatable dt
logical, dimension(:), allocatable ldefhss
integer, dimension(:), allocatable nobc
logical, dimension(:), allocatable setgridconfig
logical, dimension(:), allocatable balance
logical, dimension(:), allocatable ldeftlf
integer, dimension(:), allocatable frcrec
logical, dimension(:), allocatable lreadfrc
integer, dimension(:), allocatable nfrec
logical, dimension(:), allocatable ldefini
logical, dimension(:), allocatable ldefavg
logical, dimension(:), allocatable lwrtavg
logical, dimension(:), allocatable ldefadj
logical, dimension(:), allocatable frequentimpulse
logical, dimension(:), allocatable ldefhis
integer, dimension(:), allocatable ntend
logical, dimension(:), allocatable ldefmod
logical, dimension(:), allocatable ldefirp
logical, dimension(:,:), allocatable ldefnrm
logical, dimension(:), allocatable lwrtstate2d
real(dp), dimension(:,:), allocatable obc_time
logical, dimension(:), allocatable sporadicimpulse
logical, dimension(:), allocatable lwrthis
logical, dimension(:), allocatable lwrttlm
real(dp), dimension(:), allocatable time
logical, dimension(:), allocatable ldeftlm
integer, dimension(:), allocatable nsff
integer, dimension(:), allocatable ntstart
integer, dimension(:), allocatable step_counter
real(dp), dimension(:,:), allocatable sf_time
integer, dimension(:), allocatable nbrec
logical, dimension(:), allocatable lreadfwd
real(dp), dimension(:), allocatable initime
logical, dimension(:), allocatable lreadblk
integer, dimension(:), allocatable lold
integer, dimension(:), allocatable lbout
integer, dimension(:), allocatable kstp
integer, dimension(:), allocatable lnew
integer, dimension(:), allocatable lfout
integer, dimension(:), allocatable nstp
subroutine, public normalization(ng, tile, ifac)
subroutine posterior_eofs(ng, tile, model, lbi, ubi, lbj, ubj, lbij, ubij, imins, imaxs, jmins, jmaxs, lold, lnew, lwrk, innloop, outloop, rmask, umask, vmask, nl_t_obc, nl_u_obc, nl_v_obc, nl_ubar_obc, nl_vbar_obc, nl_zeta_obc, nl_ustr, nl_vstr, nl_tflux, nl_t, nl_u, nl_v, nl_ubar, nl_vbar, nl_zeta, tl_t_obc, tl_u_obc, tl_v_obc, tl_ubar_obc, tl_vbar_obc, tl_zeta_obc, tl_ustr, tl_vstr, tl_tflux, tl_t, tl_u, tl_v, tl_ubar, tl_vbar, tl_zeta, ad_t_obc, ad_u_obc, ad_v_obc, ad_ubar_obc, ad_vbar_obc, ad_zeta_obc, ad_ustr, ad_vstr, ad_tflux, ad_t, ad_u, ad_v, ad_ubar, ad_vbar, ad_zeta)
subroutine, public posterior(ng, tile, model, innloop, outloop, ltrace)
subroutine, public posterior_var(ng, tile, model, outloop)
subroutine, public posterior_error(runinterval)
subroutine, public increment(my_outer, runinterval)
subroutine, public analysis(my_outer, runinterval)
subroutine, public prior_error(ng)
subroutine, public background(my_outer, runinterval)
subroutine, public random_ic(ng, tile, model, innloop, outloop, lout, ltrace)
subroutine, public rp_def_ini(ng)
logical function, public founderror(flag, noerr, line, routine)
subroutine, public tl_def_ini(ng)
subroutine, public tl_wrt_ini(ng, tile, tindex, outrec)
subroutine, public wrt_hessian(ng, tile, kout, nout)
subroutine, public wrt_impulse(ng, tile, model, inpncname)
subroutine, public wrt_ini(ng, tile, tindex, outrec)
subroutine, public biconj(ng, tile, model, lbck)
subroutine, public balance_ref(ng, tile, lbck)
subroutine rp_initial(ng)
subroutine rp_main3d(runinterval)
subroutine set_grid(ng, model)
recursive subroutine wclock_off(ng, model, region, line, routine)
recursive subroutine wclock_on(ng, model, region, line, routine)
subroutine tl_initial(ng)
subroutine tl_main3d(runinterval)