MODULE tl_wrt_ini_mod ! !git $Id$ !svn $Id: tl_wrt_ini.F 1190 2023-08-18 19:51:09Z arango $ !================================================== Hernan G. Arango === ! Copyright (c) 2002-2023 The ROMS/TOMS Group ! ! Licensed under a MIT/X style license ! ! See License_ROMS.md ! !======================================================================= ! ! ! This module writes initial conditions into tangent linear file ! ! using either the standard NetCDF library or the Parallel-IO ! ! (PIO) library. ! ! ! ! On Input: ! ! ! ! ng Nested grid number. ! ! Tindex State variables time index to write. ! ! OutRec NetCDF file unlimited dimension record to write. ! ! ! ! Notice that only momentum is affected by the full time-averaged ! ! masks. If applicable, these mask contains information about ! ! river runoff and time-dependent wetting and drying variations. ! ! ! !======================================================================= ! USE mod_param USE mod_parallel USE mod_fourdvar USE mod_grid USE mod_iounits USE mod_ncparam USE mod_ocean USE mod_scalars USE mod_stepping ! USE distribute_mod, ONLY : mp_bcasti USE nf_fwrite2d_mod, ONLY : nf_fwrite2d USE nf_fwrite3d_mod, ONLY : nf_fwrite3d USE strings_mod, ONLY : FoundError ! implicit none ! PUBLIC :: tl_wrt_ini PRIVATE :: tl_wrt_ini_nf90 ! CONTAINS ! !*********************************************************************** SUBROUTINE tl_wrt_ini (ng, tile, Tindex, OutRec) !*********************************************************************** ! ! Imported variable declarations. ! integer, intent(in) :: ng, tile, Tindex, OutRec ! ! Local variable declarations. ! integer :: LBi, UBi, LBj, UBj ! character (len=*), parameter :: MyFile = & & "ROMS/Tangent/tl_wrt_ini.F" ! !----------------------------------------------------------------------- ! Write out history fields according to IO type. !----------------------------------------------------------------------- ! LBi=BOUNDS(ng)%LBi(tile) UBi=BOUNDS(ng)%UBi(tile) LBj=BOUNDS(ng)%LBj(tile) UBj=BOUNDS(ng)%UBj(tile) ! SELECT CASE (ITL(ng)%IOtype) CASE (io_nf90) CALL tl_wrt_ini_nf90 (ng, tile, Tindex, OutRec, & & LBi, UBi, LBj, UBj) CASE DEFAULT IF (Master) WRITE (stdout,10) ITL(ng)%IOtype exit_flag=3 END SELECT IF (FoundError(exit_flag, NoError, 124, MyFile)) RETURN ! 10 FORMAT (' TL_WRT_INI - Illegal output file type, io_type = ',i0, & & /,14x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.') ! RETURN END SUBROUTINE tl_wrt_ini ! !*********************************************************************** SUBROUTINE tl_wrt_ini_nf90 (ng, tile, Tindex, OutRec, & & LBi, UBi, LBj, UBj) !*********************************************************************** ! USE mod_netcdf ! ! Imported variable declarations. ! integer, intent(in) :: ng, tile, Tindex, OutRec integer, intent(in) :: LBi, UBi, LBj, UBj ! ! Local variable declarations. ! integer :: gfactor, gtype, i, itrc, status, varid ! real(dp) :: my_time, scale ! character (len=35) :: string character (len=*), parameter :: MyFile = & & "ROMS/Tangent/tl_wrt_ini.F"//", tl_wrt_ini_nf90" ! SourceFile=MyFile ! !----------------------------------------------------------------------- ! Write out tangent linear initial conditions. !----------------------------------------------------------------------- ! IF (FoundError(exit_flag, NoError, 172, MyFile)) RETURN ! ! Report. ! IF (Master) THEN IF (OutRec.eq.1) THEN string='inner-loop initial fields ' ELSE IF (OutRec.eq.2) THEN string='final outer-loop increments ' ELSE IF (OutRec.eq.3) THEN string='sum of final outer-loop increments ' ELSE IF (OutRec.eq.4) THEN string='sum of adjoint solutions ' ELSE IF (OutRec.eq.5) THEN string='augmented correction term ' END IF WRITE (stdout,10) string, outer, inner, Tindex, Tindex, OutRec END IF ! ! Set grid type factor to write full (gfactor=1) fields or water ! points (gfactor=-1) fields only. ! gfactor=1 ! ! Write out model time (s). Use the "tdays" variable here because of ! the management of the "time" variable due to nesting. ! my_time=tdays(ng)*day2sec CALL netcdf_put_fvar (ng, iTLM, ITL(ng)%name, & & TRIM(Vname(1,idtime)), my_time, & & (/OutRec/), (/1/), & & ncid = ITL(ng)%ncid, & & varid = ITL(ng)%Vid(idtime)) IF (FoundError(exit_flag, NoError, 236, MyFile)) RETURN ! ! Write out free-surface (m) ! scale=1.0_dp gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iTLM, ITL(ng)%ncid, idFsur, & & ITL(ng)%Vid(idFsur), & & OutRec, gtype, & & LBi, UBi, LBj, UBj, scale, & & GRID(ng) % rmask, & & OCEAN(ng) % tl_zeta(:,:,Tindex)) IF (FoundError(status, nf90_noerr, 255, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idFsur)), OutRec END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out 2D U-momentum component (m/s). ! scale=1.0_dp gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iTLM, ITL(ng)%ncid, idUbar, & & ITL(ng)%Vid(idUbar), & & OutRec, gtype, & & LBi, UBi, LBj, UBj, scale, & & GRID(ng) % umask_full, & & OCEAN(ng) % tl_ubar(:,:,Tindex)) IF (FoundError(status, nf90_noerr, 300, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idUbar)), OutRec END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out 2D momentum component (m/s) in the ETA-direction. ! scale=1.0_dp gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iTLM, ITL(ng)%ncid, idVbar, & & ITL(ng)%Vid(idVbar), & & OutRec, gtype, & & LBi, UBi, LBj, UBj, scale, & & GRID(ng) % vmask_full, & & OCEAN(ng) % tl_vbar(:,:,Tindex)) IF (FoundError(status, nf90_noerr, 345, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVbar)), OutRec END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out 3D U-momentum component (m/s). ! scale=1.0_dp gtype=gfactor*u3dvar status=nf_fwrite3d(ng, iTLM, ITL(ng)%ncid, idUvel, & & ITL(ng)%Vid(idUvel), & & OutRec, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & & GRID(ng) % umask_full, & & OCEAN(ng) % tl_u(:,:,:,Tindex)) IF (FoundError(status, nf90_noerr, 437, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idUvel)), OutRec END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out 3D V-momentum component (m/s). ! scale=1.0_dp gtype=gfactor*v3dvar status=nf_fwrite3d(ng, iTLM, ITL(ng)%ncid, idVvel, & & ITL(ng)%Vid(idVvel), & & OutRec, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & & GRID(ng) % vmask_full, & & OCEAN(ng) % tl_v(:,:,:,Tindex)) IF (FoundError(status, nf90_noerr, 482, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVvel)), OutRec END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out tracer type variables. ! DO itrc=1,NT(ng) scale=1.0_dp gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iTLM, ITL(ng)%ncid, idTvar(itrc), & & ITL(ng)%Tid(itrc), & & OutRec, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & & GRID(ng) % rmask, & & OCEAN(ng) % tl_t(:,:,:,Tindex,itrc)) IF (FoundError(status, nf90_noerr, 528, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idTvar(itrc))), OutRec END IF exit_flag=3 ioerror=status RETURN END IF END DO ! !----------------------------------------------------------------------- ! Synchronize tangent linear initial NetCDF file to disk to allow other ! processes to access data immediately after it is written. !----------------------------------------------------------------------- ! CALL netcdf_sync (ng, iTLM, ITL(ng)%name, ITL(ng)%ncid) IF (FoundError(exit_flag, NoError, 656, MyFile)) RETURN ! 10 FORMAT (2x,'TL_WRT_INI_NF90 - writing ',a, & & ' (Outer=',i2.2,', Inner=',i3.3,', Index=',i0, & & ',',i0,', Rec=',i0,')') 20 FORMAT (/,' TL_WRT_INI_NF90 - error while writing variable: ',a, & & /,14x,'into tangent initial file for time record: ',i0) ! RETURN END SUBROUTINE tl_wrt_ini_nf90 END MODULE tl_wrt_ini_mod