MODULE roms_kernel_mod ! !git $Id$ !svn $Id: picard_roms.h 1166 2023-05-17 20:11:58Z arango $ !================================================== Hernan G. Arango === ! Copyright (c) 2002-2023 The ROMS/TOMS Group Andrew M. Moore ! ! Licensed under a MIT/X style license ! ! See License_ROMS.md ! !======================================================================= ! ! ! ROMS/TOMS Picard Iterations Driver: ! ! ! ! This driver is used to perform the Picard iterations test for the ! ! representers tangent linear model used in IOMs weak constraint 4D ! ! variational data assimilation (R4D-Var). Recall that all tangent ! ! linear variables are in term of the full fields and the model can ! ! expressed symbolically as: ! ! ! ! d(S')/d(t) = N(So) + A(S' - So) ! ! ! ! where S' is the tangent linear state and So is the "basic state". ! ! The "basic state" here is the solution of previous tangent linear ! ! model iteration. ! ! ! ! This driver uses ESMF conventions for the initialization, time- ! ! stepping, and finalization of the representer tangent linear ! ! model via: ! ! ! ! ROMS_initialize ! ! ROMS_run ! ! ROMS_finalize ! ! ! !======================================================================= ! USE mod_param USE mod_parallel USE mod_arrays USE mod_iounits USE mod_ncparam USE mod_scalars ! USE close_io_mod, ONLY : close_file, close_inp, close_out USE inp_par_mod, ONLY : inp_par #ifdef MCT_LIB # ifdef ATM_COUPLING USE mct_coupler_mod, ONLY : initialize_ocn2atm_coupling # endif # ifdef WAV_COUPLING USE mct_coupler_mod, ONLY : initialize_ocn2wav_coupling # endif #endif USE strings_mod, ONLY : FoundError USE wrt_rst_mod, ONLY : wrt_rst ! implicit none ! PUBLIC :: ROMS_initialize PUBLIC :: ROMS_run PUBLIC :: ROMS_finalize ! CONTAINS ! SUBROUTINE ROMS_initialize (first, mpiCOMM) ! !======================================================================= ! ! ! This routine allocates and initializes ROMS/TOMS state variables ! ! and internal and external parameters. ! ! ! !======================================================================= ! ! Imported variable declarations. ! logical, intent(inout) :: first ! integer, intent(in), optional :: mpiCOMM ! ! Local variable declarations. ! logical :: allocate_vars = .TRUE. ! #ifdef DISTRIBUTE integer :: MyError, MySize #endif integer :: chunk_size, ng, thread #ifdef _OPENMP integer :: my_threadnum #endif ! character (len=*), parameter :: MyFile = & & __FILE__//", ROMS_initialize" #ifdef DISTRIBUTE ! !----------------------------------------------------------------------- ! Set distribute-memory (mpi) world communictor. !----------------------------------------------------------------------- ! IF (PRESENT(mpiCOMM)) THEN OCN_COMM_WORLD=mpiCOMM ELSE OCN_COMM_WORLD=MPI_COMM_WORLD END IF CALL mpi_comm_rank (OCN_COMM_WORLD, MyRank, MyError) CALL mpi_comm_size (OCN_COMM_WORLD, MySize, MyError) #endif ! !----------------------------------------------------------------------- ! On first pass, initialize model parameters a variables for all ! nested/composed grids. Notice that the logical switch "first" ! is used to allow multiple calls to this routine during ensemble ! configurations. !----------------------------------------------------------------------- ! IF (first) THEN first=.FALSE. ! ! Initialize parallel control switches. These scalars switches are ! independent from standard input parameters. ! CALL initialize_parallel ! ! Read in model tunable parameters from standard input. Allocate and ! initialize variables in several modules after the number of nested ! grids and dimension parameters are known. ! CALL inp_par (iNLM) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! ! Set domain decomposition tile partition range. This range is ! computed only once since the "first_tile" and "last_tile" values ! are private for each parallel thread/node. ! !$OMP PARALLEL #if defined _OPENMP MyThread=my_threadnum() #elif defined DISTRIBUTE MyThread=MyRank #else MyThread=0 #endif DO ng=1,Ngrids chunk_size=(NtileX(ng)*NtileE(ng)+numthreads-1)/numthreads first_tile(ng)=MyThread*chunk_size last_tile (ng)=first_tile(ng)+chunk_size-1 END DO !$OMP END PARALLEL ! ! Initialize internal wall clocks. Notice that the timings does not ! includes processing standard input because several parameters are ! needed to allocate clock variables. ! IF (Master) THEN WRITE (stdout,10) 10 FORMAT (/,' Process Information:',/) END IF ! DO ng=1,Ngrids !$OMP PARALLEL DO thread=THREAD_RANGE CALL wclock_on (ng, iNLM, 0, __LINE__, MyFile) END DO !$OMP END PARALLEL END DO ! ! Allocate and initialize modules variables. ! !$OMP PARALLEL CALL ROMS_allocate_arrays (allocate_vars) CALL ROMS_initialize_arrays !$OMP END PARALLEL IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF #if defined MCT_LIB && (defined ATM_COUPLING || defined WAV_COUPLING) ! !----------------------------------------------------------------------- ! Initialize coupling streams between model(s). !----------------------------------------------------------------------- ! DO ng=1,Ngrids # ifdef ATM_COUPLING CALL initialize_ocn2atm_coupling (ng, MyRank) # endif # ifdef WAV_COUPLING CALL initialize_ocn2wav_coupling (ng, MyRank) # endif END DO #endif ! RETURN END SUBROUTINE ROMS_initialize ! SUBROUTINE ROMS_run (RunInterval) ! !======================================================================= ! ! ! This routine time-steps ROMS/TOMS representer tangent linear model ! ! for the specified time interval (seconds), RunInterval. ! ! ! !======================================================================= ! ! Imported variable declarations ! real(dp), intent(in) :: RunInterval ! seconds ! ! Local variable declarations. ! integer :: ng ! character (len=*), parameter :: MyFile = & & __FILE__//", ROMS_run" ! !----------------------------------------------------------------------- ! Run Picard iteratons. !----------------------------------------------------------------------- ! ! Use ensemble parameters for Picard itereations. ! ITER_LOOP : DO Nrun=ERstr,ERend ! ! Cycle history and forward file names in such a way that the history ! from the previous iteration becomes the basic state for the next. ! DO ng=1,Ngrids WRITE (TLM(ng)%name,10) TRIM(TLM(ng)%head), Nrun WRITE (FWD(ng)%name,10) TRIM(TLM(ng)%head), Nrun-1 IF (Master) THEN WRITE (stdout,20) 'ROMS/TOMS Picard Iteration: ', Nrun, ng, & & TRIM(TLM(ng)%name), & & TRIM(FWD(ng)%name) END IF END DO ! ! Activate defining history an restart files on each iteration. The ! restart file is used to the store the solution of each iteration. ! DO ng=1,Ngrids iic(ng)=0 LdefTLM(ng)=.TRUE. LwrtTLM(ng)=.TRUE. LdefRST(ng)=.FALSE. END DO ! ! Initialize representer tangent linear model. ! DO ng=1,Ngrids !$OMP PARALLEL CALL rp_initial (ng) !$OMP END PARALLEL IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END DO ! ! Time-step representers tangent linear model ! DO ng=1,Ngrids IF (Master) THEN WRITE (stdout,30) 'RP', ng, ntstart(ng), ntend(ng) END IF END DO !$OMP PARALLEL #ifdef SOLVE3D CALL rp_main3d (RunInterval) #else CALL rp_main2d (RunInterval) #endif !$OMP END PARALLEL IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! ! Close IO and re-initialize NetCDF switches. ! DO ng=1,Ngrids CALL close_file (ng, iRPM, TLM(ng)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! CALL close_file (ng, iRPM, FWD(ng)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END DO END DO ITER_LOOP ! 10 FORMAT (a,'_',i3.3,'.nc') 20 FORMAT (/,a,i3,2x,'(Grid: ',i0,')',/, & & /,5x,' History file: ',a, & & /,5x,' Forward file: ',a,/) 30 FORMAT (/,1x,a,1x,'ROMS/TOMS: started time-stepping:', & & ' (Grid: ',i0,' TimeSteps: ',i0,' - ',i0,')',/) ! RETURN END SUBROUTINE ROMS_run ! SUBROUTINE ROMS_finalize ! !======================================================================= ! ! ! This routine terminates ROMS/TOMS nonlinear model execution. ! ! ! !======================================================================= ! ! Local variable declarations. ! integer :: Fcount, ng, thread ! character (len=*), parameter :: MyFile = & & __FILE__//", ROMS_finalize" ! !----------------------------------------------------------------------- ! If blowing-up, save latest model state into RESTART NetCDF file. !----------------------------------------------------------------------- ! ! If cycling restart records, write solution into the next record. ! IF (exit_flag.eq.1) THEN DO ng=1,Ngrids IF (LwrtRST(ng)) THEN IF (Master) WRITE (stdout,10) 10 FORMAT (/,' Blowing-up: Saving latest model state into ', & & ' RESTART file',/) Fcount=RST(ng)%load IF (LcycleRST(ng).and.(RST(ng)%Nrec(Fcount).ge.2)) THEN RST(ng)%Rindex=2 LcycleRST(ng)=.FALSE. END IF blowup=exit_flag exit_flag=NoError #ifdef DISTRIBUTE CALL wrt_rst (ng, MyRank) #else CALL wrt_rst (ng, -1) #endif END IF END DO END IF ! !----------------------------------------------------------------------- ! Stop model and time profiling clocks, report memory requirements, and ! close output NetCDF files. !----------------------------------------------------------------------- ! ! Stop time clocks. ! IF (Master) THEN WRITE (stdout,20) 20 FORMAT (/,'Elapsed wall CPU time for each process (seconds):',/) END IF ! DO ng=1,Ngrids !$OMP PARALLEL DO thread=THREAD_RANGE CALL wclock_off (ng, iNLM, 0, __LINE__, MyFile) END DO !$OMP END PARALLEL END DO ! ! Report dynamic memory and automatic memory requirements. ! !$OMP PARALLEL CALL memory !$OMP END PARALLEL ! ! Close IO files. ! DO ng=1,Ngrids CALL close_inp (ng, iNLM) END DO CALL close_out ! RETURN END SUBROUTINE ROMS_finalize END MODULE roms_kernel_mod