64#if defined PIO_LIB && defined DISTRIBUTE
105#if defined BALANCE_OPERATOR && defined ZETA_ELLIPTIC
128 logical,
intent(inout) :: first
130 integer,
intent(in),
optional :: mpiCOMM
134 logical :: allocate_vars = .true.
137 integer :: MyError, MySize
139 integer :: STDrec, Tindex
140 integer :: chunk_size, ng, thread
142 integer :: my_threadnum
145 character (len=*),
parameter :: MyFile = &
146 & __FILE__//
", ROMS_initialize"
154 IF (
PRESENT(mpicomm))
THEN
204#elif defined DISTRIBUTE
221 10
FORMAT (/,
' Process Information:',/)
225 DO thread=thread_range
238#if defined MCT_LIB && (defined ATM_COUPLING || defined WAV_COUPLING)
246 CALL initialize_ocn2atm_coupling (ng,
myrank)
249 CALL initialize_ocn2wav_coupling (ng,
myrank)
254#if !defined RECOMPUTE_4DVAR
264 SELECT CASE (
lcz(ng)%IOtype)
295 &
'TLmodVal_S', tlmodval_s, &
296 & broadcast = .false.)
313# if defined PIO_LIB && defined DISTRIBUTE
344 &
'TLmodVal_S', tlmodval_s)
375 SELECT CASE (
lcz(ng)%IOtype)
380# if defined PIO_LIB && defined DISTRIBUTE
416#ifdef ADJUST_BOUNDARY
427#if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
453 real(dp),
intent(in) :: RunInterval
457 logical :: Lcgini, Linner, Lposterior
459 integer :: my_inner, my_outer
460 integer :: Lbck, Lini, Rec1, Rec2
461 integer :: i, lstr, ng, status, tile
462 integer :: Fcount, NRMrec
464 integer,
dimension(Ngrids) :: indxSave
465 integer,
dimension(Ngrids) :: Nrec
467 real(r8) :: str_day, end_day
469 character (len=25) :: driver
470 character (len=20) :: string
472 character (len=*),
parameter :: MyFile = &
473 & __FILE__//
", ROMS_run"
482#if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
486#ifdef ADJUST_BOUNDARY
502 driver=
'obs_sen_rbl4dvar_analysis'
533 ini(ng)%Nrec(fcount)=1
550 lstr=len_trim(
his(ng)%name)
551 his(ng)%base=
his(ng)%name(1:lstr-3)
573#ifdef ADJUST_BOUNDARY
578#if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
598#ifdef ADJUST_BOUNDARY
603#if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
610#if !defined RECOMPUTE_4DVAR && defined BALANCE_OPERATOR && \
611 defined zeta_elliptic
661 SELECT CASE (
dav(ng)%IOtype)
665 & (/1/), (/
ndatum(ng)/), &
666 & ncid =
dav(ng)%ncid, &
669# if defined PIO_LIB && defined DISTRIBUTE
673 & (/1/), (/
ndatum(ng)/), &
674 & piofile =
dav(ng)%pioFile, &
686 SELECT CASE (
dav(ng)%IOtype)
691 & ncid =
dav(ng)%ncid)
693#if defined PIO_LIB && defined DISTRIBUTE
698 & piofile =
dav(ng)%pioFile)
744 IF (
fourdvar(ng)%NLPenalty(i).ne.0.0_r8)
THEN
755 SELECT CASE (
dav(ng)%IOtype)
758 &
'NL_iDataPenalty', &
761 & ncid =
dav(ng)%ncid)
763# if defined PIO_LIB && defined DISTRIBUTE
766 &
'NL_iDataPenalty', &
769 & piofile =
dav(ng)%pioFile)
779#endif /* !SKIP_NLM */
816#ifdef RECOMPUTE_4DVAR
855 outer_loop :
DO my_outer=1,
nouter
863 WRITE (
fwd(ng)%name,10) trim(
fwd(ng)%head),
outer-1
864 lstr=len_trim(
fwd(ng)%name)
865 fwd(ng)%base=
fwd(ng)%name(1:lstr-3)
875# ifdef ADJUST_BOUNDARY
881# if defined BALANCE_OPERATOR && defined ZETA_ELLIPTIC
900 inner_loop :
DO my_inner=0,
ninner
924 inner_compute :
IF (linner)
THEN
937 & __line__, myfile))
RETURN
948 adm(ng)%Nrec(fcount)=0
978 & __line__, myfile))
RETURN
992 & __line__, myfile))
RETURN
1000 & rec1, rec2, lposterior)
1017 CALL wrt_impulse (ng, -1,
iadm,
adm(ng)%name)
1020 & __line__, myfile))
RETURN
1041 IF (
frcrec(ng).gt.3)
THEN
1052 & __line__, myfile))
RETURN
1096 & __line__, myfile))
RETURN
1099 END IF inner_compute
1125 adm(ng)%Nrec(fcount)=0
1176 & rec1, rec2, lposterior)
1193 CALL wrt_impulse (ng, -1,
iadm,
adm(ng)%name)
1211 lstr=len_trim(
his(ng)%name)
1212 his(ng)%base=
his(ng)%name(1:lstr-3)
1219 IF (
frcrec(ng).gt.3)
THEN
1230# ifdef ADJUST_BOUNDARY
1241 indxsave(ng)=
ini(ng)%Rindex
1249 ini(ng)%Rindex=indxsave(ng)
1271 CALL main3d (runinterval)
1273 CALL main2d (runinterval)
1292 IF (
fourdvar(ng)%NLPenalty(i).ne.0.0_r8)
THEN
1303 SELECT CASE (
dav(ng)%IOtype)
1306 &
'NL_fDataPenalty', &
1310 & ncid =
dav(ng)%ncid)
1312# if defined PIO_LIB && defined DISTRIBUTE
1315 &
'NL_fDataPenalty', &
1319 & piofile =
dav(ng)%pioFile)
1340#endif /* RECOMPUTE_4DVAR */
1370 IF ((
dstrs(ng).eq.0.0_r8).and.(
dends(ng).eq.0.0_r8))
THEN
1396 WRITE (
fwd(ng)%name,10) trim(
fwd(ng)%head),
outer-1
1397 lstr=len_trim(
fwd(ng)%name)
1398 fwd(ng)%base=
fwd(ng)%name(1:lstr-3)
1421 adm(ng)%Nrec(fcount)=0
1472 & rec1, rec2, lposterior)
1513#ifdef ADJUST_BOUNDARY
1522 WRITE (
fwd(ng)%name,10) trim(
fwd(ng)%head),
outer-1
1523 lstr=len_trim(
fwd(ng)%name)
1524 fwd(ng)%base=
fwd(ng)%name(1:lstr-3)
1531 IF (
frcrec(ng).gt.3)
THEN
1582 WRITE (
fwd(ng)%name,10) trim(
fwd(ng)%head),
outer-1
1583 lstr=len_trim(
fwd(ng)%name)
1584 fwd(ng)%base=
fwd(ng)%name(1:lstr-3)
1592# ifdef ADJUST_BOUNDARY
1599 ad_inner_loop :
DO my_inner=
ninner,0,-1
1601 ad_inner_loop :
DO my_inner=
ninner,1,-1
1608 IF (
inner.eq.0)
THEN
1610 SELECT CASE (
dav(ng)%IOtype)
1615# if defined PIO_LIB && defined DISTRIBUTE
1622 & __line__, myfile))
RETURN
1638 inner_compute :
IF (linner)
THEN
1648 & __line__, myfile))
RETURN
1668 adm(ng)%Nrec(fcount)=0
1718 & rec1, rec2, lposterior)
1759 IF (
frcrec(ng).gt.3)
THEN
1779 tlm(ng)%Nrec(fcount)=0
1804 END IF inner_compute
1812 END DO ad_inner_loop
1824#endif /* !OBS_IMPACT */
1832 SELECT CASE (
dav(ng)%IOtype)
1839 & (/1/), (/
mobs/), &
1841 & ncid =
dav(ng)%ncid)
1843 & __line__, myfile))
RETURN
1847 & __line__, myfile))
RETURN
1849# if defined PIO_LIB && defined DISTRIBUTE
1856 & (/1/), (/
mobs/), &
1858 & piofile =
dav(ng)%pioFile)
1860 & __line__, myfile))
RETURN
1865 & __line__, myfile))
RETURN
1875 SELECT CASE (
dav(ng)%IOtype)
1879 & (/1/), (/
mobs/), &
1880 & ncid =
dav(ng)%ncid)
1882 & __line__, myfile))
RETURN
1886 & __line__, myfile))
RETURN
1888# if defined PIO_LIB && defined DISTRIBUTE
1892 & (/1/), (/
mobs/), &
1893 & piofile =
dav(ng)%pioFile)
1895 & __line__, myfile))
RETURN
1900 & __line__, myfile))
RETURN
1914#if defined OBS_IMPACT && defined OBS_IMPACT_SPLIT
1936# ifdef ADJUST_BOUNDARY
1945 WRITE (
fwd(ng)%name,10) trim(
fwd(ng)%head),
outer-1
1946 lstr=len_trim(
fwd(ng)%name)
1947 fwd(ng)%base=
fwd(ng)%name(1:lstr-3)
1954 IF (
frcrec(ng).gt.3)
THEN
1973# ifdef ADJUST_BOUNDARY
2015 SELECT CASE (
dav(ng)%IOtype)
2022 & (/1/), (/
mobs/), &
2024 & ncid =
dav(ng)%ncid)
2026 & __line__, myfile))
RETURN
2030 & __line__, myfile))
RETURN
2032# if defined PIO_LIB && defined DISTRIBUTE
2039 & (/1/), (/
mobs/), &
2041 & piofile =
dav(ng)%pioFile)
2043 & __line__, myfile))
RETURN
2048 & __line__, myfile))
RETURN
2053# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
2075# ifdef ADJUST_BOUNDARY
2084 WRITE (
fwd(ng)%name,10) trim(
fwd(ng)%head),
outer-1
2085 lstr=len_trim(
fwd(ng)%name)
2086 fwd(ng)%base=
fwd(ng)%name(1:lstr-3)
2093 IF (
frcrec(ng).gt.3)
THEN
2112# ifdef ADJUST_BOUNDARY
2154 SELECT CASE (
dav(ng)%IOtype)
2161 & (/1/), (/
mobs/), &
2163 & ncid =
dav(ng)%ncid)
2165 & __line__, myfile))
RETURN
2169 & __line__, myfile))
RETURN
2171# if defined PIO_LIB && defined DISTRIBUTE
2178 & (/1/), (/
mobs/), &
2180 & piofile =
dav(ng)%pioFile)
2182 & __line__, myfile))
RETURN
2187 & __line__, myfile))
RETURN
2193# if defined ADJUST_BOUNDARY
2215# ifdef ADJUST_BOUNDARY
2224 WRITE (
fwd(ng)%name,10) trim(
fwd(ng)%head),
outer-1
2225 lstr=len_trim(
fwd(ng)%name)
2226 fwd(ng)%base=
fwd(ng)%name(1:lstr-3)
2233 IF (
frcrec(ng).gt.3)
THEN
2292 SELECT CASE (
dav(ng)%IOtype)
2299 & (/1/), (/
mobs/), &
2301 & ncid =
dav(ng)%ncid)
2303 & __line__, myfile))
RETURN
2307 & __line__, myfile))
RETURN
2309# if defined PIO_LIB && defined DISTRIBUTE
2316 & (/1/), (/
mobs/), &
2318 & piofile =
dav(ng)%pioFile)
2320 & __line__, myfile))
RETURN
2325 & __line__, myfile))
RETURN
2330#endif /* OBS_IMPACT_SPLIT */
2341#if defined PIO_LIB && defined DISTRIBUTE
2343 his(ng)%pioFile%fh=-1
2348 END DO ad_outer_loop
2350 10
FORMAT (a,
'_outer',i0,
'.nc')
2351 20
FORMAT (/,1x,a,1x,
'ROMS: started time-stepping:', &
2352 &
' (Grid: ',i2.2,
' TimeSteps: ',i8.8,
' - ',i8.8,
')',/)
2353 30
FORMAT (
' (',i3.3,
',',i3.3,
'): ',a,
' data penalty, Jdata = ', &
2354 & 1p,e17.10,0p,t68,a)
2355 40
FORMAT (/,
' Converting Convolved Adjoint Trajectory to', &
2356 &
' Impulses: Outer = ',i3.3,
' Inner = ',i3.3,/)
2357 50
FORMAT (/,
'ROMS: Started adjoint Sensitivity calculation', &
2359 60
FORMAT (/,
'ROMS: ',a,1x,a,
', Outer = ',i3.3, &
2360 &
' Inner = ',i3.3,/)
2361 70
FORMAT (/,1x,a,1x,
'ROMS: adjoint forcing time range: ', &
2362 & f12.4,
' - ',f12.4 ,/)
2378 integer :: Fcount, ng, thread
2380 character (len=*),
parameter :: MyFile = &
2381 & __FILE__//
", ROMS_finalize"
2405 10
FORMAT (/,
' Blowing-up: Saving latest model state into ', &
2406 &
' RESTART file',/)
2408 IF (
lcyclerst(ng).and.(
rst(ng)%Nrec(fcount).ge.2))
THEN
2432 20
FORMAT (/,
'Elapsed wall CPU time for each process (seconds):',/)
2436 DO thread=thread_range
subroutine ad_initial(ng)
subroutine ad_main3d(runinterval)
subroutine edit_multifile(task)
subroutine main3d(runinterval)
subroutine, public ad_wrt_his(ng, tile)
subroutine, public close_out
subroutine, public close_file(ng, model, s, ncname, lupdate)
subroutine, public close_inp(ng, model)
subroutine, public congrad(ng, model, outloop, innloop, ninnloop, lcgini)
subroutine, public error_covariance(model, driver, outloop, innloop, rbck, rini, rold, rnew, rec1, rec2, lposterior)
subroutine, public def_impulse(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 inp_par(model)
subroutine, public roms_initialize_arrays
subroutine, public roms_allocate_arrays(allocate_vars)
subroutine, public initialize_boundary(ng, tile, model)
subroutine, public initialize_forces(ng, tile, model)
real(dp), dimension(:), allocatable cg_gnorm_v
real(r8), dimension(:,:,:), allocatable vcglwk
type(t_fourdvar), dimension(:), allocatable fourdvar
real(dp), dimension(:,:), allocatable cg_beta
integer, dimension(:), allocatable ndatum
real(r8), dimension(:,:), allocatable cg_dla
real(dp), dimension(:,:), allocatable cg_qg
logical, dimension(:), allocatable wrtmisfit
logical, dimension(:), allocatable wrtrpmod
integer, dimension(:), allocatable nobsvar
logical, dimension(:), allocatable lsen4dvar
real(r8), dimension(:,:), allocatable ad_obsval
logical, dimension(:), allocatable wrttlmod
logical, dimension(:), allocatable wrtnlmod
logical, dimension(:), allocatable wrtforce
real(r8), dimension(:), allocatable obsscale
real(r8), dimension(:), allocatable jb0
real(r8), dimension(:,:,:), allocatable zcglwk
logical, dimension(:), allocatable wrtobsscale
real(r8), dimension(:), allocatable nlmodval
real(dp), dimension(:,:), allocatable cg_delta
character(len=40), dimension(:), allocatable obsname
logical, dimension(:), allocatable wrtzetaref
real(r8), dimension(:,:), allocatable zgrad0
type(t_io), dimension(:), allocatable lcz
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 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 rst
type(t_io), dimension(:), allocatable ini
character(len=256) sourcefile
integer, parameter io_nf90
integer, parameter io_pio
character(len=maxlen), dimension(6, 0:nv) vname
subroutine, public netcdf_sync(ng, model, ncname, ncid)
subroutine, public initialize_ocean(ng, tile, model)
subroutine, public initialize_parallel
integer, dimension(:), allocatable first_tile
integer, dimension(:), allocatable last_tile
integer, dimension(:), allocatable ntilex
integer, dimension(:), allocatable ntilee
subroutine, public pio_netcdf_sync(ng, model, ncname, piofile)
logical, dimension(:,:), allocatable lwrtnrm
logical, dimension(:), allocatable lreadqck
integer, dimension(:), allocatable ntimes
logical, dimension(:), allocatable ldefitl
real(dp), dimension(:), allocatable dt
logical, dimension(:), allocatable balance
logical, dimension(:), allocatable ldeftlf
integer, dimension(:), allocatable frcrec
logical, dimension(:), allocatable lreadfrc
real(dp), dimension(:), allocatable tdays
real(r8), dimension(:), allocatable dends
logical, dimension(:), allocatable ldefadj
logical, dimension(:), allocatable frequentimpulse
logical, dimension(:), allocatable ldefhis
real(dp), parameter sec2day
integer, dimension(:), allocatable ntend
logical, dimension(:), allocatable ldefmod
logical, dimension(:,:), allocatable ldefnrm
logical, dimension(:), allocatable sporadicimpulse
real(r8), dimension(:), allocatable dstrs
logical, dimension(:), allocatable lwrthis
logical, dimension(:), allocatable lwrttlm
logical, dimension(:), allocatable lwrtrst
logical, dimension(:), allocatable ldeftlm
integer, dimension(:), allocatable ntstart
logical, dimension(:), allocatable lreadfwd
logical, dimension(:), allocatable lcyclerst
logical, dimension(:), allocatable lreadblk
integer, dimension(:), allocatable lold
integer, dimension(:), allocatable lbout
integer, dimension(:), allocatable lfinp
integer, dimension(:), allocatable lbinp
integer, dimension(:), allocatable lnew
integer, dimension(:), allocatable lfout
subroutine, public normalization(ng, tile, ifac)
subroutine, public roms_finalize
subroutine, public roms_run(runinterval)
subroutine, public roms_initialize(first, mpicomm)
subroutine, public rpcg_lanczos(ng, model, outloop, innloop, ninnloop, lcgini)
subroutine, public stats_modobs(ng, tile)
integer function, public stdout_unit(mymaster)
logical, save set_stdoutunit
character(len(sinp)) function, public uppercase(sinp)
logical function, public founderror(flag, noerr, line, routine)
subroutine, public tl_def_ini(ng)
subroutine, public wrt_ini(ng, tile, tindex, outrec)
subroutine, public wrt_rst(ng, tile)
subroutine, public biconj(ng, tile, model, lbck)
subroutine, public balance_ref(ng, tile, lbck)
subroutine rep_matrix(ng, model, outloop, ninnloop)
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)