101 logical,
intent(inout) :: first
103 integer,
intent(in),
optional :: mpiCOMM
107 logical :: allocate_vars = .true.
110 integer :: MyError, MySize
112 integer :: chunk_size, ng, thread
114 integer :: my_threadnum
117 character (len=*),
parameter :: MyFile = &
118 & __FILE__//
", ROMS_initialize"
126 IF (
PRESENT(mpicomm))
THEN
176#elif defined DISTRIBUTE
193 10
FORMAT (/,
' Process Information:',/)
197 DO thread=thread_range
210#if defined MCT_LIB && (defined ATM_COUPLING || defined WAV_COUPLING)
218 CALL initialize_ocn2atm_coupling (ng,
myrank)
221 CALL initialize_ocn2wav_coupling (ng,
myrank)
240 real(dp),
intent(in) :: RunInterval
246 logical :: BOUNDED_AD, BOUNDED_TL, SAME_VAR
248 integer :: Istr, Iend, Jstr, Jend
250 integer :: IperAD, JperAD, KperAD, ivarAD
251 integer :: IperTL, JperTL, KperTL, ivarTL
254 real(r8) :: IniVal = 0.0_r8
256 real(r8),
dimension(4,Ngrids) :: val
259 character (len=*),
parameter :: MyFile = &
260 & __FILE__//
", ROMS_run"
273 WRITE (
stdout,10)
'Nested grids are not allowed, Ngrids = ', &
280 &
lm(ng)*(
mm(ng)-1)+ &
282 & (
lm(ng)-1)*
mm(ng)*
n(ng)+ &
283 &
lm(ng)*(
mm(ng)-1)*
n(ng)+ &
287 &
lm(ng)*(
mm(ng)-1)+ &
304 same_var=(ivartl.eq.ivarad).and. &
305 & (ipertl.eq.iperad).and. &
306 & (jpertl.eq.jperad).and. &
309 same_var=(ivartl.eq.ivarad).and. &
310 & (ipertl.eq.iperad).and. &
384 bounded_tl=((istr.le.ipertl).and.(ipertl.le.iend)).and. &
385 & ((jstr.le.jpertl).and.(jpertl.le.jend))
386 bounded_ad=((istr.le.iperad).and.(iperad.le.iend)).and. &
387 & ((jstr.le.jperad).and.(jperad.le.jend))
397 IF (ivartl.eq.
isubar)
THEN
398 val(1,ng)=
ocean(ng)%tl_ubar(ipertl,jpertl,
knew(ng))
399 ELSE IF (ivartl.eq.
isvbar)
THEN
400 val(1,ng)=
ocean(ng)%tl_vbar(ipertl,jpertl,
knew(ng))
401 ELSE IF (ivartl.eq.
isfsur)
THEN
402 val(1,ng)=
ocean(ng)%tl_zeta(ipertl,jpertl,
knew(ng))
403 ELSE IF (ivartl.eq.
isuvel)
THEN
404 val(1,ng)=
ocean(ng)%tl_u(ipertl,jpertl,kpertl,
nstp(ng))
405 ELSE IF (ivartl.eq.
isvvel)
THEN
406 val(1,ng)=
ocean(ng)%tl_v(ipertl,jpertl,kpertl,
nstp(ng))
409 IF (ivartl.eq.
istvar(i))
THEN
410 val(1,ng)=
ocean(ng)%tl_t(ipertl,jpertl,kpertl, &
416 IF (ivartl.eq.
isubar)
THEN
417 val(1,ng)=
ocean(ng)%tl_ubar(ipertl,jpertl,
knew(ng))
418 ELSE IF (ivartl.eq.
isvbar)
THEN
419 val(1,ng)=
ocean(ng)%tl_vbar(ipertl,jpertl,
knew(ng))
420 ELSE IF (ivartl.eq.
isfsur)
THEN
421 val(1,ng)=
ocean(ng)%tl_zeta(ipertl,jpertl,
knew(ng))
428 IF (ivarad.eq.
isubar)
THEN
429 val(3,ng)=
ocean(ng)%tl_ubar(iperad,jperad,
knew(ng))
430 ELSE IF (ivarad.eq.
isvbar)
THEN
431 val(3,ng)=
ocean(ng)%tl_vbar(iperad,jperad,
knew(ng))
432 ELSE IF (ivarad.eq.
isfsur)
THEN
433 val(3,ng)=
ocean(ng)%tl_zeta(iperad,jperad,
knew(ng))
434 ELSE IF (ivarad.eq.
isuvel)
THEN
435 val(3,ng)=
ocean(ng)%tl_u(iperad,jperad,kperad,
nstp(ng))
436 ELSE IF (ivarad.eq.
isvvel)
THEN
437 val(3,ng)=
ocean(ng)%tl_v(iperad,jperad,kperad,
nstp(ng))
440 IF (ivarad.eq.
istvar(i))
THEN
441 val(3,ng)=
ocean(ng)%tl_t(iperad,jperad,kperad, &
447 IF (ivarad.eq.
isubar)
THEN
448 val(3,ng)=
ocean(ng)%tl_ubar(iperad,jperad,
knew(ng))
449 ELSE IF (ivarad.eq.
isvbar)
THEN
450 val(3,ng)=
ocean(ng)%tl_vbar(iperad,jperad,
knew(ng))
451 ELSE IF (ivarad.eq.
isfsur)
THEN
452 val(3,ng)=
ocean(ng)%tl_zeta(iperad,jperad,
knew(ng))
499 bounded_ad=((istr.le.iperad).and.(iperad.le.iend)).and. &
500 & ((jstr.le.jperad).and.(jperad.le.jend))
501 bounded_tl=((istr.le.ipertl).and.(ipertl.le.iend)).and. &
502 & ((jstr.le.jpertl).and.(jpertl.le.jend))
509 IF (ivarad.eq.
isubar)
THEN
510 val(2,ng)=
ocean(ng)%ad_ubar(iperad,jperad,
kstp(ng))
511 ELSE IF (ivarad.eq.
isvbar)
THEN
512 val(2,ng)=
ocean(ng)%ad_vbar(iperad,jperad,
kstp(ng))
513 ELSE IF (ivarad.eq.
isfsur)
THEN
514 val(2,ng)=
ocean(ng)%ad_zeta(iperad,jperad,
kstp(ng))
515 ELSE IF (ivarad.eq.
isuvel)
THEN
516 val(2,ng)=
ocean(ng)%ad_u(iperad,jperad,kperad,
nstp(ng))
517 ELSE IF (ivarad.eq.
isvvel)
THEN
518 val(2,ng)=
ocean(ng)%ad_v(iperad,jperad,kperad,
nstp(ng))
521 IF (ivarad.eq.
istvar(i))
THEN
522 val(2,ng)=
ocean(ng)%ad_t(iperad,jperad,kperad, &
528 IF (ivarad.eq.
isubar)
THEN
529 val(2,ng)=
ocean(ng)%ad_ubar(iperad,jperad,
kstp(ng))
530 ELSE IF (ivarad.eq.
isvbar)
THEN
531 val(2,ng)=
ocean(ng)%ad_vbar(iperad,jperad,
kstp(ng))
532 ELSE IF (ivarad.eq.
isfsur)
THEN
533 val(2,ng)=
ocean(ng)%ad_zeta(iperad,jperad,
kstp(ng))
540 IF (ivartl.eq.
isubar)
THEN
541 val(4,ng)=
ocean(ng)%ad_ubar(ipertl,jpertl,
kstp(ng))
542 ELSE IF (ivartl.eq.
isvbar)
THEN
543 val(4,ng)=
ocean(ng)%ad_vbar(ipertl,jpertl,
kstp(ng))
544 ELSE IF (ivartl.eq.
isfsur)
THEN
545 val(4,ng)=
ocean(ng)%ad_zeta(ipertl,jpertl,
kstp(ng))
546 ELSE IF (ivartl.eq.
isuvel)
THEN
547 val(4,ng)=
ocean(ng)%ad_u(ipertl,jpertl,kpertl,
nstp(ng))
548 ELSE IF (ivartl.eq.
isvvel)
THEN
549 val(4,ng)=
ocean(ng)%ad_v(ipertl,jpertl,kpertl,
nstp(ng))
552 IF (ivartl.eq.
istvar(i))
THEN
553 val(4,ng)=
ocean(ng)%ad_t(ipertl,jpertl,kpertl, &
559 IF (ivartl.eq.
isubar)
THEN
560 val(4,ng)=
ocean(ng)%ad_ubar(ipertl,jpertl,
kstp(ng))
561 ELSE IF (ivartl.eq.
isvbar)
THEN
562 val(4,ng)=
ocean(ng)%ad_vbar(ipertl,jpertl,
kstp(ng))
563 ELSE IF (ivartl.eq.
isfsur)
THEN
564 val(4,ng)=
ocean(ng)%ad_zeta(ipertl,jpertl,
kstp(ng))
576 WRITE (
stdout,20)
'Perturbing', &
578 IF (ivartl.le.3)
THEN
579 WRITE (
stdout,30)
'Tangent: ', val(1,ng), &
581 WRITE (
stdout,30)
'Adjoint: ', val(2,ng), &
583 WRITE (
stdout,30)
'Difference: ', val(2,ng)-val(1,ng), &
586 WRITE (
stdout,40)
'Tangent: ', val(1,ng), &
587 & ipertl,jpertl,kpertl
588 WRITE (
stdout,40)
'Adjoint: ', val(2,ng), &
589 & iperad,jperad,kperad
590 WRITE (
stdout,40)
'Difference: ', val(2,ng)-val(1,ng), &
591 & ipertl,jpertl,kpertl
594 IF (ivartl.le.3)
THEN
595 WRITE (
stdout,50)
'Tangent, Perturbing: ', &
599 & val(1,ng),ipertl,jpertl
601 WRITE (
stdout,70)
'Tangent, Perturbing: ', &
603 & ipertl,jpertl,kpertl
605 & val(1,ng),ipertl,jpertl,kpertl
607 IF (ivarad.le.3)
THEN
609 & val(3,ng),iperad,jperad
612 & val(3,ng),iperad,jperad,kperad
615 IF (ivarad.le.3)
THEN
616 WRITE (
stdout,50)
'Adjoint, Perturbing: ', &
620 & val(2,ng),iperad,jperad
622 WRITE (
stdout,70)
'Adjoint, Perturbing: ', &
624 & iperad,jperad,kperad
626 & val(2,ng),iperad,jperad,kperad
628 IF (ivartl.le.3)
THEN
630 & val(4,ng),ipertl,jpertl
633 & val(4,ng),ipertl,jpertl,kpertl
635 WRITE (
stdout,90) val(3,ng)-val(4,ng)
659 10
FORMAT (/,1x,a,1x,
'ROMS: started time-stepping:', &
660 &
' (Grid: ',i2.2,
' TimeSteps: ',i8.8,
' - ',i8.8,
')',/)
662 20
FORMAT (/,
' Sanity Check - ',a,
' variable: ',a,t60)
663 30
FORMAT (
' Sanity Check - ', a, 1p,e19.12, &
664 & 3x,
'at (i,j) ',2i4)
665 40
FORMAT (
' Sanity Check - ', a, 1p,e19.12, &
666 & 3x,
'at (i,j,k) ',3i4)
667 50
FORMAT (/,
' Sanity Check - ',a, a, t52,
'at (i,j) ', 2i4)
668 60
FORMAT (
' Sanity Check - ', a,
' =', t30, 1p,e19.12, &
669 & t52,
'at (i,j) ',2i4)
670 70
FORMAT (/,
' Sanity Check - ',a, a, t52,
'at (i,j,k) ', 3i4)
671 80
FORMAT (
' Sanity Check - ', a,
' =', t30, 1p,e19.12, &
672 & t52,
'at (i,j,k) ',3i4)
673 90
FORMAT (/,
' Sanity Check - Difference = ', 1p,e19.12)
690 integer :: Fcount, ng, thread
692 character (len=*),
parameter :: MyFile = &
693 & __FILE__//
", ROMS_finalize"
705 10
FORMAT (/,
' Blowing-up: Saving latest model state into ', &
732 20
FORMAT (/,
'Elapsed wall CPU time for each process (seconds):',/)
736 DO thread=thread_range
subroutine ad_initial(ng)
subroutine ad_main3d(runinterval)
subroutine edit_multifile(task)
subroutine, public close_out
subroutine, public close_file(ng, model, s, ncname, lupdate)
subroutine, public close_inp(ng, model)
subroutine, public inp_par(model)
subroutine, public roms_initialize_arrays
subroutine, public roms_allocate_arrays(allocate_vars)
type(t_io), dimension(:), allocatable fwd
type(t_io), dimension(:), allocatable rst
character(len=256) sourcefile
integer, dimension(:), allocatable istvar
character(len=maxlen), dimension(6, 0:nv) vname
integer, dimension(:), allocatable idsvar
type(t_ocean), dimension(:), allocatable ocean
subroutine, public initialize_ocean(ng, tile, model)
subroutine, public initialize_parallel
integer, dimension(:), allocatable first_tile
integer, dimension(:), allocatable last_tile
integer, dimension(:), allocatable n
type(t_bounds), dimension(:), allocatable bounds
integer, dimension(:), allocatable ntilex
integer, dimension(:), allocatable lm
integer, dimension(:), allocatable ntilee
integer, dimension(:), allocatable nt
integer, dimension(:), allocatable mm
integer, dimension(:), allocatable ntlm
real(r8), dimension(:), allocatable user
logical, dimension(:), allocatable lreadfrc
logical, dimension(:), allocatable ldefadj
integer, dimension(:), allocatable ntend
logical, dimension(:), allocatable lwrtrst
logical, dimension(:), allocatable ldeftlm
integer, dimension(:), allocatable ntstart
integer, dimension(:), allocatable nadj
logical, dimension(:), allocatable lreadfwd
logical, dimension(:), allocatable lcyclerst
logical, dimension(:), allocatable lreadblk
integer, dimension(:), allocatable kstp
integer, dimension(:), allocatable knew
integer, dimension(:), allocatable nstp
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 wrt_rst(ng, tile)
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)