63#if defined PIO_LIB && defined DISTRIBUTE
104#if defined BALANCE_OPERATOR && defined ZETA_ELLIPTIC
127 logical,
intent(inout) :: first
129 integer,
intent(in),
optional :: mpiCOMM
133 logical :: allocate_vars = .true.
136 integer :: MyError, MySize
138 integer :: STDrec, Tindex
139 integer :: chunk_size, ng, thread
141 integer :: my_threadnum
144 character (len=*),
parameter :: MyFile = &
145 & __FILE__//
", ROMS_initialize"
153 IF (
PRESENT(mpicomm))
THEN
203#elif defined DISTRIBUTE
220 10
FORMAT (/,
' Process Information:',/)
224 DO thread=thread_range
237#if defined MCT_LIB && (defined ATM_COUPLING || defined WAV_COUPLING)
245 CALL initialize_ocn2atm_coupling (ng,
myrank)
248 CALL initialize_ocn2wav_coupling (ng,
myrank)
253#if !defined RECOMPUTE_4DVAR
262 SELECT CASE (
lcz(ng)%IOtype)
302 & start = (/1,1,1/), &
320 & start = (/1,1,1/), &
326 &
'TLmodVal_S', tlmodval_s, &
327 & start = (/1,1,1/), &
329 & broadcast = .false.)
332# if defined PIO_LIB && defined DISTRIBUTE
372 & start = (/1,1,1/), &
390 & start = (/1,1,1/), &
396 &
'TLmodVal_S', tlmodval_s, &
397 & start = (/1,1,1/), &
432#ifdef ADJUST_BOUNDARY
443#if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
469 real(dp),
intent(in) :: RunInterval
473 logical :: Lcgini, Linner, Lposterior
475 integer :: my_inner, my_outer
476 integer :: Lbck, Lini, Rec1, Rec2
477 integer :: i, lstr, ng, status, tile
478 integer :: Fcount, NRMrec
480 integer,
dimension(Ngrids) :: Nrec
482 character (len=18) :: driver
483 character (len=20) :: string
485 character (len=*),
parameter :: MyFile = &
486 & __FILE__//
", ROMS_run"
495#if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
499#ifdef ADJUST_BOUNDARY
515 driver=
'array_modes_w4dvar'
547 ini(ng)%Nrec(fcount)=1
567 lstr=len_trim(
his(ng)%name)
568 his(ng)%base=
his(ng)%name(1:lstr-3)
599#ifdef ADJUST_BOUNDARY
603#if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
622#ifdef ADJUST_BOUNDARY
626#if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
633#if !defined RECOMPUTE_4DVAR && defined BALANCE_OPERATOR && \
634 defined zeta_elliptic
682 SELECT CASE (
dav(ng)%IOtype)
687 & ncid =
dav(ng)%ncid)
689#if defined PIO_LIB && defined DISTRIBUTE
694 & piofile =
dav(ng)%pioFile)
762#ifdef RECOMPUTE_4DVAR
798 outer_loop :
DO my_outer=1,1
813 WRITE (
fwd(ng)%name,10) trim(
fwd(ng)%head),
outer-1
823 lstr=len_trim(
tlm(ng)%name)
824 tlm(ng)%base=
tlm(ng)%name(1:lstr-3)
836# ifndef DATALESS_LOOPS
874 IF (
fourdvar(ng)%DataPenalty(i).ne.0.0_r8)
THEN
885 SELECT CASE (
dav(ng)%IOtype)
888 &
'RP_iDataPenalty', &
892 & ncid =
dav(ng)%ncid)
894#if defined PIO_LIB && defined DISTRIBUTE
897 &
'RP_iDataPenalty', &
901 & piofile =
dav(ng)%pioFile)
927# ifdef ADJUST_BOUNDARY
933# if defined BALANCE_OPERATOR && defined ZETA_ELLIPTIC
954 inner_loop :
DO my_inner=0,
ninner
978 inner_compute :
IF (linner)
THEN
990 & __line__, myfile))
RETURN
994# ifdef RPM_RELAXATION
1011 adm(ng)%Nrec(fcount)=0
1041 & __line__, myfile))
RETURN
1055 & __line__, myfile))
RETURN
1063 & rec1, rec2, lposterior)
1083 & __line__, myfile))
RETURN
1095 tlm(ng)%name=trim(
tlm(ng)%head)//
'.nc'
1096 lstr=len_trim(
tlm(ng)%name)
1097 tlm(ng)%base=
tlm(ng)%name(1:lstr-3)
1104 IF (
frcrec(ng).gt.3)
THEN
1115 & __line__, myfile))
RETURN
1134 tlm(ng)%Nrec(fcount)=0
1170 & __line__, myfile))
RETURN
1173 END IF inner_compute
1200# ifdef RPM_RELAXATION
1217 adm(ng)%Nrec(fcount)=0
1268 & rec1, rec2, lposterior)
1290# endif /* !DATALESS_LOOPS */
1306 lstr=len_trim(
tlm(ng)%name)
1307 tlm(ng)%base=
tlm(ng)%name(1:lstr-3)
1314 IF (
frcrec(ng).gt.3)
THEN
1322# ifdef DATALESS_LOOPS
1366 IF (
fourdvar(ng)%DataPenalty(i).ne.0.0_r8)
THEN
1370# ifdef DATALESS_LOOPS
1384 SELECT CASE (
dav(ng)%IOtype)
1387 &
'RP_fDataPenalty', &
1391 & ncid =
dav(ng)%ncid)
1393# if defined PIO_LIB && defined DISTRIBUTE
1396 &
'RP_fDataPenalty', &
1400 & piofile =
dav(ng)%pioFile)
1410# ifdef DATALESS_LOOPS
1426#endif /* RECOMPUTE_4DVAR */
1476 WRITE (
fwd(ng)%name,10) trim(
fwd(ng)%head),
outer-1
1500 adm(ng)%Nrec(fcount)=0
1553 & rec1, rec2, lposterior)
1591 WRITE (
tlm(ng)%name,20) trim(
tlm(ng)%head),
nimpact,
'TOTAL'
1592 lstr=len_trim(
tlm(ng)%name)
1593 tlm(ng)%base=
tlm(ng)%name(1:lstr-3)
1604#ifdef ADJUST_BOUNDARY
1613 WRITE (
fwd(ng)%name,10) trim(
fwd(ng)%head),
outer-1
1620 IF (
frcrec(ng).gt.3)
THEN
1633#ifdef RPM_RELAXATION
1677#if defined ARRAY_MODES_SPLIT || defined CLIPPING_SPLIT
1696 lstr=len_trim(
tlm(ng)%name)
1697 tlm(ng)%base=
tlm(ng)%name(1:lstr-3)
1717# ifdef ADJUST_BOUNDARY
1725# ifdef RPM_RELAXATION
1749# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
1768 lstr=len_trim(
tlm(ng)%name)
1769 tlm(ng)%base=
tlm(ng)%name(1:lstr-3)
1789# ifdef ADJUST_BOUNDARY
1797# ifdef RPM_RELAXATION
1821# ifdef ADJUST_BOUNDARY
1840 lstr=len_trim(
tlm(ng)%name)
1841 tlm(ng)%base=
tlm(ng)%name(1:lstr-3)
1851 WRITE (
fwd(ng)%name,10) trim(
fwd(ng)%head),
outer-1
1874# ifdef RPM_RELAXATION
1904 IF (
frcrec(ng).gt.3)
THEN
1913 WRITE (
dav(ng)%name,20) trim(
dav(ng)%head),
nimpact,
'ERROR'
1914 WRITE (
tlm(ng)%name,20) trim(
tlm(ng)%head),
nimpact,
'ERROR'
1915 lstr=len_trim(
tlm(ng)%name)
1916 tlm(ng)%base=
tlm(ng)%name(1:lstr-3)
1938# ifdef ADJUST_BOUNDARY
1945# ifdef RPM_RELAXATION
1951 IF (maxval(
frcrec).gt.3)
THEN
1967 IF (
frcrec(ng).gt.3)
THEN
1983#if defined PIO_LIB && defined DISTRIBUTE
1985 his(ng)%pioFile%fh=-1
1990 10
FORMAT (a,
'_outer',i0,
'.nc')
1991 20
FORMAT (a,
'_outer',i0,
'_',a,
'.nc')
1992 30
FORMAT (/,1x,a,1x,
'ROMS: started time-stepping:', &
1993 &
' (Grid: ',i2.2,
' TimeSteps: ',i8.8,
' - ',i8.8,
')',/)
1994 40
FORMAT (
' (',i3.3,
',',i3.3,
'): ',a,
' data penalty, Jdata = ', &
1995 & 1p,e17.10,0p,t68,a)
1996 50
FORMAT (/,
' Convolving Adjoint Trajectory: Outer = ',i3.3, &
1998 60
FORMAT (/,
' Converting Convolved Adjoint Trajectory to', &
1999 &
' Impulses: Outer = ',i3.3,
' Inner = ',i3.3,/)
2000 70
FORMAT (/,
'ROMS: Started adjoint Sensitivity calculation', &
2002 80
FORMAT (/,
'ROMS: ',a,1x,a,
', Outer = ',i3.3, &
2003 &
' Inner = ',i3.3,/)
2004 90
FORMAT (/,1x,a,1x,
'ROMS: started time-stepping:', &
2005 &
'( TimeSteps: ',i8.8,
' - ',i8.8,
')',/,15x, &
2006 &
'adjoint forcing time range: ',f12.4,
' - ',f12.4 ,/)
2022 integer :: Fcount, ng, thread
2024 character (len=*),
parameter :: MyFile = &
2025 & __FILE__//
", ROMS_finalize"
2036 10
FORMAT (/,
' Blowing-up: Saving latest model state into ', &
2037 &
' RESTART file',/)
2039 IF (
lcyclerst(ng).and.(
rst(ng)%Nrec(fcount).ge.2))
THEN
2062 20
FORMAT (/,
'Elapsed wall CPU time for each process (seconds):',/)
2066 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 rep_check(ng, model, outloop, ninnloop)
subroutine, public rep_eigen(ng, model, outloop, ninnloop)
subroutine, public rep_clip(ng, model, outloop, ninnloop)
subroutine, public close_out
subroutine, public close_file(ng, model, s, ncname, lupdate)
subroutine, public close_inp(ng, model)
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
type(t_fourdvar), dimension(:), allocatable fourdvar
real(dp), dimension(:,:), allocatable cg_beta
real(dp), dimension(:,:), allocatable cg_ritz
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 wrttlmod
logical, dimension(:), allocatable wrtnlmod
logical, dimension(:), allocatable wrtforce
real(r8), dimension(:), allocatable obsscale
real(dp), dimension(:,:,:), allocatable cg_zv
real(r8), dimension(:,:,:), allocatable zcglwk
logical, dimension(:), allocatable wrtobsscale
real(dp), dimension(:,:), allocatable cg_delta
logical, dimension(:), allocatable lweakrelax
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 irp
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
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
logical, dimension(:,:), allocatable lwrtnrm
logical, dimension(:), allocatable ldefitl
logical, dimension(:), allocatable balance
logical, dimension(:), allocatable ldeftlf
integer, dimension(:), allocatable frcrec
logical, dimension(:), allocatable lreadfrc
logical, dimension(:), allocatable ldefadj
logical, dimension(:), allocatable frequentimpulse
logical, dimension(:), allocatable ldefhis
integer, dimension(:), allocatable ntend
logical, dimension(:), allocatable ldefmod
logical, dimension(:,:), allocatable ldefnrm
logical, dimension(:), allocatable sporadicimpulse
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)
integer function, public stdout_unit(mymaster)
logical, save set_stdoutunit
logical function, public founderror(flag, noerr, line, routine)
subroutine, public tl_def_ini(ng)
subroutine, public wrt_impulse(ng, tile, model, inpncname)
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 rp_initial(ng)
subroutine rp_main3d(runinterval)
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)