47#if defined PIO_LIB && defined DISTRIBUTE
98 logical,
intent(inout) :: first
100 integer,
intent(in),
optional :: mpiCOMM
104 logical :: allocate_vars = .true.
107 integer :: MyError, MySize
109 integer :: chunk_size, ng, thread
111 integer :: my_threadnum
114 character (len=*),
parameter :: MyFile = &
115 & __FILE__//
", ROMS_initialize"
123 IF (
PRESENT(mpicomm))
THEN
173#elif defined DISTRIBUTE
190 10
FORMAT (/,
' Process Information:',/)
194 DO thread=thread_range
207#if defined MCT_LIB && (defined ATM_COUPLING || defined WAV_COUPLING)
215 CALL initialize_ocn2atm_coupling (ng,
myrank)
218 CALL initialize_ocn2wav_coupling (ng,
myrank)
357 real(dp),
intent(in) :: RunInterval
366 integer :: Fcount, Is, Ie, i, iter, ng
367 integer :: NconvRitz(Ngrids)
371 real(r8),
dimension(2) :: my_norm, my_value
373 TYPE (T_GST),
allocatable :: ad_state(:)
374 TYPE (T_GST),
allocatable :: state(:)
376 character (len=55) :: string
378 character (len=*),
parameter :: MyFile = &
379 & __FILE__//
", ROMS_run"
388 IF (.not.
allocated(ad_state))
THEN
389 allocate ( ad_state(ngrids) )
391 IF (.not.
allocated(state))
THEN
392 allocate ( state(ngrids) )
404 iter_loop :
DO WHILE (iterate)
443 & (any(
ido.eq.99)))
THEN
461 IF (any(abs(
ido).eq.1))
THEN
464 adm(ng)%Nrec(fcount)=0
466 tlm(ng)%Nrec(fcount)=0
475 IF (
ASSOCIATED(state(ng)%vector))
THEN
476 nullify (state(ng)%vector)
480 state(ng)%vector =>
storage(ng)%SworkD(is:ie)
482 IF (
ASSOCIATED(ad_state(ng)%vector))
THEN
483 nullify (ad_state(ng)%vector)
487 ad_state(ng)%vector =>
storage(ng)%SworkD(is:ie)
493 IF (any(
info.ne.0))
THEN
495 IF (
info(ng).ne.0)
THEN
498 WRITE (
stdout,10)
'DSAUPD', trim(string), &
499 &
', info = ',
info(ng)
511 nconvritz(ng)=
iparam(5,ng)
513 WRITE (
stdout,20)
'Number of converged Ritz values:', &
515 WRITE (
stdout,20)
'Number of Arnoldi iterations:', &
549 IF (any(
info.ne.0))
THEN
551 IF (
info(ng).ne.0)
THEN
554 WRITE (
stdout,10)
'DSEUPD', trim(string), &
555 &
', info = ',
info(ng)
568 DO i=1,maxval(nconvritz)
572 adm(ng)%Nrec(fcount)=0
574 tlm(ng)%Nrec(fcount)=0
581 WRITE (
adm(ng)%name,30) trim(
adm(ng)%base), i
582 WRITE (
tlm(ng)%name,30) trim(
tlm(ng)%base), i
591 IF (
ASSOCIATED(state(ng)%vector))
THEN
592 nullify (state(ng)%vector)
595 IF (
ASSOCIATED(ad_state(ng)%vector))
THEN
596 nullify (ad_state(ng)%vector)
598 state(ng)%vector =>
storage(ng)%Rvector(is:ie,i)
599 ad_state(ng)%vector =>
sworkr(is:ie)
604 & __line__, myfile))
RETURN
609 & state(ng)%vector, &
610 & ad_state(ng)%vector, enorm)
624 my_norm(1)=
norm(i,ng)
625 my_norm(2)=my_norm(1)
627 my_value(2)=my_value(1)
630 SELECT CASE (
tlm(ng)%IOtype)
636 & start = (/
tlm(ng)%Rindex/), &
638 & ncid =
tlm(ng)%ncid)
641 & __line__, myfile))
RETURN
647 & start = (/
tlm(ng)%Rindex/), &
649 & ncid =
tlm(ng)%ncid)
652 & __line__, myfile))
RETURN
654#if defined PIO_LIB && defined DISTRIBUTE
660 & start = (/
tlm(ng)%Rindex/), &
662 & piofile =
tlm(ng)%pioFile)
665 & __line__, myfile))
RETURN
671 & start = (/
tlm(ng)%Rindex/), &
673 & piofile =
tlm(ng)%pioFile)
676 & __line__, myfile))
RETURN
683 & __line__, myfile))
RETURN
688 SELECT CASE (
adm(ng)%IOtype)
694 & start = (/
adm(ng)%Rindex/), &
696 & ncid =
adm(ng)%ncid)
699 & __line__, myfile))
RETURN
705 & start = (/
adm(ng)%Rindex/), &
707 & ncid =
adm(ng)%ncid)
710 & __line__, myfile))
RETURN
712#if defined PIO_LIB && defined DISTRIBUTE
718 & start = (/
adm(ng)%Rindex/), &
720 & piofile =
adm(ng)%pioFile)
723 & __line__, myfile))
RETURN
729 & start = (/
adm(ng)%Rindex/), &
731 & piofile =
adm(ng)%pioFile)
733 & __line__, myfile))
RETURN
740 & __line__, myfile))
RETURN
752 10
FORMAT (/,1x,
'Error in ',a,1x,a,a,1x,i5,/)
753 20
FORMAT (/,a,1x,i2,/)
754 30
FORMAT (a,
'_',i3.3,
'.nc')
755 40
FORMAT (1x,i4.4,
'-th residual',1p,e14.6,0p, &
756 &
' Ritz value',1pe14.6,0p,2x,i4.4)
772 integer :: Fcount, ng, thread
774 character (len=*),
parameter :: MyFile = &
775 & __FILE__//
", ROMS_finalize"
787 10
FORMAT (/,
' Blowing-up: Saving latest model state into ', &
814 20
FORMAT (/,
'Elapsed wall CPU time for each process (seconds):',/)
818 DO thread=thread_range
849 integer,
intent(in) ::
info
851 character (len=*),
intent(out) :: string
858 string=
'Normal exit '
859 ELSE IF (
info.eq.1)
THEN
860 string=
'Maximum number of iterations taken '
861 ELSE IF (
info.eq.3)
THEN
862 string=
'No shifts could be applied during an IRAM cycle '
863 ELSE IF (
info.eq.-1)
THEN
864 string=
'Nstate must be positive '
865 ELSE IF (
info.eq.-2)
THEN
866 string=
'NEV must be positive '
867 ELSE IF (
info.eq.-3)
THEN
868 string=
'NCV must be greater NEV and less than or equal Nstate '
869 ELSE IF (
info.eq.-4)
THEN
870 string=
'Maximum number of iterations must be greater than zero '
871 ELSE IF (
info.eq.-5)
THEN
872 string=
'WHICH must be one of LM, SM, LA, SA or BE '
873 ELSE IF (
info.eq.-6)
THEN
874 string=
'BMAT must be one of I or G '
875 ELSE IF (
info.eq.-7)
THEN
876 string=
'Length of private work array SworkL is not sufficient '
877 ELSE IF (
info.eq.-8)
THEN
878 string=
'Error in DSTEQR in the eigenvalue calculation '
879 ELSE IF (
info.eq.-9)
THEN
880 string=
'Starting vector is zero '
881 ELSE IF (
info.eq.-10)
THEN
882 string=
'IPARAM(7) must be 1, 2, 3, 4, 5 '
883 ELSE IF (
info.eq.-11)
THEN
884 string=
'IPARAM(7) = 1 and BMAT = G are incompatable '
885 ELSE IF (
info.eq.-12)
THEN
886 string=
'IPARAM(1) must be equal to 0 or 1 '
887 ELSE IF (
info.eq.-13)
THEN
888 string=
'NEV and WHICH = BE are incompatable '
889 ELSE IF (
info.eq.-14)
THEN
890 string=
'Did not find any eigenvalues to sufficient accuaracy '
891 ELSE IF (
info.eq.-15)
THEN
892 string=
'HOWMANY must be one of A or S if RVEC = .TRUE. '
893 ELSE IF (
info.eq.-16)
THEN
894 string=
'HOWMANY = S not yet implemented '
895 ELSE IF (
info.eq.-17)
THEN
896 string=
'Different count of converge Ritz values in DSEUPD '
897 ELSE IF (
info.eq.-9999)
THEN
898 string=
'Could not build and Arnoldi factorization '
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 def_gst(ng, model)
subroutine, public get_gst(ng, model)
subroutine, public inp_par(model)
subroutine, public roms_initialize_arrays
subroutine, public roms_allocate_arrays(allocate_vars)
type(t_io), dimension(:), allocatable adm
type(t_io), dimension(:), allocatable tlm
type(t_io), dimension(:), allocatable rst
character(len=256) sourcefile
integer, parameter io_nf90
integer, parameter io_pio
subroutine, public initialize_parallel
integer, dimension(:), allocatable first_tile
integer, dimension(:), allocatable last_tile
integer, dimension(:), allocatable nstr
integer, dimension(:), allocatable ntilex
integer, dimension(:), allocatable nsize
integer, dimension(:), allocatable ntilee
integer, dimension(:), allocatable nend
integer, dimension(:), allocatable ntimes
integer, dimension(:), allocatable ntlm
integer, dimension(:), allocatable nconv
logical, dimension(:), allocatable lreadfrc
logical, dimension(:), allocatable ldefadj
logical, dimension(:), allocatable lcycleadj
logical, dimension(:), allocatable lwrtadj
logical, dimension(:), allocatable lcycletlm
logical, dimension(:), allocatable lwrtper
logical, dimension(:), allocatable lwrttlm
logical, dimension(:), allocatable lwrtrst
logical, dimension(:), allocatable ldeftlm
integer, dimension(:), allocatable nadj
logical, dimension(:), allocatable lreadfwd
logical, dimension(:), allocatable lcyclerst
logical, dimension(:), allocatable lreadblk
integer, dimension(8) iaup2
integer, dimension(:), allocatable ido
real(r8), dimension(:,:), allocatable sworkl
integer, dimension(:,:), allocatable ipntr
type(t_storage), dimension(:), allocatable storage
real(r8), dimension(:,:), allocatable norm
integer, dimension(:), allocatable info
subroutine, public allocate_storage
integer, dimension(:,:), allocatable iparam
logical, dimension(:,:), allocatable pick
real(r8), dimension(:), pointer sworkr
real(r8), dimension(:,:), allocatable rvaluer
subroutine, public propagator_fsv(runinterval, state, ad_state)
subroutine, public roms_finalize
subroutine, public roms_run(runinterval)
subroutine, private iram_error(info, icall, string)
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_gst(ng, model)
subroutine, public wrt_rst(ng, tile)
subroutine r_norm2(ng, model, mstr, mend, evalue, evector, state, norm2)
recursive subroutine wclock_off(ng, model, region, line, routine)
recursive subroutine wclock_on(ng, model, region, line, routine)
subroutine tl_initial(ng)