diff --git a/ROMS/Adjoint/ad_def_his.F b/ROMS/Adjoint/ad_def_his.F index 20c71ca2..e14fbcaa 100644 --- a/ROMS/Adjoint/ad_def_his.F +++ b/ROMS/Adjoint/ad_def_his.F @@ -67,11 +67,11 @@ SUBROUTINE ad_def_his (ng, ldef) ! SELECT CASE (ADM(ng)%IOtype) CASE (io_nf90) - CALL ad_def_his_nf90 (ng, ldef) + CALL ad_def_his_nf90 (ng, iADM, ldef) # if defined PIO_LIB && defined DISTRIBUTE CASE (io_pio) - CALL ad_def_his_pio (ng, ldef) + CALL ad_def_his_pio (ng, iADM, ldef) # endif CASE DEFAULT IF (Master) WRITE (stdout,10) ng, ADM(ng)%IOtype @@ -86,14 +86,14 @@ SUBROUTINE ad_def_his (ng, ldef) END SUBROUTINE ad_def_his ! !*********************************************************************** - SUBROUTINE ad_def_his_nf90 (ng, ldef) + SUBROUTINE ad_def_his_nf90 (ng, model, ldef) !*********************************************************************** ! USE mod_netcdf ! ! Imported variable declarations. ! - integer, intent(in) :: ng + integer, intent(in) :: ng, model logical, intent(in) :: ldef ! @@ -164,7 +164,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) !======================================================================= ! DEFINE : IF (ldef) THEN - CALL netcdf_create (ng, iADM, TRIM(ncname), ADM(ng)%ncid) + CALL netcdf_create (ng, model, TRIM(ncname), ADM(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) THEN IF (Master) WRITE (stdout,30) TRIM(ncname) RETURN @@ -176,104 +176,104 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) ! DimIDs=0 ! - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'xi_rho', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'xi_rho', & & IOBOUNDS(ng)%xi_rho, DimIDs( 1)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'xi_u', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'xi_u', & & IOBOUNDS(ng)%xi_u, DimIDs( 2)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'xi_v', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'xi_v', & & IOBOUNDS(ng)%xi_v, DimIDs( 3)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'xi_psi', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'xi_psi', & & IOBOUNDS(ng)%xi_psi, DimIDs( 4)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'eta_rho', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'eta_rho', & & IOBOUNDS(ng)%eta_rho, DimIDs( 5)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'eta_u', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'eta_u', & & IOBOUNDS(ng)%eta_u, DimIDs( 6)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'eta_v', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'eta_v', & & IOBOUNDS(ng)%eta_v, DimIDs( 7)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'eta_psi', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'eta_psi', & & IOBOUNDS(ng)%eta_psi, DimIDs( 8)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # ifdef ADJUST_BOUNDARY - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'IorJ', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'IorJ', & & IOBOUNDS(ng)%IorJ, IorJdim) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # if defined WRITE_WATER && defined MASKING - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'xy_rho', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'xy_rho', & & IOBOUNDS(ng)%xy_rho, DimIDs(17)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'xy_u', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'xy_u', & & IOBOUNDS(ng)%xy_u, DimIDs(18)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'xy_v', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'xy_v', & & IOBOUNDS(ng)%xy_v, DimIDs(19)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # ifdef SOLVE3D # if defined WRITE_WATER && defined MASKING - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'xyz_rho', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'xyz_rho', & & IOBOUNDS(ng)%xy_rho*N(ng), DimIDs(20)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'xyz_u', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'xyz_u', & & IOBOUNDS(ng)%xy_u*N(ng), DimIDs(21)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'xyz_v', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'xyz_v', & & IOBOUNDS(ng)%xy_v*N(ng), DimIDs(22)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'xyz_w', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'xyz_w', & & IOBOUNDS(ng)%xy_rho*(N(ng)+1), DimIDs(23)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'N', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'N', & & N(ng), DimIDs( 9)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 's_rho', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 's_rho', & & N(ng), DimIDs( 9)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 's_w', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 's_w', & & N(ng)+1, DimIDs(10)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'tracer', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'tracer', & & NT(ng), DimIDs(11)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # ifdef SEDIMENT - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'NST', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'NST', & & NST, DimIDs(32)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'Nbed', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'Nbed', & & Nbed, DimIDs(16)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # if defined WRITE_WATER && defined MASKING - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'xybed', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'xybed', & & IOBOUNDS(ng)%xy_rho*Nbed, DimIDs(24)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -284,61 +284,61 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) & NBands, DimIDs(33)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'Nphy', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'Nphy', & & Nphy, DimIDs(25)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'Nbac', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'Nbac', & & Nbac, DimIDs(26)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'Ndom', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'Ndom', & & Ndom, DimIDs(27)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'Nfec', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'Nfec', & & Nfec, DimIDs(28)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # endif - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'boundary', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'boundary', & & 4, DimIDs(14)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # ifdef FOUR_DVAR - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'Nstate', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'Nstate', & & NstateVar(ng), DimIDs(29)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # if defined ADJUST_STFLUX || defined ADJUST_WSTRESS - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'frc_adjust', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'frc_adjust', & & Nfrec(ng), DimIDs(30)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # ifdef ADJUST_BOUNDARY - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'obc_adjust', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'obc_adjust', & & Nbrec(ng), DimIDs(31)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # if defined I4DVAR - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'Ninner', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'Ninner', & & Ninner, NinnerDim) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'Minner', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'Minner', & & Ninner+1, MinnerDim) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, 'Nouter', & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, 'Nouter', & & Nouter, NouterDim) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif - status=def_dim(ng, iADM, ADM(ng)%ncid, ncname, & + status=def_dim(ng, model, ADM(ng)%ncid, ncname, & & TRIM(ADJUSTL(Vname(5,idtime))), & & nf90_unlimited, DimIDs(12)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -488,7 +488,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) ! Define time-recordless information variables. !----------------------------------------------------------------------- ! - CALL def_info (ng, iADM, ADM(ng)%ncid, ncname, DimIDs) + CALL def_info (ng, model, ADM(ng)%ncid, ncname, DimIDs) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! !----------------------------------------------------------------------- @@ -503,7 +503,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo( 4)=TRIM(Rclock%calendar) Vinfo(14)=Vname(4,idtime) Vinfo(21)=Vname(6,idtime) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idtime), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idtime), & & NF_TOUT, 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -514,7 +514,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) ! Vinfo( 1)='Ritz_rvalue' Vinfo( 2)='real Ritz eigenvalues' - status=def_var(ng, iADM, ADM(ng)%ncid, varid, NF_TYPE, & + status=def_var(ng, model, ADM(ng)%ncid, varid, NF_TYPE, & & 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -522,7 +522,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) # if defined AFT_EIGENMODES Vinfo( 1)='Ritz_ivalue' Vinfo( 2)='imaginary Ritz eigenvalues' - status=def_var(ng, iADM, ADM(ng)%ncid, varid, NF_TYPE, & + status=def_var(ng, model, ADM(ng)%ncid, varid, NF_TYPE, & & 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -530,7 +530,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo( 1)='Ritz_norm' Vinfo( 2)='Ritz eigenvectors Euclidean norm' - status=def_var(ng, iADM, ADM(ng)%ncid, varid, NF_TYPE, & + status=def_var(ng, model, ADM(ng)%ncid, varid, NF_TYPE, & & 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -545,7 +545,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo( 2)='conjugate gradient beta coefficient' vardim(1)=MinnerDim vardim(2)=NouterDim - status=def_var(ng, iADM, ADM(ng)%ncid, varid, NF_FRST, & + status=def_var(ng, model, ADM(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -554,7 +554,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo( 2)='Lanczos algorithm delta coefficient' vardim(1)=NinnerDim vardim(2)=NouterDim - status=def_var(ng, iADM, ADM(ng)%ncid, varid, NF_FRST, & + status=def_var(ng, model, ADM(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -563,7 +563,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo( 2)='Lanczos recurrence eigenvectors' vardim(1)=NinnerDim vardim(2)=NinnerDim - status=def_var(ng, iADM, ADM(ng)%ncid, varid, NF_FRST, & + status=def_var(ng, model, ADM(ng)%ncid, varid, NF_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -583,7 +583,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) # endif Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idUsms,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idUsms), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idUsms), & & NF_FOUT, nvd4, u3dfrc, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! @@ -598,7 +598,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) # endif Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idVsms,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idVsms), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idVsms), & & NF_FOUT, nvd4, v3dfrc, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -627,7 +627,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) # endif Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idTsur(itrc),ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, & + status=def_var(ng, model, ADM(ng)%ncid, & & ADM(ng)%Vid(idTsur(itrc)), NF_FOUT, & & nvd4, t3dfrc, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -646,7 +646,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idbath) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idbath,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idbath), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idbath), & & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -668,7 +668,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idpthR) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idpthR,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idpthR), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idpthR), & & NF_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -688,7 +688,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idpthW) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idpthW,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idpthW), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idpthW), & & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -709,7 +709,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idFsur) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idFsur,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idFsur), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idFsur), & # ifdef WET_DRY & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -732,7 +732,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(16)=Vname(1,idtime) Vinfo(21)=Vname(6,ifield) Aval(5)=REAL(Iinfo(1,ifield,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(ifield), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(ifield), & & NF_FOUT, 4, t2dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -753,7 +753,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idUbar) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idUbar,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idUbar), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idUbar), & & NF_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -771,7 +771,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(16)=Vname(1,idtime) Vinfo(21)=Vname(6,ifield) Aval(5)=REAL(Iinfo(1,ifield,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(ifield), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(ifield), & & NF_FOUT, 4, t2dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -792,7 +792,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idVbar) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idVbar,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idVbar), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idVbar), & & NF_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -810,7 +810,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(16)=Vname(1,idtime) Vinfo(21)=Vname(6,ifield) Aval(5)=REAL(Iinfo(1,ifield,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(ifield), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(ifield), & & NF_FOUT, 4, t2dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError,__LINE__, MyFile)) RETURN @@ -832,7 +832,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idUvel) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idUvel,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idUvel), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idUvel), & & NF_FOUT, nvd4, u3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -850,7 +850,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(16)=Vname(1,idtime) Vinfo(21)=Vname(6,ifield) Aval(5)=REAL(Iinfo(1,ifield,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(ifield), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(ifield), & & NF_FOUT, 5, t3dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -871,7 +871,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idVvel) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idVvel,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idVvel), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idVvel), & & NF_FOUT, nvd4, v3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -889,13 +889,51 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(16)=Vname(1,idtime) Vinfo(21)=Vname(6,ifield) Aval(5)=REAL(Iinfo(1,ifield,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(ifield), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(ifield), & & NF_FOUT, 5, t3dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF # endif ! +! Define 3D Eastward momentum at RHO-points, A-grid. +! + IF (Hout(idu3dE,ng)) THEN + Vinfo( 1)=Vname(1,idu3dE) + Vinfo( 2)=Vname(2,idu3dE) + Vinfo( 3)=Vname(3,idu3dE) + Vinfo(14)=Vname(4,idu3dE) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idu3dE) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idu3dE,ng),r8) + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idu3dE), & + & NF_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Northward momentum at RHO-points, A-grid. +! + IF (Hout(idv3dN,ng)) THEN + Vinfo( 1)=Vname(1,idv3dN) + Vinfo( 2)=Vname(2,idv3dN) + Vinfo( 3)=Vname(3,idv3dN) + Vinfo(14)=Vname(4,idv3dN) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idv3dN) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idv3dN,ng),r8) + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idv3dN), & + & NF_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! ! Define S-coordinate omega vertical velocity. ! IF (Hout(idOvel,ng)) THEN @@ -907,7 +945,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idOvel) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idOvel,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idOvel), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idOvel), & & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -934,7 +972,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idTvar(itrc)) Vinfo(22)='coordinates' Aval(5)=REAL(r3dvar,r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Tid(itrc), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Tid(itrc), & & NF_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -961,7 +999,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) # endif Vinfo(21)=Vname(6,ifield) Aval(5)=REAL(Iinfo(1,ifield,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(ifield), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(ifield),& & NF_FOUT, 5, t3dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -983,7 +1021,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idDano) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idDano,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idDano), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idDano), & & NF_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -999,7 +1037,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idVvis) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idVvis,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idVvis), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idVvis), & & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1016,7 +1054,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idTdif) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idTdif,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idTdif), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idTdif), & & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1035,7 +1073,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idSdif) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idSdif,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idSdif), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idSdif), & & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1065,7 +1103,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idTsur(itrc)) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idTsur(itrc),ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, & + status=def_var(ng, model, ADM(ng)%ncid, & & ADM(ng)%Vid(idTsur(itrc)), NF_FOUT, & & nvd3, t2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1089,7 +1127,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idUsms) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idUsms,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idUsms), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idUsms), & & NF_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -1108,7 +1146,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idVsms) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idVsms,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idVsms), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idVsms), & & NF_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -1128,7 +1166,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idUbms) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idUbms,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idUbms), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idUbms), & & NF_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -1147,7 +1185,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idVbms) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idVbms,ng),r8) - status=def_var(ng, iADM, ADM(ng)%ncid, ADM(ng)%Vid(idVbms), & + status=def_var(ng, model, ADM(ng)%ncid, ADM(ng)%Vid(idVbms), & & NF_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -1156,14 +1194,14 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) ! Leave definition mode. !----------------------------------------------------------------------- ! - CALL netcdf_enddef (ng, iADM, ncname, ADM(ng)%ncid) + CALL netcdf_enddef (ng, model, ncname, ADM(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! !----------------------------------------------------------------------- ! Write out time-recordless, information variables. !----------------------------------------------------------------------- ! - CALL wrt_info (ng, iADM, ADM(ng)%ncid, ncname) + CALL wrt_info (ng, model, ADM(ng)%ncid, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF DEFINE ! @@ -1177,7 +1215,7 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) ! ! Open adjoint file for read/write. ! - CALL netcdf_open (ng, iADM, ncname, 1, ADM(ng)%ncid) + CALL netcdf_open (ng, model, ncname, 1, ADM(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) THEN WRITE (stdout,60) TRIM(ncname) RETURN @@ -1185,13 +1223,13 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) ! ! Inquire about the dimensions and check for consistency. ! - CALL netcdf_check_dim (ng, iADM, ncname, & + CALL netcdf_check_dim (ng, model, ncname, & & ncid = ADM(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! ! Inquire about the variables. ! - CALL netcdf_inq_var (ng, iADM, ncname, & + CALL netcdf_inq_var (ng, model, ncname, & & ncid = ADM(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! @@ -1264,6 +1302,12 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) got_var(idSbry(isVvel))=.TRUE. ADM(ng)%Vid(idSbry(isVvel))=var_id(i) # endif + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idu3dE))) THEN + got_var(idu3dE)=.TRUE. + ADM(ng)%Vid(idu3dE)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idv3dN))) THEN + got_var(idv3dN)=.TRUE. + ADM(ng)%Vid(idv3dN)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idOvel))) THEN got_var(idOvel)=.TRUE. ADM(ng)%Vid(idOvel)=var_id(i) @@ -1411,6 +1455,18 @@ SUBROUTINE ad_def_his_nf90 (ng, ldef) RETURN END IF # endif + IF (.not.got_var(idu3dE).and.Hout(idu3dE,ng)) THEN + IF (Master) WRITE (stdout,70) TRIM(Vname(1,idu3dE)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idv3dN).and.Hout(idv3dN,ng)) THEN + IF (Master) WRITE (stdout,70) TRIM(Vname(1,idv3dN)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF IF (.not.got_var(idOvel).and.Hout(idOvel,ng)) THEN IF (Master) WRITE (stdout,70) TRIM(Vname(1,idOvel)), & & TRIM(ncname) @@ -1486,7 +1542,7 @@ END SUBROUTINE ad_def_his_nf90 # if defined PIO_LIB && defined DISTRIBUTE ! !*********************************************************************** - SUBROUTINE ad_def_his_pio (ng, ldef) + SUBROUTINE ad_def_his_pio (ng, model, ldef) !*********************************************************************** ! USE mod_pio_netcdf @@ -1566,7 +1622,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) !======================================================================= ! DEFINE : IF (ldef) THEN - CALL pio_netcdf_create (ng, iADM, TRIM(ncname), ADM(ng)%pioFile) + CALL pio_netcdf_create (ng, model, TRIM(ncname), ADM(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) THEN IF (Master) WRITE (stdout,30) TRIM(ncname) RETURN @@ -1578,104 +1634,104 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ! DimIDs=0 ! - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'xi_rho', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'xi_rho', & & IOBOUNDS(ng)%xi_rho, DimIDs( 1)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'xi_u', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'xi_u', & & IOBOUNDS(ng)%xi_u, DimIDs( 2)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'xi_v', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'xi_v', & & IOBOUNDS(ng)%xi_v, DimIDs( 3)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'xi_psi', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'xi_psi', & & IOBOUNDS(ng)%xi_psi, DimIDs( 4)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'eta_rho', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'eta_rho', & & IOBOUNDS(ng)%eta_rho, DimIDs( 5)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'eta_u', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'eta_u', & & IOBOUNDS(ng)%eta_u, DimIDs( 6)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'eta_v', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'eta_v', & & IOBOUNDS(ng)%eta_v, DimIDs( 7)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'eta_psi', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'eta_psi', & & IOBOUNDS(ng)%eta_psi, DimIDs( 8)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # ifdef ADJUST_BOUNDARY - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'IorJ', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'IorJ', & & IOBOUNDS(ng)%IorJ, IorJdim) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # if defined WRITE_WATER && defined MASKING - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'xy_rho', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'xy_rho', & & IOBOUNDS(ng)%xy_rho, DimIDs(17)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'xy_u', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'xy_u', & & IOBOUNDS(ng)%xy_u, DimIDs(18)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'xy_v', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'xy_v', & & IOBOUNDS(ng)%xy_v, DimIDs(19)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # ifdef SOLVE3D # if defined WRITE_WATER && defined MASKING - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'xyz_rho', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'xyz_rho', & & IOBOUNDS(ng)%xy_rho*N(ng), DimIDs(20)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'xyz_u', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'xyz_u', & & IOBOUNDS(ng)%xy_u*N(ng), DimIDs(21)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'xyz_v', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'xyz_v', & & IOBOUNDS(ng)%xy_v*N(ng), DimIDs(22)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'xyz_w', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'xyz_w', & & IOBOUNDS(ng)%xy_rho*(N(ng)+1), DimIDs(23)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'N', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'N', & & N(ng), DimIDs( 9)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 's_rho', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 's_rho', & & N(ng), DimIDs( 9)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 's_w', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 's_w', & & N(ng)+1, DimIDs(10)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'tracer', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'tracer', & & NT(ng), DimIDs(11)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # ifdef SEDIMENT - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'NST', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'NST', & & NST, DimIDs(32)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'Nbed', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'Nbed', & & Nbed, DimIDs(16)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # if defined WRITE_WATER && defined MASKING - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'xybed', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'xybed', & & IOBOUNDS(ng)%xy_rho*Nbed, DimIDs(24)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -1686,61 +1742,61 @@ SUBROUTINE ad_def_his_pio (ng, ldef) & NBands, DimIDs(33)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'Nphy', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'Nphy', & & Nphy, DimIDs(25)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'Nbac', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'Nbac', & & Nbac, DimIDs(26)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'Ndom', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'Ndom', & & Ndom, DimIDs(27)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'Nfec', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'Nfec', & & Nfec, DimIDs(28)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # endif - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'boundary', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'boundary', & & 4, DimIDs(14)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # ifdef FOUR_DVAR - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'Nstate', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'Nstate', & & NstateVar(ng), DimIDs(29)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # if defined ADJUST_STFLUX || defined ADJUST_WSTRESS - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'frc_adjust', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'frc_adjust',& & Nfrec(ng), DimIDs(30)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # ifdef ADJUST_BOUNDARY - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'obc_adjust', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'obc_adjust',& & Nbrec(ng), DimIDs(31)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # if defined I4DVAR - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'Ninner', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'Ninner', & & Ninner, NinnerDim) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'Minner', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'Minner', & & Ninner+1, MinnerDim) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, 'Nouter', & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, 'Nouter', & & Nouter, NouterDim) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif - status=def_dim(ng, iADM, ADM(ng)%pioFile, ncname, & + status=def_dim(ng, model, ADM(ng)%pioFile, ncname, & & TRIM(ADJUSTL(Vname(5,idtime))), & & PIO_unlimited, DimIDs(12)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1890,7 +1946,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ! Define time-recordless information variables. !----------------------------------------------------------------------- ! - CALL def_info (ng, iADM, ADM(ng)%pioFile, ncname, DimIDs) + CALL def_info (ng, model, ADM(ng)%pioFile, ncname, DimIDs) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! !----------------------------------------------------------------------- @@ -1908,7 +1964,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idtime)%dkind=PIO_TOUT ADM(ng)%pioVar(idtime)%gtype=0 ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idtime)%vd, & & PIO_TOUT, 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) @@ -1920,7 +1976,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ! Vinfo( 1)='Ritz_rvalue' Vinfo( 2)='real Ritz eigenvalues' - status=def_var(ng, iADM, ADM(ng)%pioFile, varDesc, PIO_TYPE, & + status=def_var(ng, model, ADM(ng)%pioFile, varDesc, PIO_TYPE, & & 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1928,7 +1984,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) # if defined AFT_EIGENMODES Vinfo( 1)='Ritz_ivalue' Vinfo( 2)='imaginary Ritz eigenvalues' - status=def_var(ng, iADM, ADM(ng)%pioFile, varDesc, PIO_TYPE, & + status=def_var(ng, model, ADM(ng)%pioFile, varDesc, PIO_TYPE, & & 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1937,7 +1993,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) Vinfo( 1)='Ritz_norm' Vinfo( 2)='Ritz eigenvectors Euclidean norm' - status=def_var(ng, iADM, ADM(ng)%pioFile, varDesc, PIO_TYPE, & + status=def_var(ng, model, ADM(ng)%pioFile, varDesc, PIO_TYPE, & & 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1952,7 +2008,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) Vinfo( 2)='conjugate gradient beta coefficient' vardim(1)=MinnerDim vardim(2)=NouterDim - status=def_var(ng, iADM, ADM(ng)%pioFile, varDesc, PIO_FRST, & + status=def_var(ng, model, ADM(ng)%pioFile, varDesc, PIO_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1961,7 +2017,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) Vinfo( 2)='Lanczos algorithm delta coefficient' vardim(1)=NinnerDim vardim(2)=NouterDim - status=def_var(ng, iADM, ADM(ng)%pioFile, varDesc, PIO_FRST, & + status=def_var(ng, model, ADM(ng)%pioFile, varDesc, PIO_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1970,7 +2026,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) Vinfo( 2)='Lanczos recurrence eigenvectors' vardim(1)=NinnerDim vardim(2)=NinnerDim - status=def_var(ng, iADM, ADM(ng)%pioFile, varDesc, PIO_FRST, & + status=def_var(ng, model, ADM(ng)%pioFile, varDesc, PIO_FRST, & & 2, vardim, Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1993,7 +2049,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idUsms)%dkind=PIO_FOUT ADM(ng)%pioVar(idUsms)%gtype=u2dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idUsms)%vd, & & PIO_FOUT, nvd4, u3dfrc, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2012,7 +2068,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idVsms)%dkind=PIO_FOUT ADM(ng)%pioVar(idVsms)%gtype=v2dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idVsms)%vd, & & PIO_FOUT, nvd4, v3dfrc, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2045,7 +2101,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idTsur(itrc))%dkind=PIO_FOUT ADM(ng)%pioVar(idTsur(itrc))%gtype=r2dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idTsur(itrc))%vd, & & PIO_FOUT, nvd4, t3dfrc, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2067,7 +2123,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idbath)%dkind=PIO_FOUT ADM(ng)%pioVar(idbath)%gtype=r2dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idbath)%vd, & & PIO_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2093,7 +2149,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idpthR)%dkind=PIO_FOUT ADM(ng)%pioVar(idpthR)%gtype=r3dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idpthR)%vd, & & PIO_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2117,7 +2173,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idpthW)%dkind=PIO_FOUT ADM(ng)%pioVar(idpthW)%gtype=w3dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idpthW)%vd, & & PIO_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2142,7 +2198,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idFsur)%dkind=PIO_FOUT ADM(ng)%pioVar(idFsur)%gtype=r2dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idFsur)%vd, & # ifdef WET_DRY & PIO_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & @@ -2169,7 +2225,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(ifield)%dkind=PIO_FOUT ADM(ng)%pioVar(ifield)%gtype=r2dobc ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(ifield)%vd, & & PIO_FOUT, 4, t2dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2194,7 +2250,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idUbar)%dkind=PIO_FOUT ADM(ng)%pioVar(idUbar)%gtype=u2dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idUbar)%vd, & & PIO_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2216,7 +2272,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(ifield)%dkind=PIO_FOUT ADM(ng)%pioVar(ifield)%gtype=u2dobc ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(ifield)%vd, & & PIO_FOUT, 4, t2dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2241,7 +2297,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idVbar)%dkind=PIO_FOUT ADM(ng)%pioVar(idVbar)%gtype=v2dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idVbar)%vd, & & PIO_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2263,7 +2319,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(ifield)%dkind=PIO_FOUT ADM(ng)%pioVar(ifield)%gtype=v2dobc ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(ifield)%vd, & & PIO_FOUT, 4, t2dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2289,7 +2345,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idUvel)%dkind=PIO_FOUT ADM(ng)%pioVar(idUvel)%gtype=u3dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idUvel)%vd, & & PIO_FOUT, nvd4, u3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2311,7 +2367,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(ifield)%dkind=PIO_FOUT ADM(ng)%pioVar(ifield)%gtype=u3dobc ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(ifield)%vd, & & PIO_FOUT, 5, t3dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2336,7 +2392,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idVvel)%dkind=PIO_FOUT ADM(ng)%pioVar(idVvel)%gtype=v3dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idVvel)%vd, & & PIO_FOUT, nvd4, v3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2358,7 +2414,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(ifield)%dkind=PIO_FOUT ADM(ng)%pioVar(ifield)%gtype=v3dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(ifield)%vd, & & PIO_FOUT, 5, t3dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2366,6 +2422,52 @@ SUBROUTINE ad_def_his_pio (ng, ldef) END IF # endif ! +! Define 3D Eastward momentum at RHO-points, A-grid. +! + IF (Hout(idu3dE,ng)) THEN + Vinfo( 1)=Vname(1,idu3dE) + Vinfo( 2)=Vname(2,idu3dE) + Vinfo( 3)=Vname(3,idu3dE) + Vinfo(14)=Vname(4,idu3dE) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idu3dE) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idu3dE,ng),r8) + ADM(ng)%pioVar(idu3dE)%dkind=PIO_FOUT + ADM(ng)%pioVar(idu3dE)%gtype=r3dvar +! + status=def_var(ng, model, ADM(ng)%pioFile, & + & ADM(ng)%pioVar(idu3dE)%vd, & + & PIO_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Northward momentum at RHO-points, A-grid. +! + IF (Hout(idv3dN,ng)) THEN + Vinfo( 1)=Vname(1,idv3dN) + Vinfo( 2)=Vname(2,idv3dN) + Vinfo( 3)=Vname(3,idv3dN) + Vinfo(14)=Vname(4,idv3dN) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idv3dN) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idv3dN,ng),r8) + ADM(ng)%pioVar(idv3dN)%dkind=PIO_FOUT + ADM(ng)%pioVar(idv3dN)%gtype=r3dvar +! + status=def_var(ng, model, ADM(ng)%pioFile, & + & ADM(ng)%pioVar(idv3dN)%vd, & + & PIO_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! ! Define S-coordinate omega vertical velocity. ! IF (Hout(idOvel,ng)) THEN @@ -2380,7 +2482,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idOvel)%dkind=PIO_FOUT ADM(ng)%pioVar(idOvel)%gtype=w3dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idOvel)%vd, & & PIO_FOUT, nvd4, v3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2411,7 +2513,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioTrc(itrc)%dkind=PIO_FOUT ADM(ng)%pioTrc(itrc)%gtype=r3dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioTrc(itrc)%vd, & & PIO_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2442,7 +2544,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(ifield)%dkind=PIO_FOUT ADM(ng)%pioVar(ifield)%gtype=r2dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(ifield)%vd, & & PIO_FOUT, 5, t3dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2468,7 +2570,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idDano)%dkind=PIO_FOUT ADM(ng)%pioVar(idDano)%gtype=r3dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idDano)%vd, & & PIO_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2488,7 +2590,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idVvis)%dkind=PIO_FOUT ADM(ng)%pioVar(idVvis)%gtype=w3dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idVvis)%vd, & & PIO_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2509,7 +2611,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idTdif)%dkind=PIO_FOUT ADM(ng)%pioVar(idTdif)%gtype=w3dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idTdif)%vd, & & PIO_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2532,7 +2634,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idSdif)%dkind=PIO_FOUT ADM(ng)%pioVar(idSdif)%gtype=w3dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idSdif)%vd, & & PIO_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2566,7 +2668,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idTsur(itrc))%dkind=PIO_FOUT ADM(ng)%pioVar(idTsur(itrc))%gtype=r2dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idTsur(itrc))%vd, & & PIO_FOUT, & & nvd3, t2dgrd, Aval, Vinfo, ncname) @@ -2594,7 +2696,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idUsms)%dkind=PIO_FOUT ADM(ng)%pioVar(idUsms)%gtype=u2dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idUsms)%vd, & & PIO_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2617,7 +2719,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idVsms)%dkind=PIO_FOUT ADM(ng)%pioVar(idVsms)%gtype=v2dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idVsms)%vd, & & PIO_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2641,7 +2743,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idUbms)%dkind=PIO_FOUT ADM(ng)%pioVar(idUbms)%gtype=u2dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idUbms)%vd, & & PIO_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2664,7 +2766,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idVbms)%dkind=PIO_FOUT ADM(ng)%pioVar(idVbms)%gtype=v2dvar ! - status=def_var(ng, iADM, ADM(ng)%pioFile, & + status=def_var(ng, model, ADM(ng)%pioFile, & & ADM(ng)%pioVar(idVbms)%vd, & & PIO_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2674,14 +2776,14 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ! Leave definition mode. !----------------------------------------------------------------------- ! - CALL pio_netcdf_enddef (ng, iADM, ncname, ADM(ng)%pioFile) + CALL pio_netcdf_enddef (ng, model, ncname, ADM(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! !----------------------------------------------------------------------- ! Write out time-recordless, information variables. !----------------------------------------------------------------------- ! - CALL wrt_info (ng, iADM, ADM(ng)%pioFile, ncname) + CALL wrt_info (ng, model, ADM(ng)%pioFile, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF DEFINE ! @@ -2695,7 +2797,7 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ! ! Open adjoint file for read/write. ! - CALL pio_netcdf_open (ng, iADM, ncname, 1, ADM(ng)%pioFile) + CALL pio_netcdf_open (ng, model, ncname, 1, ADM(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) THEN WRITE (stdout,60) TRIM(ncname) RETURN @@ -2703,13 +2805,13 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ! ! Inquire about the dimensions and check for consistency. ! - CALL pio_netcdf_check_dim (ng, iADM, ncname, & + CALL pio_netcdf_check_dim (ng, model, ncname, & & pioFile = ADM(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! ! Inquire about the variables. ! - CALL pio_netcdf_inq_var (ng, iADM, ncname, & + CALL pio_netcdf_inq_var (ng, model, ncname, & & pioFile = ADM(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! @@ -2812,6 +2914,16 @@ SUBROUTINE ad_def_his_pio (ng, ldef) ADM(ng)%pioVar(idSbry(isVvel))%dkind=PIO_FOUT ADM(ng)%pioVar(idSbry(isVvel))%gtype=v3dvar # endif + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idu3dE))) THEN + got_var(idu3dE)=.TRUE. + ADM(ng)%pioVar(idu3dE)%vd=var_desc(i) + ADM(ng)%pioVar(idu3dE)%dkind=PIO_FOUT + ADM(ng)%pioVar(idu3dE)%gtype=r3dvar + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idv3dN))) THEN + got_var(idv3dN)=.TRUE. + ADM(ng)%pioVar(idv3dN)%vd=var_desc(i) + ADM(ng)%pioVar(idv3dN)%dkind=PIO_FOUT + ADM(ng)%pioVar(idv3dN)%gtype=r3dvar ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idOvel))) THEN got_var(idOvel)=.TRUE. ADM(ng)%pioVar(idOvel)%vd=var_desc(i) diff --git a/ROMS/Adjoint/ad_step3d_uv.F b/ROMS/Adjoint/ad_step3d_uv.F index 91c392a7..30f44c4c 100644 --- a/ROMS/Adjoint/ad_step3d_uv.F +++ b/ROMS/Adjoint/ad_step3d_uv.F @@ -20,6 +20,28 @@ MODULE ad_step3d_uv_mod ! Qsrc ! ! ! !======================================================================= +! + USE mod_param + USE mod_coupling +# ifdef DIAGNOSTICS_UV +!! USE mod_diags +# endif + USE mod_forces + USE mod_grid + USE mod_mixing + USE mod_ocean + USE mod_scalars + USE mod_sources +! + USE ad_exchange_2d_mod + USE ad_exchange_3d_mod + USE exchange_3d_mod +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : ad_mp_exchange2d, ad_mp_exchange3d +# endif + USE ad_u3dbc_mod, ONLY : ad_u3dbc_tile + USE ad_v3dbc_mod, ONLY : ad_v3dbc_tile + USE uv_var_change_mod, ONLY : ad_uv_C2A_grid ! implicit none ! @@ -32,15 +54,6 @@ MODULE ad_step3d_uv_mod SUBROUTINE ad_step3d_uv (ng, tile) !*********************************************************************** ! - USE mod_param - USE mod_coupling -# ifdef DIAGNOSTICS_UV -!! USE mod_diags -# endif - USE mod_forces - USE mod_grid - USE mod_mixing - USE mod_ocean USE mod_stepping ! ! Imported variable declarations. @@ -177,19 +190,6 @@ SUBROUTINE ad_step3d_uv_tile (ng, tile, & & Huon, ad_Huon, & & Hvom, ad_Hvom) !*********************************************************************** -! - USE mod_param - USE mod_scalars - USE mod_sources -! - USE ad_exchange_2d_mod - USE ad_exchange_3d_mod - USE exchange_3d_mod -# ifdef DISTRIBUTE - USE mp_exchange_mod, ONLY : ad_mp_exchange2d, ad_mp_exchange3d -# endif - USE ad_u3dbc_mod, ONLY : ad_u3dbc_tile - USE ad_v3dbc_mod, ONLY : ad_v3dbc_tile ! ! Imported variable declarations. ! @@ -413,6 +413,16 @@ SUBROUTINE ad_step3d_uv_tile (ng, tile, & END DO ! !----------------------------------------------------------------------- +! Compute adjoint 3D momentum (ad_ua, ad_va) at RHO-points (A-Grid) +! for output purposes and data assimilation where the observations +! and state vector is located at the cell-center. +!----------------------------------------------------------------------- +! +!> CALL tl_uv_C2A_grid (ng, tile, iTLM, nnew) +!> + CALL ad_uv_C2A_grid (ng, tile, iTLM, nnew) +! +!----------------------------------------------------------------------- ! Exchange boundary data. !----------------------------------------------------------------------- ! diff --git a/ROMS/Adjoint/ad_wrt_his.F b/ROMS/Adjoint/ad_wrt_his.F index edc112df..8809e4a7 100644 --- a/ROMS/Adjoint/ad_wrt_his.F +++ b/ROMS/Adjoint/ad_wrt_his.F @@ -94,7 +94,7 @@ SUBROUTINE ad_wrt_his (ng, tile) ! SELECT CASE (ADM(ng)%IOtype) CASE (io_nf90) - CALL ad_wrt_his_nf90 (ng, tile, & + CALL ad_wrt_his_nf90 (ng, iADM, tile, & # ifdef ADJUST_BOUNDARY & LBij, UBij, & # endif @@ -102,7 +102,7 @@ SUBROUTINE ad_wrt_his (ng, tile) # if defined PIO_LIB && defined DISTRIBUTE CASE (io_pio) - CALL ad_wrt_his_pio (ng, tile, & + CALL ad_wrt_his_pio (ng, iADM, tile, & # ifdef ADJUST_BOUNDARY & LBij, UBij, & # endif @@ -121,7 +121,7 @@ SUBROUTINE ad_wrt_his (ng, tile) END SUBROUTINE ad_wrt_his ! !*********************************************************************** - SUBROUTINE ad_wrt_his_nf90 (ng, tile, & + SUBROUTINE ad_wrt_his_nf90 (ng, model, tile, & # ifdef ADJUST_BOUNDARY & LBij, UBij, & # endif @@ -132,7 +132,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & ! ! Imported variable declarations. ! - integer, intent(in) :: ng, tile + integer, intent(in) :: ng, model, tile # ifdef ADJUST_BOUNDARY integer, intent(in) :: LBij, UBij # endif @@ -244,7 +244,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & Tval(1)=time(ng) # endif END IF - CALL netcdf_put_fvar (ng, iADM, ADM(ng)%name, & + CALL netcdf_put_fvar (ng, model, ADM(ng)%name, & & TRIM(Vname(1,idtime)), tval, & & (/ADM(ng)%Rindex/), (/1/), & & ncid = ADM(ng)%ncid, & @@ -260,7 +260,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & ! scale=1.0_dp ! m2/s2 gtype=gfactor*u3dvar - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idUsms, & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idUsms, & & ADM(ng)%Vid(idUsms), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, Nfrec(ng), scale, & @@ -281,7 +281,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & ! scale=1.0_dp ! m2/s2 gtype=gfactor*v3dvar - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idVsms, & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idVsms, & & ADM(ng)%Vid(idVsms), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, Nfrec(ng), scale, & @@ -308,7 +308,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & IF (Lstflux(itrc,ng)) THEN scale=1.0_dp ! kinematic flux units gtype=gfactor*r3dvar - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idTsur(itrc), & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idTsur(itrc), & & ADM(ng)%Vid(idTsur(itrc)), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, Nfrec(ng), scale, & @@ -333,7 +333,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & IF (Hout(idbath,ng)) THEN scale=1.0_dp gtype=gfactor*r2dvar - status=nf_fwrite2d(ng, iADM, ADM(ng)%ncid, idbath, & + status=nf_fwrite2d(ng, model, ADM(ng)%ncid, idbath, & & ADM(ng)%Vid(idbath), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -359,7 +359,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & IF (Hout(idpthR,ng)) THEN scale=1.0_dp gtype=gfactor*r3dvar - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idpthR, & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idpthR, & & ADM(ng)%Vid(idpthR), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -383,7 +383,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & IF (Hout(idpthW,ng)) THEN scale=1.0_dp gtype=gfactor*w3dvar - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idpthW, & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idpthW, & & ADM(ng)%Vid(idpthW), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -410,7 +410,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & IF (WRTforce(ng)) THEN scale=1.0_dp gtype=gfactor*r2dvar - status=nf_fwrite2d(ng, iADM, ADM(ng)%ncid, idFsur, & + status=nf_fwrite2d(ng, model, ADM(ng)%ncid, idFsur, & & ADM(ng)%Vid(idFsur), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -431,7 +431,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & scale=1.0_dp gtype=gfactor*r2dvar IF (LwrtState2d(ng)) THEN - status=nf_fwrite2d(ng, iADM, ADM(ng)%ncid, idFsur, & + status=nf_fwrite2d(ng, model, ADM(ng)%ncid, idFsur, & & ADM(ng)%Vid(idFsur), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -445,7 +445,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & & OCEAN(ng)% ad_zeta(:,:,kout)) # endif ELSE - status=nf_fwrite2d(ng, iADM, ADM(ng)%ncid, idFsur, & + status=nf_fwrite2d(ng, model, ADM(ng)%ncid, idFsur, & & ADM(ng)%Vid(idFsur), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -478,7 +478,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & ! IF (ANY(Lobc(:,isFsur,ng))) THEN scale=1.0_dp - status=nf_fwrite2d_bry(ng, iADM, ADM(ng)%name, ADM(ng)%ncid, & + status=nf_fwrite2d_bry(ng, model, ADM(ng)%name, ADM(ng)%ncid, & & Vname(1,idSbry(isFsur)), & & ADM(ng)%Vid(idSbry(isFsur)), & & ADM(ng)%Rindex, r2dvar, & @@ -504,7 +504,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & IF (WRTforce(ng)) THEN scale=1.0_dp gtype=gfactor*u2dvar - status=nf_fwrite2d(ng, iADM, ADM(ng)%ncid, idUbar, & + status=nf_fwrite2d(ng, model, ADM(ng)%ncid, idUbar, & & ADM(ng)%Vid(idUbar), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -525,7 +525,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & scale=1.0_dp gtype=gfactor*u2dvar IF (LwrtState2d(ng)) THEN - status=nf_fwrite2d(ng, iADM, ADM(ng)%ncid, idUbar, & + status=nf_fwrite2d(ng, model, ADM(ng)%ncid, idUbar, & & ADM(ng)%Vid(idUbar), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -534,7 +534,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & # endif & OCEAN(ng) % ad_ubar(:,:,kout)) ELSE - status=nf_fwrite2d(ng, iADM, ADM(ng)%ncid, idUbar, & + status=nf_fwrite2d(ng, model, ADM(ng)%ncid, idUbar, & & ADM(ng)%Vid(idUbar), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -562,7 +562,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & ! IF (ANY(Lobc(:,isUbar,ng))) THEN scale=1.0_dp - status=nf_fwrite2d_bry(ng, iADM, ADM(ng)%name, ADM(ng)%ncid, & + status=nf_fwrite2d_bry(ng, model, ADM(ng)%name, ADM(ng)%ncid, & & Vname(1,idSbry(isUbar)), & & ADM(ng)%Vid(idSbry(isUbar)), & & ADM(ng)%Rindex, u2dvar, & @@ -588,7 +588,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & IF (WRTforce(ng)) THEN scale=1.0_dp gtype=gfactor*v2dvar - status=nf_fwrite2d(ng, iADM, ADM(ng)%ncid, idVbar, & + status=nf_fwrite2d(ng, model, ADM(ng)%ncid, idVbar, & & ADM(ng)%Vid(idVbar), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -609,7 +609,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & scale=1.0_dp gtype=gfactor*v2dvar IF (LwrtState2d(ng)) THEN - status=nf_fwrite2d(ng, iADM, ADM(ng)%ncid, idVbar, & + status=nf_fwrite2d(ng, model, ADM(ng)%ncid, idVbar, & & ADM(ng)%Vid(idVbar), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -618,7 +618,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & # endif & OCEAN(ng) % ad_vbar(:,:,kout)) ELSE - status=nf_fwrite2d(ng, iADM, ADM(ng)%ncid, idVbar, & + status=nf_fwrite2d(ng, model, ADM(ng)%ncid, idVbar, & & ADM(ng)%Vid(idVbar), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -646,7 +646,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & ! IF (ANY(Lobc(:,isVbar,ng))) THEN scale=1.0_dp - status=nf_fwrite2d_bry(ng, iADM, ADM(ng)%name, ADM(ng)%ncid, & + status=nf_fwrite2d_bry(ng, model, ADM(ng)%name, ADM(ng)%ncid, & & Vname(1,idSbry(isVbar)), & & ADM(ng)%Vid(idSbry(isVbar)), & & ADM(ng)%Rindex, v2dvar, & @@ -674,7 +674,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & IF (WRTforce(ng)) THEN scale=1.0_dp gtype=gfactor*u3dvar - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idUvel, & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idUvel, & & ADM(ng)%Vid(idUvel), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -697,7 +697,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & # ifdef AD_OUTPUT_STATE IF (LwrtState3d(ng)) THEN # endif - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idUvel, & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idUvel, & & ADM(ng)%Vid(idUvel), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -707,7 +707,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & & OCEAN(ng) % ad_u(:,:,:,nout)) # ifdef AD_OUTPUT_STATE ELSE - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idUvel, & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idUvel, & & ADM(ng)%Vid(idUvel), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -736,7 +736,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & ! IF (ANY(Lobc(:,isUvel,ng))) THEN scale=1.0_dp - status=nf_fwrite3d_bry(ng, iADM, ADM(ng)%name, ADM(ng)%ncid, & + status=nf_fwrite3d_bry(ng, model, ADM(ng)%name, ADM(ng)%ncid, & & Vname(1,idSbry(isUvel)), & & ADM(ng)%Vid(idSbry(isUvel)), & & ADM(ng)%Rindex, u3dvar, & @@ -762,7 +762,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & IF (WRTforce(ng)) THEN scale=1.0_dp gtype=gfactor*v3dvar - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idVvel, & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idVvel, & & ADM(ng)%Vid(idVvel), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -785,7 +785,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & # ifdef AD_OUTPUT_STATE IF (LwrtState3d(ng)) THEN # endif - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idVvel, & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idVvel, & & ADM(ng)%Vid(idVvel), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -795,7 +795,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & & OCEAN(ng) % ad_v(:,:,:,nout)) # ifdef AD_OUTPUT_STATE ELSE - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idVvel, & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idVvel, & & ADM(ng)%Vid(idVvel), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -824,7 +824,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & ! IF (ANY(Lobc(:,isVvel,ng))) THEN scale=1.0_dp - status=nf_fwrite3d_bry(ng, iADM, ADM(ng)%name, ADM(ng)%ncid, & + status=nf_fwrite3d_bry(ng, model, ADM(ng)%name, ADM(ng)%ncid, & & Vname(1,idSbry(isVvel)), & & ADM(ng)%Vid(idSbry(isVvel)), & & ADM(ng)%Rindex, v3dvar, & @@ -843,6 +843,50 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & END IF # endif ! +! Write out 3D Eastward momentum (m/s) at RHO-points, A-grid. +! + IF (Hout(idu3dE,ng)) THEN + scale=1.0_dp + gtype=gfactor*r3dvar + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idu3dE, & + & ADM(ng)%Vid(idu3dE), & + & ADM(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask_full, & +# endif + & OCEAN(ng) % ad_ua) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idu3dE)), ADM(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 3D Northward momentum (m/s) at RHO-points, A-grid. +! + IF (Hout(idv3dN,ng)) THEN + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idv3dN, & + & ADM(ng)%Vid(idv3dN), & + & ADM(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask_full, & +# endif + & OCEAN(ng) % ad_va) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idv3dN)), ADM(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! ! Write out S-coordinate omega vertical velocity (m/s). ! IF (Hout(idOvel,ng)) THEN @@ -857,7 +901,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & & GRID(ng) % pn, & & OCEAN(ng) % ad_W_sol, & & Wr3d) - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idOvel, & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idOvel, & & ADM(ng)%Vid(idOvel), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -884,7 +928,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & IF (WRTforce(ng)) THEN scale=1.0_dp gtype=gfactor*r3dvar - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idTvar(itrc), & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idTvar(itrc), & & ADM(ng)%Tid(itrc), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -908,7 +952,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & # ifdef AD_OUTPUT_STATE IF (LwrtState3d(ng)) THEN # endif - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idTvar(itrc), & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idTvar(itrc), & & ADM(ng)%Tid(itrc), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -918,7 +962,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & & OCEAN(ng) % ad_t(:,:,:,nout,itrc)) # ifdef AD_OUTPUT_STATE ELSE - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idTvar(itrc), & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idTvar(itrc), & & ADM(ng)%Tid(itrc), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -950,7 +994,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & DO itrc=1,NT(ng) IF (ANY(Lobc(:,isTvar(itrc),ng))) THEN scale=1.0_dp - status=nf_fwrite3d_bry(ng, iADM, ADM(ng)%name, ADM(ng)%ncid, & + status=nf_fwrite3d_bry(ng, model, ADM(ng)%name, ADM(ng)%ncid, & & Vname(1,idSbry(isTvar(itrc))), & & ADM(ng)%Vid(idSbry(isTvar(itrc))), & & ADM(ng)%Rindex, r3dvar, & @@ -976,7 +1020,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & IF (Hout(idDano,ng)) THEN scale=1.0_dp gtype=gfactor*r3dvar - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idDano, & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idDano, & & ADM(ng)%Vid(idDano), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -999,7 +1043,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & IF (Hout(idVvis,ng)) THEN scale=1.0_dp gtype=gfactor*w3dvar - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idVvis, & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idVvis, & & ADM(ng)%Vid(idVvis), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -1023,7 +1067,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & IF (Hout(idTdif,ng)) THEN scale=1.0_dp gtype=gfactor*w3dvar - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idTdif, & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idTdif, & & ADM(ng)%Vid(idTdif), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -1048,7 +1092,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & IF (Hout(idSdif,ng)) THEN scale=1.0_dp gtype=gfactor*w3dvar - status=nf_fwrite3d(ng, iADM, ADM(ng)%ncid, idSdif, & + status=nf_fwrite3d(ng, model, ADM(ng)%ncid, idSdif, & & ADM(ng)%Vid(idSdif), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -1085,7 +1129,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & scale=1.0_dp # endif gtype=gfactor*r2dvar - status=nf_fwrite2d(ng, iADM, ADM(ng)%ncid, idTsur(itrc), & + status=nf_fwrite2d(ng, model, ADM(ng)%ncid, idTsur(itrc), & & ADM(ng)%Vid(idTsur(itrc)), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -1119,7 +1163,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & scale=1.0_dp # endif gtype=gfactor*u2dvar - status=nf_fwrite2d(ng, iADM, ADM(ng)%ncid, idUsms, & + status=nf_fwrite2d(ng, model, ADM(ng)%ncid, idUsms, & & ADM(ng)%Vid(idUsms), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -1148,7 +1192,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & scale=1.0_dp # endif gtype=gfactor*v2dvar - status=nf_fwrite2d(ng, iADM, ADM(ng)%ncid, idVsms, & + status=nf_fwrite2d(ng, model, ADM(ng)%ncid, idVsms, & & ADM(ng)%Vid(idVsms), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -1173,7 +1217,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & !! scale=-rho0 scale=1.0_dp gtype=gfactor*u2dvar - status=nf_fwrite2d(ng, iADM, ADM(ng)%ncid, idUbms, & + status=nf_fwrite2d(ng, model, ADM(ng)%ncid, idUbms, & & ADM(ng)%Vid(idUbms), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -1197,7 +1241,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & !! scale=-rho0 scale=1.0_dp gtype=gfactor*v2dvar - status=nf_fwrite2d(ng, iADM, ADM(ng)%ncid, idVbms, & + status=nf_fwrite2d(ng, model, ADM(ng)%ncid, idVbms, & & ADM(ng)%Vid(idVbms), & & ADM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -1220,7 +1264,7 @@ SUBROUTINE ad_wrt_his_nf90 (ng, tile, & ! processes to access data immediately after it is written. !----------------------------------------------------------------------- ! - CALL netcdf_sync (ng, iADM, ADM(ng)%name, ADM(ng)%ncid) + CALL netcdf_sync (ng, model, ADM(ng)%name, ADM(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! 10 FORMAT (2x,'AD_WRT_HIS_NF90 - writing adjoint', t42, & @@ -1362,7 +1406,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & Tval(1)=time(ng) # endif END IF - CALL pio_netcdf_put_fvar (ng, iADM, ADM(ng)%name, & + CALL pio_netcdf_put_fvar (ng, model, ADM(ng)%name, & & TRIM(Vname(1,idtime)), tval, & & (/ADM(ng)%Rindex/), (/1/), & & pioFile = ADM(ng)%pioFile, & @@ -1383,7 +1427,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u2dfrc(ng) END IF ! - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idUsms, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idUsms, & & ADM(ng)%pioVar(idUsms), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, Nfrec(ng), scale, & @@ -1409,7 +1453,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v2dfrc(ng) END IF ! - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idVsms, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idVsms, & & ADM(ng)%pioVar(idVsms), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, Nfrec(ng), scale, & @@ -1441,7 +1485,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_r2dfrc(ng) END IF ! - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idTsur(itrc), & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idTsur(itrc), & & ADM(ng)%pioVar(idTsur(itrc)), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, Nfrec(ng), scale, & @@ -1471,7 +1515,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_r2dvar(ng) END IF ! - status=nf_fwrite2d(ng, iADM, ADM(ng)%pioFile, idbath, & + status=nf_fwrite2d(ng, model, ADM(ng)%pioFile, idbath, & & ADM(ng)%pioVar(idbath), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1501,7 +1545,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ELSE ioDesc => ioDesc_sp_r3dvar(ng) END IF - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idpthR, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idpthR, & & ADM(ng)%pioVar(idpthR), & & ADM(ng)%Rindex, & & ioDesc, & @@ -1530,7 +1574,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ELSE ioDesc => ioDesc_sp_w3dvar(ng) END IF - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idpthW, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idpthW, & & ADM(ng)%pioVar(idpthW), & & ADM(ng)%Rindex, & & ioDesc, & @@ -1563,7 +1607,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & IF (Hout(idFsur,ng)) THEN # ifdef WEAK_CONSTRAINT IF (WRTforce(ng)) THEN - status=nf_fwrite2d(ng, iADM, ADM(ng)%pioFile, idFsur, & + status=nf_fwrite2d(ng, model, ADM(ng)%pioFile, idFsur, & & ADM(ng)%pioVar(idFsur), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1582,7 +1626,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ELSE # endif IF (LwrtState2d(ng)) THEN - status=nf_fwrite2d(ng, iADM, ADM(ng)%pioFile, idFsur, & + status=nf_fwrite2d(ng, model, ADM(ng)%pioFile, idFsur, & & ADM(ng)%pioVar(idFsur), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1596,7 +1640,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & & OCEAN(ng)% ad_zeta(:,:,kout)) # endif ELSE - status=nf_fwrite2d(ng, iADM, ADM(ng)%pioFile, idFsur, & + status=nf_fwrite2d(ng, model, ADM(ng)%pioFile, idFsur, & & ADM(ng)%pioVar(idFsur), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1635,7 +1679,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_r2dobc(ng) END IF ! - status=nf_fwrite2d_bry(ng, iADM, ADM(ng)%name, & + status=nf_fwrite2d_bry(ng, model, ADM(ng)%name, & & ADM(ng)%pioFile, & & Vname(1,idSbry(isFsur)), & & ADM(ng)%pioVar(idSbry(isFsur)), & @@ -1667,7 +1711,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & IF (Hout(idUbar,ng)) THEN # ifdef WEAK_CONSTRAINT IF (WRTforce(ng)) THEN - status=nf_fwrite2d(ng, iADM, ADM(ng)%pioFile, idUbar, & + status=nf_fwrite2d(ng, model, ADM(ng)%pioFile, idUbar, & & ADM(ng)%pioVar(idUbar), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1686,7 +1730,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ELSE # endif IF (LwrtState2d(ng)) THEN - status=nf_fwrite2d(ng, iADM, ADM(ng)%pioFile, idUbar, & + status=nf_fwrite2d(ng, model, ADM(ng)%pioFile, idUbar, & & ADM(ng)%pioVar(idUbar), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1695,7 +1739,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & # endif & OCEAN(ng) % ad_ubar(:,:,kout)) ELSE - status=nf_fwrite2d(ng, iADM, ADM(ng)%pioFile, idUbar, & + status=nf_fwrite2d(ng, model, ADM(ng)%pioFile, idUbar, & & ADM(ng)%pioVar(idUbar), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1729,7 +1773,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u2dobc(ng) END IF ! - status=nf_fwrite2d_bry(ng, iADM, ADM(ng)%name, & + status=nf_fwrite2d_bry(ng, model, ADM(ng)%name, & & ADM(ng)%pioFile, & & Vname(1,idSbry(isUbar)), & & ADM(ng)%pioVar(idSbry(isUbar)), & @@ -1762,7 +1806,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & # ifdef WEAK_CONSTRAINT IF (WRTforce(ng)) THEN - status=nf_fwrite2d(ng, iADM, ADM(ng)%pioFile, idVbar, & + status=nf_fwrite2d(ng, model, ADM(ng)%pioFile, idVbar, & & ADM(ng)%pioVar(idVbar), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1781,7 +1825,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ELSE # endif IF (LwrtState2d(ng)) THEN - status=nf_fwrite2d(ng, iADM, ADM(ng)%pioFile, idVbar, & + status=nf_fwrite2d(ng, model, ADM(ng)%pioFile, idVbar, & & ADM(ng)%pioVar(idVbar), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1790,7 +1834,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & # endif & OCEAN(ng) % ad_vbar(:,:,kout)) ELSE - status=nf_fwrite2d(ng, iADM, ADM(ng)%pioFile, idVbar, & + status=nf_fwrite2d(ng, model, ADM(ng)%pioFile, idVbar, & & ADM(ng)%pioVar(idVbar), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1824,7 +1868,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v2dobc(ng) END IF ! - status=nf_fwrite2d_bry(ng, iADM, ADM(ng)%name, & + status=nf_fwrite2d_bry(ng, model, ADM(ng)%name, & & ADM(ng)%pioFile, & & Vname(1,idSbry(isVbar)), & & ADM(ng)%pioVar(idSbry(isVbar)), & @@ -1858,7 +1902,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & IF (Hout(idUvel,ng)) THEN # ifdef WEAK_CONSTRAINT IF (WRTforce(ng)) THEN - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idUvel, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idUvel, & & ADM(ng)%pioVar(idUvel), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -1879,7 +1923,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & # ifdef AD_OUTPUT_STATE IF (LwrtState3d(ng)) THEN # endif - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idUvel, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idUvel, & & ADM(ng)%pioVar(idUvel), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -1889,7 +1933,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & & OCEAN(ng) % ad_u(:,:,:,nout)) # ifdef AD_OUTPUT_STATE ELSE - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idUvel, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idUvel, & & ADM(ng)%pioVar(idUvel), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -1924,7 +1968,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u3dobc(ng) END IF ! - status=nf_fwrite3d_bry(ng, iADM, ADM(ng)%name, & + status=nf_fwrite3d_bry(ng, model, ADM(ng)%name, & & ADM(ng)%pioFile, & & Vname(1,idSbry(isUvel)), & & ADM(ng)%pioVar(idSbry(isUvel)), & @@ -1956,7 +2000,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & IF (Hout(idVvel,ng)) THEN # ifdef WEAK_CONSTRAINT IF (WRTforce(ng)) THEN - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idVvel, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idVvel, & & ADM(ng)%pioVar(idVvel), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -1977,7 +2021,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & # ifdef AD_OUTPUT_STATE IF (LwrtState3d(ng)) THEN # endif - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idVvel, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idVvel, & & ADM(ng)%pioVar(idVvel), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -1987,7 +2031,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & & OCEAN(ng) % ad_v(:,:,:,nout)) # ifdef AD_OUTPUT_STATE ELSE - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idVvel, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idVvel, & & ADM(ng)%pioVar(idVvel), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -2022,7 +2066,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v3dobc(ng) END IF ! - status=nf_fwrite3d_bry(ng, iADM, ADM(ng)%name, & + status=nf_fwrite3d_bry(ng, model, ADM(ng)%name, & & ADM(ng)%pioFile, & & Vname(1,idSbry(isVvel)), & & ADM(ng)%pioVar(idSbry(isVvel)), & @@ -2042,6 +2086,61 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & END IF # endif ! +! Write out 3D Eastward momentum (m/s) at RHO-points, A-grid +! + IF (Hout(idu3dE,ng)) THEN + scale=1.0_dp + IF (ADM(ng)%pioVar(idu3dE)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r3dvar(ng) + ELSE + ioDesc => ioDesc_sp_r3dvar(ng) + END IF + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idu3dE, & + & ADM(ng)%pioVar(idu3dE), & + & ADM(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask_full, & +# endif + & OCEAN(ng) % ad_ua) + IF (FoundError(status, PIO_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idu3dE)), ADM(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 3D Northward momentum (m/s) at RHO-points, A-grid +! + IF (Hout(idv3dN,ng)) THEN + IF (ADM(ng)%pioVar(idV3dN)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r3dvar(ng) + ELSE + ioDesc => ioDesc_sp_r3dvar(ng) + END IF + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idv3dN, & + & ADM(ng)%pioVar(idv3dN), & + & ADM(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask_full, & +# endif + & OCEAN(ng) % ad_va) + IF (FoundError(status, PIO_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idv3dN)), ADM(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! ! Write out S-coordinate omega vertical velocity (m/s). ! IF (Hout(idOvel,ng)) THEN @@ -2061,7 +2160,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ELSE ioDesc => ioDesc_sp_w3dvar(ng) END IF - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idOvel, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idOvel, & & ADM(ng)%pioVar(idOvel), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -2094,7 +2193,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & # ifdef WEAK_CONSTRAINT IF (WRTforce(ng)) THEN - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idTvar(itrc), & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idTvar(itrc),& & ADM(ng)%pioTrc(itrc), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -2116,7 +2215,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & # ifdef AD_OUTPUT_STATE IF (LwrtState3d(ng)) THEN # endif - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, & & idTvar(itrc), ADM(ng)%pioTrc(itrc), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -2126,7 +2225,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & & OCEAN(ng) % ad_t(:,:,:,nout,itrc)) # ifdef AD_OUTPUT_STATE ELSE - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, & & idTvar(itrc), ADM(ng)%pioTrc(itrc), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -2165,7 +2264,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_r3dobc(ng) END IF ! - status=nf_fwrite3d_bry(ng, iADM, ADM(ng)%name, & + status=nf_fwrite3d_bry(ng, model, ADM(ng)%name, & & ADM(ng)%pioFile, & & Vname(1,ifield), & & ADM(ng)%pioVar(ifield), & @@ -2196,7 +2295,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_r3dvar(ng) END IF ! - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idDano, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idDano, & & ADM(ng)%pioVar(idDano), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -2224,7 +2323,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_w3dvar(ng) END IF ! - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idVvis, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idVvis, & & ADM(ng)%pioVar(idVvis), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -2253,7 +2352,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_w3dvar(ng) END IF ! - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idTdif, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idTdif, & & ADM(ng)%pioVar(idTdif), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -2284,7 +2383,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_w3dvar(ng) END IF ! - status=nf_fwrite3d(ng, iADM, ADM(ng)%pioFile, idSdif, & + status=nf_fwrite3d(ng, model, ADM(ng)%pioFile, idSdif, & & ADM(ng)%pioVar(idSdif), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -2326,7 +2425,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_r2dvar(ng) END IF ! - status=nf_fwrite2d(ng, iADM, ADM(ng)%pioFile, idTsur(itrc), & + status=nf_fwrite2d(ng, model, ADM(ng)%pioFile, idTsur(itrc), & & ADM(ng)%pioVar(idTsur(itrc)), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -2365,7 +2464,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u2dvar(ng) END IF ! - status=nf_fwrite2d(ng, iADM, ADM(ng)%pioFile, idUsms, & + status=nf_fwrite2d(ng, model, ADM(ng)%pioFile, idUsms, & & ADM(ng)%pioVar(idUsms), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -2399,7 +2498,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v2dvar(ng) END IF ! - status=nf_fwrite2d(ng, iADM, ADM(ng)%pioFile, idVsms, & + status=nf_fwrite2d(ng, model, ADM(ng)%pioFile, idVsms, & & ADM(ng)%pioVar(idVsms), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -2429,7 +2528,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u2dvar(ng) END IF ! - status=nf_fwrite2d(ng, iADM, ADM(ng)%pioFile, idUbms, & + status=nf_fwrite2d(ng, model, ADM(ng)%pioFile, idUbms, & & ADM(ng)%pioVar(idUbms), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -2458,7 +2557,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v2dvar(ng) END IF ! - status=nf_fwrite2d(ng, iADM, ADM(ng)%pioFile, idVbms, & + status=nf_fwrite2d(ng, model, ADM(ng)%pioFile, idVbms, & & ADM(ng)%pioVar(idVbms), & & ADM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -2481,7 +2580,7 @@ SUBROUTINE ad_wrt_his_pio (ng, tile, & ! processes to access data immediately after it is written. !----------------------------------------------------------------------- ! - CALL pio_netcdf_sync (ng, iADM, ADM(ng)%name, ADM(ng)%pioFile) + CALL pio_netcdf_sync (ng, model, ADM(ng)%name, ADM(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! 10 FORMAT (2x,'AD_WRT_HIS_PIO - writing adjoint', t42, & diff --git a/ROMS/Modules/mod_ocean.F b/ROMS/Modules/mod_ocean.F index afbae0ef..44646c98 100644 --- a/ROMS/Modules/mod_ocean.F +++ b/ROMS/Modules/mod_ocean.F @@ -28,7 +28,9 @@ MODULE mod_ocean ! rv Right hand side of 3D V-momentum equation (m4/s2). ! ! t Tracer type variables (active and passive). ! ! u 3D U-momentum component (m/s). ! +! ua 3D U-momentun component (m/s) at RHO-points, A-grid. ! ! v 3D V-momentum component (m/s). ! +! va 3D U-momentun component (m/s) at RHO-points, A-grid. ! ! W S-coordinate (omega*Hz/mn) vertical velocity (m3/s). ! #ifdef BIOLOGY ! ! @@ -109,7 +111,9 @@ MODULE mod_ocean real(r8), pointer :: rv(:,:,:,:) real(r8), pointer :: t(:,:,:,:,:) real(r8), pointer :: u(:,:,:,:) + real(r8), pointer :: ua(:,:,:) real(r8), pointer :: v(:,:,:,:) + real(r8), pointer :: va(:,:,:) real(r8), pointer :: W(:,:,:) # if defined OMEGA_IMPLICIT real(r8), pointer :: Wi(:,:,:) @@ -171,7 +175,9 @@ MODULE mod_ocean real(r8), pointer :: tl_rv(:,:,:,:) real(r8), pointer :: tl_t(:,:,:,:,:) real(r8), pointer :: tl_u(:,:,:,:) + real(r8), pointer :: tl_ua(:,:,:) real(r8), pointer :: tl_v(:,:,:,:) + real(r8), pointer :: tl_va(:,:,:) real(r8), pointer :: tl_W(:,:,:) # if defined OMEGA_IMPLICIT real(r8), pointer :: tl_Wi(:,:,:) @@ -220,7 +226,9 @@ MODULE mod_ocean real(r8), pointer :: ad_rv(:,:,:,:) real(r8), pointer :: ad_t(:,:,:,:,:) real(r8), pointer :: ad_u(:,:,:,:) + real(r8), pointer :: ad_ua(:,:,:) real(r8), pointer :: ad_v(:,:,:,:) + real(r8), pointer :: ad_va(:,:,:) real(r8), pointer :: ad_W(:,:,:) real(r8), pointer :: ad_wvel(:,:,:) @@ -434,9 +442,15 @@ SUBROUTINE allocate_ocean (ng, LBi, UBi, LBj, UBj) allocate ( OCEAN(ng) % u(LBi:UBi,LBj:UBj,N(ng),2) ) Dmem(ng)=Dmem(ng)+2.0_r8*REAL(N(ng),r8)*size2d + allocate ( OCEAN(ng) % ua(LBi:UBi,LBj:UBj,N(ng)) ) + Dmem(ng)=Dmem(ng)+REAL(N(ng),r8)*size2d + allocate ( OCEAN(ng) % v(LBi:UBi,LBj:UBj,N(ng),2) ) Dmem(ng)=Dmem(ng)+2.0_r8*REAL(N(ng),r8)*size2d + allocate ( OCEAN(ng) % va(LBi:UBi,LBj:UBj,N(ng)) ) + Dmem(ng)=Dmem(ng)+REAL(N(ng),r8)*size2d + allocate ( OCEAN(ng) % W(LBi:UBi,LBj:UBj,0:N(ng)) ) Dmem(ng)=Dmem(ng)+REAL(N(ng)+1,r8)*size2d @@ -565,9 +579,15 @@ SUBROUTINE allocate_ocean (ng, LBi, UBi, LBj, UBj) allocate ( OCEAN(ng) % tl_u(LBi:UBi,LBj:UBj,N(ng),2) ) Dmem(ng)=Dmem(ng)+2.0_r8*REAL(N(ng),r8)*size2d + allocate ( OCEAN(ng) % tl_ua(LBi:UBi,LBj:UBj,N(ng)) ) + Dmem(ng)=Dmem(ng)+REAL(N(ng),r8)*size2d + allocate ( OCEAN(ng) % tl_v(LBi:UBi,LBj:UBj,N(ng),2) ) Dmem(ng)=Dmem(ng)+2.0_r8*REAL(N(ng),r8)*size2d + allocate ( OCEAN(ng) % tl_va(LBi:UBi,LBj:UBj,N(ng)) ) + Dmem(ng)=Dmem(ng)+REAL(N(ng),r8)*size2d + allocate ( OCEAN(ng) % tl_W(LBi:UBi,LBj:UBj,0:N(ng)) ) Dmem(ng)=Dmem(ng)+REAL(N(ng)+1,r8)*size2d @@ -671,9 +691,15 @@ SUBROUTINE allocate_ocean (ng, LBi, UBi, LBj, UBj) allocate ( OCEAN(ng) % ad_u(LBi:UBi,LBj:UBj,N(ng),2) ) Dmem(ng)=Dmem(ng)+2.0_r8*REAL(N(ng),r8)*size2d + allocate ( OCEAN(ng) % ad_ua(LBi:UBi,LBj:UBj,N(ng)) ) + Dmem(ng)=Dmem(ng)+REAL(N(ng),r8)*size2d + allocate ( OCEAN(ng) % ad_v(LBi:UBi,LBj:UBj,N(ng),2) ) Dmem(ng)=Dmem(ng)+2.0_r8*REAL(N(ng),r8)*size2d + allocate ( OCEAN(ng) % ad_va(LBi:UBi,LBj:UBj,N(ng)) ) + Dmem(ng)=Dmem(ng)+REAL(N(ng),r8)*size2d + allocate ( OCEAN(ng) % ad_W(LBi:UBi,LBj:UBj,0:N(ng)) ) Dmem(ng)=Dmem(ng)+REAL(N(ng)+1,r8)*size2d @@ -1004,6 +1030,9 @@ SUBROUTINE deallocate_ocean (ng) IF (.not.destroy(ng, OCEAN(ng)%t, MyFile, & & __LINE__, 'OCEAN(ng)%t')) RETURN + IF (.not.destroy(ng, OCEAN(ng)%ua, MyFile, & + & __LINE__, 'OCEAN(ng)%u')) RETURN + IF (.not.destroy(ng, OCEAN(ng)%u, MyFile, & & __LINE__, 'OCEAN(ng)%u')) RETURN @@ -1610,8 +1639,10 @@ SUBROUTINE initialize_ocean (ng, tile, model) OCEAN(ng) % u(i,j,k,1) = IniVal OCEAN(ng) % u(i,j,k,2) = IniVal + OCEAN(ng) % ua(i,j,k) = IniVal OCEAN(ng) % v(i,j,k,1) = IniVal OCEAN(ng) % v(i,j,k,2) = IniVal + OCEAN(ng) % va(i,j,k) = IniVal # if defined WEC OCEAN(ng) % u_stokes(i,j,k) = IniVal OCEAN(ng) % v_stokes(i,j,k) = IniVal @@ -1715,8 +1746,10 @@ SUBROUTINE initialize_ocean (ng, tile, model) OCEAN(ng) % tl_u(i,j,k,1) = IniVal OCEAN(ng) % tl_u(i,j,k,2) = IniVal + OCEAN(ng) % tl_ua(i,j,k) = IniVal OCEAN(ng) % tl_v(i,j,k,1) = IniVal OCEAN(ng) % tl_v(i,j,k,2) = IniVal + OCEAN(ng) % tl_va(i,j,k) = IniVal # if defined FORCING_SV || defined HESSIAN_FSV OCEAN(ng) % f_u(i,j,k) = IniVal OCEAN(ng) % f_v(i,j,k) = IniVal @@ -1821,8 +1854,10 @@ SUBROUTINE initialize_ocean (ng, tile, model) OCEAN(ng) % ad_u(i,j,k,1) = IniVal OCEAN(ng) % ad_u(i,j,k,2) = IniVal + OCEAN(ng) % ad_ua(i,j,k) = IniVal OCEAN(ng) % ad_v(i,j,k,1) = IniVal OCEAN(ng) % ad_v(i,j,k,2) = IniVal + OCEAN(ng) % ad_va(i,j,k) = IniVal OCEAN(ng) % ad_u_sol(i,j,k) = IniVal OCEAN(ng) % ad_v_sol(i,j,k) = IniVal # if defined FORCING_SV || defined HESSIAN_FSV diff --git a/ROMS/Nonlinear/set_avg.F b/ROMS/Nonlinear/set_avg.F index 23215700..2384fccd 100644 --- a/ROMS/Nonlinear/set_avg.F +++ b/ROMS/Nonlinear/set_avg.F @@ -369,18 +369,31 @@ SUBROUTINE set_avg_tile (ng, tile, & END DO END IF - IF (Aout(idu3dE,ng).and.Aout(idv3dN,ng)) THEN - CALL uv_rotate3d (ng, tile, .FALSE., .FALSE., & - & LBi, UBi, LBj, UBj, 1, N(ng), & - & GRID(ng) % CosAngler, & - & GRID(ng) % SinAngler, & -# ifdef MASKING - & GRID(ng)%rmask_full, & + IF (Aout(idu3dE,ng)) THEN + DO k=1,N(ng) + DO j=JstrR,JendR + DO i=IstrR,IendR + AVERAGE(ng)%avgu3dE(i,j,k)=OCEAN(ng)%ua(i,j,k) +# ifdef WET_DRY + AVERAGE(ng)%avgu3dE(i,j,k)=AVERAGE(ng)%avgu3dE(i,j,k)* & + & GRID(ng)%vmask_full(i,j) +# endif + END DO + END DO + END DO + END IF + IF (Aout(idv3dN,ng)) THEN + DO k=1,N(ng) + DO j=JstrR,JendR + DO i=IstrR,IendR + AVERAGE(ng)%avgv3dN(i,j,k)=OCEAN(ng)%va(i,j,k) +# ifdef WET_DRY + AVERAGE(ng)%avgv3dN(i,j,k)=AVERAGE(ng)%avgv3dN(i,j,k)* & + & GRID(ng)%vmask_full(i,j) # endif - & OCEAN(ng) % u(:,:,:,Nout), & - & OCEAN(ng) % v(:,:,:,Nout), & - & AVERAGE(ng)%avgu3dE, & - & AVERAGE(ng)%avgv3dN) + END DO + END DO + END DO END IF IF (Aout(idOvel,ng)) THEN @@ -1711,18 +1724,31 @@ SUBROUTINE set_avg_tile (ng, tile, & END DO END IF - IF (Aout(idu3dE,ng).and.Aout(idv3dN,ng)) THEN - CALL uv_rotate3d (ng, tile, .TRUE., .FALSE., & - & LBi, UBi, LBj, UBj, 1, N(ng), & - & GRID(ng) % CosAngler, & - & GRID(ng) % SinAngler, & -# ifdef MASKING - & GRID(ng)%rmask_full, & + IF (Aout(idu3dE,ng)) THEN + DO k=1,N(ng) + DO j=JstrR,JendR + DO i=IstrR,IendR + AVERAGE(ng)%avgu3dE(i,j,k)=AVERAGE(ng)%avgu3dE(i,j,k)+ & +# ifdef WET_DRY + & GRID(ng)%umask_full(i,j)* & # endif - & OCEAN(ng) % u(:,:,:,Nout), & - & OCEAN(ng) % v(:,:,:,Nout), & - & AVERAGE(ng)%avgu3dE, & - & AVERAGE(ng)%avgv3dN) + & OCEAN(ng)%ua(i,j,k) + END DO + END DO + END DO + END IF + IF (Aout(idv3dN,ng)) THEN + DO k=1,N(ng) + DO j=JstrR,JendR + DO i=IstrR,IendR + AVERAGE(ng)%avgv3dN(i,j,k)=AVERAGE(ng)%avgv3dN(i,j,k)+ & +# ifdef WET_DRY + & GRID(ng)%vmask_full(i,j)* & +# endif + & OCEAN(ng)%va(i,j,k) + END DO + END DO + END DO END IF IF (Aout(idOvel,ng)) THEN @@ -3112,14 +3138,12 @@ SUBROUTINE set_avg_tile (ng, tile, & END IF END IF - IF (Aout(idu3dE,ng).and.Aout(idv3dN,ng)) THEN + IF (Aout(idu3dE,ng)) THEN DO k=1,N(ng) - DO j=Jstr,Jend - DO i=Istr,Iend + DO j=JstrR,JendR + DO i=IstrR,IendR AVERAGE(ng)%avgu3dE(i,j,k)=rfac(i,j)* & & AVERAGE(ng)%avgu3dE(i,j,k) - AVERAGE(ng)%avgv3dN(i,j,k)=rfac(i,j)* & - & AVERAGE(ng)%avgv3dN(i,j,k) END DO END DO END DO @@ -3127,15 +3151,34 @@ SUBROUTINE set_avg_tile (ng, tile, & CALL exchange_r3d_tile (ng, tile, & & LBi, UBi, LBj, UBj, 1, N(ng), & & AVERAGE(ng)%avgu3dE) +# ifdef DISTRIBUTE + CALL mp_exchange3d (ng, tile, iNLM, 1, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & AVERAGE(ng)%avgu3dE) +# endif + END IF + END IF + + IF (Aout(idv3dN,ng)) THEN + DO k=1,N(ng) + DO j=JstrR,JendR + DO i=IstrR,IendR + AVERAGE(ng)%avgv3dN(i,j,k)=rfac(i,j)* & + & AVERAGE(ng)%avgv3dN(i,j,k) + END DO + END DO + END DO + IF (EWperiodic(ng).or.NSperiodic(ng)) THEN CALL exchange_r3d_tile (ng, tile, & & LBi, UBi, LBj, UBj, 1, N(ng), & & AVERAGE(ng)%avgv3dN) # ifdef DISTRIBUTE - CALL mp_exchange3d (ng, tile, iNLM, 2, & + CALL mp_exchange3d (ng, tile, iNLM, 1, & & LBi, UBi, LBj, UBj, 1, N(ng), & & NghostPoints, & & EWperiodic(ng), NSperiodic(ng), & - & AVERAGE(ng)%avgu3dE, & & AVERAGE(ng)%avgv3dN) # endif END IF diff --git a/ROMS/Nonlinear/step3d_uv.F b/ROMS/Nonlinear/step3d_uv.F index 33a091b0..c80c1d45 100644 --- a/ROMS/Nonlinear/step3d_uv.F +++ b/ROMS/Nonlinear/step3d_uv.F @@ -15,6 +15,28 @@ MODULE step3d_uv_mod ! an implicit algorithm. ! ! ! !======================================================================= +! + USE mod_param + USE mod_coupling +# ifdef DIAGNOSTICS_UV + USE mod_diags +# endif + USE mod_forces + USE mod_grid + USE mod_mixing + USE mod_ncparam + USE mod_ocean + USE mod_scalars + USE mod_sources +! + USE exchange_2d_mod + USE exchange_3d_mod +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d +# endif + USE uv_var_change_mod, ONLY : uv_C2A_grid + USE u3dbc_mod, ONLY : u3dbc_tile + USE v3dbc_mod, ONLY : v3dbc_tile ! implicit none ! @@ -27,15 +49,6 @@ MODULE step3d_uv_mod SUBROUTINE step3d_uv (ng, tile) !*********************************************************************** ! - USE mod_param - USE mod_coupling -# ifdef DIAGNOSTICS_UV - USE mod_diags -# endif - USE mod_forces - USE mod_grid - USE mod_mixing - USE mod_ocean USE mod_stepping ! ! Imported variable declarations. @@ -158,19 +171,6 @@ SUBROUTINE step3d_uv_tile (ng, tile, & # endif & Huon, Hvom) !*********************************************************************** -! - USE mod_param - USE mod_ncparam - USE mod_scalars - USE mod_sources -! - USE exchange_2d_mod - USE exchange_3d_mod -# ifdef DISTRIBUTE - USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d -# endif - USE u3dbc_mod, ONLY : u3dbc_tile - USE v3dbc_mod, ONLY : v3dbc_tile ! ! Imported variable declarations. ! @@ -1831,6 +1831,14 @@ SUBROUTINE step3d_uv_tile (ng, tile, & & u_stokes(:,:,:), v_stokes(:,:,:)) # endif # endif +! +!----------------------------------------------------------------------- +! Compute 3D momentum (ua, va) at RHO-points (A-Grid) for output +! purposes and data assimilation where the observations and state +! vector is located at the cell-center. +!----------------------------------------------------------------------- +! + CALL uv_C2A_grid (ng, tile, iNLM, nnew) ! RETURN END SUBROUTINE step3d_uv_tile diff --git a/ROMS/Representer/rp_step3d_uv.F b/ROMS/Representer/rp_step3d_uv.F index 8ce1c45b..764ec88b 100644 --- a/ROMS/Representer/rp_step3d_uv.F +++ b/ROMS/Representer/rp_step3d_uv.F @@ -19,6 +19,28 @@ MODULE rp_step3d_uv_mod ! Qsrc ! ! ! !======================================================================= +! + USE mod_param + USE mod_coupling +# ifdef DIAGNOSTICS_UV +!! USE mod_diags +# endif + USE mod_forces + USE mod_grid + USE mod_mixing + USE mod_ncparam + USE mod_ocean + USE mod_scalars + USE mod_sources +! + USE exchange_2d_mod + USE exchange_3d_mod +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d +# endif + USE rp_u3dbc_mod, ONLY : rp_u3dbc_tile + USE rp_v3dbc_mod, ONLY : rp_v3dbc_tile + USE uv_var_change_mod, ONLY : tl_uv_C2A_grid ! implicit none ! @@ -31,15 +53,6 @@ MODULE rp_step3d_uv_mod SUBROUTINE rp_step3d_uv (ng, tile) !*********************************************************************** ! - USE mod_param - USE mod_coupling -# ifdef DIAGNOSTICS_UV -!! USE mod_diags -# endif - USE mod_forces - USE mod_grid - USE mod_mixing - USE mod_ocean USE mod_stepping ! ! Imported variable declarations. @@ -166,19 +179,6 @@ SUBROUTINE rp_step3d_uv_tile (ng, tile, & & Huon, tl_Huon, & & Hvom, tl_Hvom) !*********************************************************************** -! - USE mod_param - USE mod_ncparam - USE mod_scalars - USE mod_sources -! - USE exchange_2d_mod - USE exchange_3d_mod -# ifdef DISTRIBUTE - USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d -# endif - USE rp_u3dbc_mod, ONLY : rp_u3dbc_tile - USE rp_v3dbc_mod, ONLY : rp_v3dbc_tile ! ! Imported variable declarations. ! @@ -2369,6 +2369,17 @@ SUBROUTINE rp_step3d_uv_tile (ng, tile, & & tl_ubar(:,:,1), tl_vbar(:,:,1), & & tl_ubar(:,:,2), tl_vbar(:,:,2)) # endif +! +! +!----------------------------------------------------------------------- +! Compute representer 3D momentum (tl_ua, tl_va) at RHO-points (A-Grid) +! for output purposes and data assimilation where the observations and +! state vector is located at the cell-center. +!----------------------------------------------------------------------- +! +!> CALL uv_C2A_grid (ng, tile, iNLM, nnew) +!> + CALL tl_uv_C2A_grid (ng, tile, iRPM, nnew) ! RETURN END SUBROUTINE rp_step3d_uv_tile diff --git a/ROMS/Tangent/tl_def_his.F b/ROMS/Tangent/tl_def_his.F index ad48d7c3..1c7c2bb4 100644 --- a/ROMS/Tangent/tl_def_his.F +++ b/ROMS/Tangent/tl_def_his.F @@ -67,11 +67,11 @@ SUBROUTINE tl_def_his (ng, ldef) ! SELECT CASE (TLM(ng)%IOtype) CASE (io_nf90) - CALL tl_def_his_nf90 (ng, ldef) + CALL tl_def_his_nf90 (ng, iTLM, ldef) # if defined PIO_LIB && defined DISTRIBUTE CASE (io_pio) - CALL tl_def_his_pio (ng, ldef) + CALL tl_def_his_pio (ng, iTLM, ldef) # endif CASE DEFAULT IF (Master) WRITE (stdout,10) TLM(ng)%IOtype @@ -86,14 +86,14 @@ SUBROUTINE tl_def_his (ng, ldef) END SUBROUTINE tl_def_his ! !*********************************************************************** - SUBROUTINE tl_def_his_nf90 (ng, ldef) + SUBROUTINE tl_def_his_nf90 (ng, model, ldef) !*********************************************************************** ! USE mod_netcdf ! ! Imported variable declarations. ! - integer, intent(in) :: ng + integer, intent(in) :: ng, model ! logical, intent(in) :: ldef ! @@ -160,7 +160,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) !======================================================================= ! DEFINE : IF (ldef) THEN - CALL netcdf_create (ng, iTLM, TRIM(ncname), TLM(ng)%ncid) + CALL netcdf_create (ng, model, TRIM(ncname), TLM(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) THEN IF (Master) WRITE (stdout,30) TRIM(ncname) RETURN @@ -172,155 +172,155 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) ! DimIDs=0 ! - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'xi_rho', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'xi_rho', & & IOBOUNDS(ng)%xi_rho, DimIDs( 1)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'xi_u', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'xi_u', & & IOBOUNDS(ng)%xi_u, DimIDs( 2)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'xi_v', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'xi_v', & & IOBOUNDS(ng)%xi_v, DimIDs( 3)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'xi_psi', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'xi_psi', & & IOBOUNDS(ng)%xi_psi, DimIDs( 4)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'eta_rho', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'eta_rho', & & IOBOUNDS(ng)%eta_rho, DimIDs( 5)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'eta_u', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'eta_u', & & IOBOUNDS(ng)%eta_u, DimIDs( 6)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'eta_v', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'eta_v', & & IOBOUNDS(ng)%eta_v, DimIDs( 7)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'eta_psi', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'eta_psi', & & IOBOUNDS(ng)%eta_psi, DimIDs( 8)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # ifdef ADJUST_BOUNDARY - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'IorJ', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'IorJ', & & IOBOUNDS(ng)%IorJ, IorJdim) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # if defined WRITE_WATER && defined MASKING - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'xy_rho', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'xy_rho', & & IOBOUNDS(ng)%xy_rho, DimIDs(17)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'xy_u', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'xy_u', & & IOBOUNDS(ng)%xy_u, DimIDs(18)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'xy_v', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'xy_v', & & IOBOUNDS(ng)%xy_v, DimIDs(19)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # ifdef SOLVE3D # if defined WRITE_WATER && defined MASKING - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'xyz_rho', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'xyz_rho', & & IOBOUNDS(ng)%xy_rho*N(ng), DimIDs(20)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'xyz_u', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'xyz_u', & & IOBOUNDS(ng)%xy_u*N(ng), DimIDs(21)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'xyz_v', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'xyz_v', & & IOBOUNDS(ng)%xy_v*N(ng), DimIDs(22)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'xyz_w', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'xyz_w', & & IOBOUNDS(ng)%xy_rho*(N(ng)+1), DimIDs(23)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'N', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'N', & & N(ng), DimIDs( 9)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 's_rho', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 's_rho', & & N(ng), DimIDs( 9)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 's_w', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 's_w', & & N(ng)+1, DimIDs(10)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'tracer', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'tracer', & & NT(ng), DimIDs(11)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # ifdef SEDIMENT - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'NST', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'NST', & & NST, DimIDs(32)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'Nbed', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'Nbed', & & Nbed, DimIDs(16)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # if defined WRITE_WATER && defined MASKING - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'xybed', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'xybed', & & IOBOUNDS(ng)%xy_rho*Nbed, DimIDs(24)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # endif # ifdef ECOSIM - status=def_dim(ng, iNLM, TLM(ng)%ncid, ncname, 'Nbands', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'Nbands', & & NBands, DimIDs(33)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'Nphy', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'Nphy', & & Nphy, DimIDs(25)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'Nbac', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'Nbac', & & Nbac, DimIDs(26)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'Ndom', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'Ndom', & & Ndom, DimIDs(27)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'Nfec', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'Nfec', & & Nfec, DimIDs(28)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # endif - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'boundary', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'boundary', & & 4, DimIDs(14)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # ifdef FOUR_DVAR - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'Nstate', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'Nstate', & & NstateVar(ng), DimIDs(29)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # if defined ADJUST_STFLUX || defined ADJUST_WSTRESS - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'frc_adjust', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'frc_adjust', & & Nfrec(ng), DimIDs(30)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # ifdef ADJUST_BOUNDARY - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, 'obc_adjust', & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, 'obc_adjust', & & Nbrec(ng), DimIDs(31)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif - status=def_dim(ng, iTLM, TLM(ng)%ncid, ncname, & + status=def_dim(ng, model, TLM(ng)%ncid, ncname, & & TRIM(ADJUSTL(Vname(5,idtime))), & & nf90_unlimited, DimIDs(12)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -470,7 +470,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) ! Define time-recordless information variables. !----------------------------------------------------------------------- ! - CALL def_info (ng, iTLM, TLM(ng)%ncid, ncname, DimIDs) + CALL def_info (ng, model, TLM(ng)%ncid, ncname, DimIDs) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! !----------------------------------------------------------------------- @@ -485,7 +485,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo( 4)=TRIM(Rclock%calendar) Vinfo(14)=Vname(4,idtime) Vinfo(21)=Vname(6,idtime) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idtime), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idtime), & & NF_TYPE, 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -496,7 +496,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) ! Vinfo( 1)='Ritz_rvalue' Vinfo( 2)='real Ritz eigenvalues' - status=def_var(ng, iTLM, TLM(ng)%ncid, varid, NF_TYPE, & + status=def_var(ng, model, TLM(ng)%ncid, varid, NF_TYPE, & & 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -504,7 +504,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) # if defined FT_EIGENMODES Vinfo( 1)='Ritz_ivalue' Vinfo( 2)='imaginary Ritz eigenvalues' - status=def_var(ng, iTLM, TLM(ng)%ncid, varid, NF_TYPE, & + status=def_var(ng, model, TLM(ng)%ncid, varid, NF_TYPE, & & 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -512,7 +512,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo( 1)='Ritz_norm' Vinfo( 2)='Ritz eigenvectors Euclidean norm' - status=def_var(ng, iTLM, TLM(ng)%ncid, varid, NF_TYPE, & + status=def_var(ng, model, TLM(ng)%ncid, varid, NF_TYPE, & & 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -532,7 +532,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) # endif Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idUsms,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idUsms), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idUsms), & & NF_FOUT, nvd4, u3dfrc, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! @@ -547,7 +547,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) # endif Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idVsms,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idVsms), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idVsms), & & NF_FOUT, nvd4, v3dfrc, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -568,7 +568,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idUsms) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idUsms,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idUsms), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idUsms), & & NF_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -587,7 +587,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idVsms) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idVsms,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idVsms), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idVsms), & & NF_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -614,7 +614,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idTsur(itrc)) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idTsur(itrc),ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, & + status=def_var(ng, model, TLM(ng)%ncid, & & TLM(ng)%Vid(idTsur(itrc)), NF_FOUT, & & nvd3, t2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -646,7 +646,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) # endif Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idTsur(itrc),ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, & + status=def_var(ng, model, TLM(ng)%ncid, & & TLM(ng)%Vid(idTsur(itrc)), NF_FOUT, & & nvd4, t3dfrc, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -669,7 +669,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idpthR) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idpthR,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idpthR), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idpthR), & & NF_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -689,7 +689,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idpthW) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idpthW,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idpthW), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idpthW), & & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -710,7 +710,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idFsur) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idFsur,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idFsur), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idFsur), & # ifdef WET_DRY & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -731,7 +731,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idRzet) Vinfo(22)='coordinates' Aval(5)=REAL(r2dvar,r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idRzet), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idRzet), & & NF_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -749,7 +749,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(16)=Vname(1,idtime) Vinfo(21)=Vname(6,ifield) Aval(5)=REAL(Iinfo(1,ifield,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(ifield), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(ifield), & & NF_FOUT, 4, t2dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -770,7 +770,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idUbar) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idUbar,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idUbar), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idUbar), & & NF_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -788,7 +788,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(22)='coordinates' Aval(5)=REAL(u2dvar,r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idRu2d), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idRu2d), & & NF_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -805,7 +805,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idRuct) Vinfo(22)='coordinates' Aval(5)=REAL(u2dvar,r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idRuct), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idRuct), & & NF_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -821,7 +821,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idUfx1) Vinfo(22)='coordinates' Aval(5)=REAL(u2dvar,r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idUfx1), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idUfx1), & & NF_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -836,7 +836,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idUfx2) Vinfo(22)='coordinates' Aval(5)=REAL(u2dvar,r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idUfx2), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idUfx2), & & NF_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -855,7 +855,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(16)=Vname(1,idtime) Vinfo(21)=Vname(6,ifield) Aval(5)=REAL(Iinfo(1,ifield,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(ifield), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(ifield), & & NF_FOUT, 4, t2dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -876,7 +876,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idVbar) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idVbar,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idVbar), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idVbar), & & NF_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -893,7 +893,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idRv2d) Vinfo(22)='coordinates' Aval(5)=REAL(v2dvar,r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idRv2d), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idRv2d), & & NF_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -910,7 +910,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idRvct) Vinfo(22)='coordinates' Aval(5)=REAL(v2dvar,r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idRvct), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idRvct), & & NF_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -926,7 +926,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idVfx1) Vinfo(22)='coordinates' Aval(5)=REAL(v2dvar,r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idVfx1), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idVfx1), & & NF_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -941,7 +941,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idVfx2) Vinfo(22)='coordinates' Aval(5)=REAL(v2dvar,r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idVfx2), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idVfx2), & & NF_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -960,7 +960,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(16)=Vname(1,idtime) Vinfo(21)=Vname(6,ifield) Aval(5)=REAL(Iinfo(1,ifield,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(ifield), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(ifield), & & NF_FOUT, 4, t2dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -982,7 +982,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idUvel) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idUvel,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idUvel), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idUvel), & & NF_FOUT, nvd4, u3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -998,7 +998,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idRu3d) Vinfo(22)='coordinates' Aval(5)=REAL(u3dvar,r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idRu3d), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idRu3d), & & NF_FOUT, nvd4, u3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -1016,7 +1016,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(16)=Vname(1,idtime) Vinfo(21)=Vname(6,ifield) Aval(5)=REAL(Iinfo(1,ifield,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(ifield), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(ifield), & & NF_FOUT, 5, t3dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1037,7 +1037,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idVvel) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idVvel,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idVvel), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idVvel), & & NF_FOUT, nvd4, v3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1053,7 +1053,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idRv3d) Vinfo(22)='coordinates' Aval(5)=REAL(v3dvar,r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idRv3d), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idRv3d), & & NF_FOUT, nvd4, v3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -1071,13 +1071,51 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(16)=Vname(1,idtime) Vinfo(21)=Vname(6,ifield) Aval(5)=REAL(Iinfo(1,ifield,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(ifield), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(ifield), & & NF_FOUT, 5, t3dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF # endif ! +! Define 3D Eastward momentum at RHO-points, A-grid. +! + IF (Hout(idu3dE,ng)) THEN + Vinfo( 1)=Vname(1,idu3dE) + Vinfo( 2)=Vname(2,idu3dE) + Vinfo( 3)=Vname(3,idu3dE) + Vinfo(14)=Vname(4,idu3dE) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idu3dE) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idu3dE,ng),r8) + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idu3dE), & + & NF_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Northward momentum at RHO-points, A-grid. +! + IF (Hout(idv3dN,ng)) THEN + Vinfo( 1)=Vname(1,idv3dN) + Vinfo( 2)=Vname(2,idv3dN) + Vinfo( 3)=Vname(3,idv3dN) + Vinfo(14)=Vname(4,idv3dN) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idv3dN) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idv3dN,ng),r8) + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idv3dN), & + & NF_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! ! Define tracer type variables. ! DO itrc=1,NT(ng) @@ -1100,7 +1138,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idTvar(itrc)) Vinfo(22)='coordinates' Aval(5)=REAL(r3dvar,r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Tid(itrc), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Tid(itrc), & & NF_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -1126,7 +1164,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) # endif Vinfo(21)=Vname(6,ifield) Aval(5)=REAL(Iinfo(1,ifield,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(ifield), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(ifield),& & NF_FOUT, 5, t3dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1148,7 +1186,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idDano) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idDano,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idDano), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idDano), & & NF_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -1168,7 +1206,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idVvis) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idVvis,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idVvis), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idVvis), & & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1185,7 +1223,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idTdif) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idTdif,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idTdif), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idTdif), & & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1203,7 +1241,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idSdif) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idSdif,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idSdif), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idSdif), & & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1222,7 +1260,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idMtke) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idMtke,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idMtke), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idMtke), & & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1238,7 +1276,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idVmKK) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idVmKK,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idVmKK), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idVmKK), & & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF @@ -1254,7 +1292,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idMtls) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idMtls,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idMtls), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idMtls), & & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1270,7 +1308,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idVmLS) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idVmLS,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idVmLS), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idVmLS), & & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -1286,7 +1324,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) Vinfo(21)=Vname(6,idVmKP) Vinfo(22)='coordinates' Aval(5)=REAL(Iinfo(1,idVmKP,ng),r8) - status=def_var(ng, iTLM, TLM(ng)%ncid, TLM(ng)%Vid(idVmKP), & + status=def_var(ng, model, TLM(ng)%ncid, TLM(ng)%Vid(idVmKP), & & NF_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -1299,14 +1337,14 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) ! Leave definition mode. !----------------------------------------------------------------------- ! - CALL netcdf_enddef (ng, iTLM, ncname, TLM(ng)%ncid) + CALL netcdf_enddef (ng, model, ncname, TLM(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! !----------------------------------------------------------------------- ! Write out time-recordless, information variables. !----------------------------------------------------------------------- ! - CALL wrt_info (ng, iTLM, TLM(ng)%ncid, ncname) + CALL wrt_info (ng, model, TLM(ng)%ncid, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF DEFINE ! @@ -1320,7 +1358,7 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) ! ! Open tangent linear history file for read/write. ! - CALL netcdf_open (ng, iTLM, ncname, 1, TLM(ng)%ncid) + CALL netcdf_open (ng, model, ncname, 1, TLM(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) THEN WRITE (stdout,60) TRIM(ncname) RETURN @@ -1328,13 +1366,13 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) ! ! Inquire about the dimensions and check for consistency. ! - CALL netcdf_check_dim (ng, iTLM, ncname, & + CALL netcdf_check_dim (ng, model, ncname, & & ncid = TLM(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! ! Inquire about the variables. ! - CALL netcdf_inq_var (ng, iTLM, ncname, & + CALL netcdf_inq_var (ng, model, ncname, & & ncid = TLM(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! @@ -1442,6 +1480,12 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) got_var(idSbry(isVvel))=.TRUE. TLM(ng)%Vid(idSbry(isVvel))=var_id(i) # endif + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idu3dE))) THEN + got_var(idu3dE)=.TRUE. + TLM(ng)%Vid(idu3dE)=var_id(i) + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idv3dN))) THEN + got_var(idv3dN)=.TRUE. + TLM(ng)%Vid(idv3dN)=var_id(i) ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idDano))) THEN got_var(idDano)=.TRUE. TLM(ng)%Vid(idDano)=var_id(i) @@ -1674,6 +1718,18 @@ SUBROUTINE tl_def_his_nf90 (ng, ldef) RETURN END IF # endif + IF (.not.got_var(idu3dE).and.Hout(idu3dE,ng)) THEN + IF (Master) WRITE (stdout,70) TRIM(Vname(1,idu3dE)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idv3dN).and.Hout(idv3dN,ng)) THEN + IF (Master) WRITE (stdout,70) TRIM(Vname(1,idv3dN)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF IF (.not.got_var(idDano).and.Hout(idDano,ng)) THEN IF (Master) WRITE (stdout,70) TRIM(Vname(1,idDano)), & & TRIM(ncname) @@ -1889,7 +1945,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) !======================================================================= ! DEFINE : IF (ldef) THEN - CALL pio_netcdf_create (ng, iTLM, TRIM(ncname), TLM(ng)%pioFile) + CALL pio_netcdf_create (ng, model, TRIM(ncname), TLM(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) THEN IF (Master) WRITE (stdout,30) TRIM(ncname) RETURN @@ -1901,104 +1957,104 @@ SUBROUTINE tl_def_his_pio (ng, ldef) ! DimIDs=0 ! - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'xi_rho', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'xi_rho', & & IOBOUNDS(ng)%xi_rho, DimIDs( 1)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'xi_u', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'xi_u', & & IOBOUNDS(ng)%xi_u, DimIDs( 2)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'xi_v', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'xi_v', & & IOBOUNDS(ng)%xi_v, DimIDs( 3)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'xi_psi', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'xi_psi', & & IOBOUNDS(ng)%xi_psi, DimIDs( 4)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'eta_rho', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'eta_rho', & & IOBOUNDS(ng)%eta_rho, DimIDs( 5)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'eta_u', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'eta_u', & & IOBOUNDS(ng)%eta_u, DimIDs( 6)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'eta_v', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'eta_v', & & IOBOUNDS(ng)%eta_v, DimIDs( 7)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'eta_psi', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'eta_psi', & & IOBOUNDS(ng)%eta_psi, DimIDs( 8)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # ifdef ADJUST_BOUNDARY - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'IorJ', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'IorJ', & & IOBOUNDS(ng)%IorJ, IorJdim) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # if defined WRITE_WATER && defined MASKING - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'xy_rho', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'xy_rho', & & IOBOUNDS(ng)%xy_rho, DimIDs(17)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'xy_u', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'xy_u', & & IOBOUNDS(ng)%xy_u, DimIDs(18)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'xy_v', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'xy_v', & & IOBOUNDS(ng)%xy_v, DimIDs(19)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # ifdef SOLVE3D # if defined WRITE_WATER && defined MASKING - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'xyz_rho', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'xyz_rho', & & IOBOUNDS(ng)%xy_rho*N(ng), DimIDs(20)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'xyz_u', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'xyz_u', & & IOBOUNDS(ng)%xy_u*N(ng), DimIDs(21)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'xyz_v', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'xyz_v', & & IOBOUNDS(ng)%xy_v*N(ng), DimIDs(22)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'xyz_w', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'xyz_w', & & IOBOUNDS(ng)%xy_rho*(N(ng)+1), DimIDs(23)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'N', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'N', & & N(ng), DimIDs( 9)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 's_rho', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 's_rho', & & N(ng), DimIDs( 9)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 's_w', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 's_w', & & N(ng)+1, DimIDs(10)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'tracer', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'tracer', & & NT(ng), DimIDs(11)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # ifdef SEDIMENT - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'NST', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'NST', & & NST, DimIDs(32)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'Nbed', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'Nbed', & & Nbed, DimIDs(16)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # if defined WRITE_WATER && defined MASKING - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'xybed', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'xybed', & & IOBOUNDS(ng)%xy_rho*Nbed, DimIDs(24)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -2009,47 +2065,47 @@ SUBROUTINE tl_def_his_pio (ng, ldef) & NBands, DimIDs(33)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'Nphy', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'Nphy', & & Nphy, DimIDs(25)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'Nbac', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'Nbac', & & Nbac, DimIDs(26)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'Ndom', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'Ndom', & & Ndom, DimIDs(27)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'Nfec', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'Nfec', & & Nfec, DimIDs(28)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # endif - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'boundary', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'boundary', & & 4, DimIDs(14)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # ifdef FOUR_DVAR - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'Nstate', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'Nstate', & & NstateVar(ng), DimIDs(29)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # if defined ADJUST_STFLUX || defined ADJUST_WSTRESS - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'frc_adjust', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'frc_adjust',& & Nfrec(ng), DimIDs(30)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif # ifdef ADJUST_BOUNDARY - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, 'obc_adjust', & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, 'obc_adjust',& & Nbrec(ng), DimIDs(31)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif - status=def_dim(ng, iTLM, TLM(ng)%pioFile, ncname, & + status=def_dim(ng, model, TLM(ng)%pioFile, ncname, & & TRIM(ADJUSTL(Vname(5,idtime))), & & nf90_unlimited, DimIDs(12)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2199,7 +2255,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) ! Define time-recordless information variables. !----------------------------------------------------------------------- ! - CALL def_info (ng, iTLM, TLM(ng)%pioFile, ncname, DimIDs) + CALL def_info (ng, model, TLM(ng)%pioFile, ncname, DimIDs) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! !----------------------------------------------------------------------- @@ -2217,7 +2273,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idtime)%dkind=PIO_TOUT TLM(ng)%pioVar(idtime)%gtype=0 ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idtime)%vd, PIO_TOUT, & & 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) @@ -2229,7 +2285,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) ! Vinfo( 1)='Ritz_rvalue' Vinfo( 2)='real Ritz eigenvalues' - status=def_var(ng, iTLM, TLM(ng)%pioFile, varDesc, PIO_TYPE, & + status=def_var(ng, model, TLM(ng)%pioFile, varDesc, PIO_TYPE, & & 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2237,7 +2293,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) # if defined FT_EIGENMODES Vinfo( 1)='Ritz_ivalue' Vinfo( 2)='imaginary Ritz eigenvalues' - status=def_var(ng, iTLM, TLM(ng)%pioFile, varDesc, PIO_TYPE, & + status=def_var(ng, model, TLM(ng)%pioFile, varDesc, PIO_TYPE, & & 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2246,7 +2302,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) Vinfo( 1)='Ritz_norm' Vinfo( 2)='Ritz eigenvectors Euclidean norm' - status=def_var(ng, iTLM, TLM(ng)%pioFile, varDesc, PIO_TYPE, & + status=def_var(ng, model, TLM(ng)%pioFile, varDesc, PIO_TYPE, & & 1, (/recdim/), Aval, Vinfo, ncname, & & SetParAccess = .FALSE.) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2269,7 +2325,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idUsms)%dkind=PIO_FOUT TLM(ng)%pioVar(idUsms)%gtype=u2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idUsms)%vd, & & PIO_FOUT, nvd4, u3dfrc, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2288,7 +2344,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idVsms)%dkind=PIO_FOUT TLM(ng)%pioVar(idVsms)%gtype=v2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idVsms)%vd, & & PIO_FOUT, nvd4, v3dfrc, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2313,7 +2369,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idUsms)%dkind=PIO_FOUT TLM(ng)%pioVar(idUsms)%gtype=u2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idUsms)%vd, & & PIO_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2336,7 +2392,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idVsms)%dkind=PIO_FOUT TLM(ng)%pioVar(idVsms)%gtype=v2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idVsms)%vd, & & PIO_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2367,7 +2423,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idTsur(itrc))%dkind=PIO_FOUT TLM(ng)%pioVar(idTsur(itrc))%gtype=r2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idTsur(itrc))%vd, & & PIO_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2402,7 +2458,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idTsur(itrc))%dkind=PIO_FOUT TLM(ng)%pioVar(idTsur(itrc))%gtype=r2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idTsur(itrc))%vd, & & PIO_FOUT, nvd4, t3dfrc, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2428,7 +2484,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idpthR)%dkind=PIO_FOUT TLM(ng)%pioVar(idpthR)%gtype=r3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idpthR)%vd, & & PIO_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2452,7 +2508,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idpthW)%dkind=PIO_FOUT TLM(ng)%pioVar(idpthW)%gtype=w3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idpthW)%vd, & & PIO_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2477,7 +2533,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idFsur)%dkind=PIO_FOUT TLM(ng)%pioVar(idFsur)%gtype=r2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idFsur)%vd, & # ifdef WET_DRY & PIO_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname, & @@ -2503,7 +2559,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idRzet)%dkind=PIO_FOUT TLM(ng)%pioVar(idRzet)%gtype=r2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idRzet)%vd, & & PIO_FOUT, nvd3, t2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2526,7 +2582,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(ifield)%dkind=PIO_FOUT TLM(ng)%pioVar(ifield)%gtype=r2dobc ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(ifield)%vd, & & PIO_FOUT, 4, t2dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2551,7 +2607,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idUbar)%dkind=PIO_FOUT TLM(ng)%pioVar(idUbar)%gtype=u2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idUbar)%vd, & & PIO_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2573,7 +2629,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idRu2d)%dkind=PIO_FOUT TLM(ng)%pioVar(idRu2d)%gtype=u2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idRu2d)%vd, & & PIO_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2595,7 +2651,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idRuct)%dkind=PIO_FOUT TLM(ng)%pioVar(idRuct)%gtype=u2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idRuct)%vd, & & PIO_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2615,7 +2671,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idUfx1)%dkind=PIO_FOUT TLM(ng)%pioVar(idUfx1)%gtype=u2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idUfx1)%vd, & & PIO_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2634,7 +2690,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idUfx2)%dkind=PIO_FOUT TLM(ng)%pioVar(idUfx2)%gtype=u2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idUfx2)%vd, & & PIO_FOUT, nvd3, u2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2658,7 +2714,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(ifield)%dkind=PIO_FOUT TLM(ng)%pioVar(ifield)%gtype=u2dobc ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(ifield)%vd, & & PIO_FOUT, 4, t2dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2683,7 +2739,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idVbar)%dkind=PIO_FOUT TLM(ng)%pioVar(idVbar)%gtype=v2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idVbar)%vd, & & PIO_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2705,7 +2761,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idRv2d)%dkind=PIO_FOUT TLM(ng)%pioVar(idRv2d)%gtype=v2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idRv2d)%vd, & & PIO_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2727,7 +2783,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idRvct)%dkind=PIO_FOUT TLM(ng)%pioVar(idRvct)%gtype=v2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idRvct)%vd, & & PIO_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2747,7 +2803,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idVfx1)%dkind=PIO_FOUT TLM(ng)%pioVar(idVfx1)%gtype=v2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idVfx1)%vd, & & PIO_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2766,7 +2822,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idVfx2)%dkind=PIO_FOUT TLM(ng)%pioVar(idVfx2)%gtype=v2dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idVfx2)%vd, & & PIO_FOUT, nvd3, v2dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2790,7 +2846,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(ifield)%dkind=PIO_FOUT TLM(ng)%pioVar(ifield)%gtype=v2dobc ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(ifield)%vd, & & PIO_FOUT, 4, t2dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2816,7 +2872,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idUvel)%dkind=PIO_FOUT TLM(ng)%pioVar(idUvel)%gtype=u3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idUvel)%vd, & & PIO_FOUT, nvd4, u3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2837,7 +2893,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idRu3d)%dkind=PIO_FOUT TLM(ng)%pioVar(idRu3d)%gtype=u3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idRu3d)%vd, & & PIO_FOUT, nvd4, u3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2860,7 +2916,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(ifield)%dkind=PIO_FOUT TLM(ng)%pioVar(ifield)%gtype=u3dobc ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(ifield)%vd, & & PIO_FOUT, 5, t3dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2885,7 +2941,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idVvel)%dkind=PIO_FOUT TLM(ng)%pioVar(idVvel)%gtype=v3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idVvel)%vd, & & PIO_FOUT, nvd4, v3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2906,7 +2962,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idRv3d)%dkind=PIO_FOUT TLM(ng)%pioVar(idRv3d)%gtype=v3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idRv3d)%vd, & & PIO_FOUT, nvd4, v3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2929,7 +2985,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(ifield)%dkind=PIO_FOUT TLM(ng)%pioVar(ifield)%gtype=v3dobc ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(ifield)%vd, & & PIO_FOUT, 5, t3dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -2937,6 +2993,52 @@ SUBROUTINE tl_def_his_pio (ng, ldef) END IF # endif ! +! Define 3D Eastward momentum at RHO-points, A-grid. +! + IF (Hout(idu3dE,ng)) THEN + Vinfo( 1)=Vname(1,idu3dE) + Vinfo( 2)=Vname(2,idu3dE) + Vinfo( 3)=Vname(3,idu3dE) + Vinfo(14)=Vname(4,idu3dE) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idu3dE) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idu3dE,ng),r8) + TLM(ng)%pioVar(idu3dE)%dkind=PIO_FOUT + TLM(ng)%pioVar(idu3dE)%gtype=r3dvar +! + status=def_var(ng, model, TLM(ng)%pioFile, & + & TLM(ng)%pioVar(idu3dE)%vd, & + & PIO_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! +! Define 3D Northward momentum at RHO-points, A-grid. +! + IF (Hout(idv3dN,ng)) THEN + Vinfo( 1)=Vname(1,idv3dN) + Vinfo( 2)=Vname(2,idv3dN) + Vinfo( 3)=Vname(3,idv3dN) + Vinfo(14)=Vname(4,idv3dN) + Vinfo(16)=Vname(1,idtime) +# if defined WRITE_WATER && defined MASKING + Vinfo(20)='mask_rho' +# endif + Vinfo(21)=Vname(6,idv3dN) + Vinfo(22)='coordinates' + Aval(5)=REAL(Iinfo(1,idv3dN,ng),r8) + TLM(ng)%pioVar(idv3dN)%dkind=PIO_FOUT + TLM(ng)%pioVar(idv3dN)%gtype=r3dvar +! + status=def_var(ng, model, TLM(ng)%pioFile, & + & TLM(ng)%pioVar(idv3dN)%vd, & + & PIO_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) + IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN + END IF +! ! Define tracer type variables. ! DO itrc=1,NT(ng) @@ -2962,7 +3064,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioTrc(itrc)%dkind=PIO_FOUT TLM(ng)%pioTrc(itrc)%gtype=r3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioTrc(itrc)%vd, & & PIO_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -2993,7 +3095,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(ifield)%dkind=PIO_FOUT TLM(ng)%pioVar(ifield)%gtype=r3dobc ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(ifield)%vd, & & PIO_FOUT, 5, t3dobc, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -3019,7 +3121,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idDano)%dkind=PIO_FOUT TLM(ng)%pioVar(idDano)%gtype=r3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idDano)%vd, & & PIO_FOUT, nvd4, t3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -3043,7 +3145,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idVvis)%dkind=PIO_FOUT TLM(ng)%pioVar(idVvis)%gtype=w3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idVvis)%vd, & & PIO_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -3064,7 +3166,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idTdif)%dkind=PIO_FOUT TLM(ng)%pioVar(idTdif)%gtype=w3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idTdif)%vd, & & PIO_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -3087,7 +3189,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idSdif)%dkind=PIO_FOUT TLM(ng)%pioVar(idSdif)%gtype=w3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idSdif)%vd, & & PIO_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -3110,7 +3212,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idMtke)%dkind=PIO_FOUT TLM(ng)%pioVar(idMtke)%gtype=w3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idMtke)%vd, & & PIO_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -3130,7 +3232,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idVmKK)%dkind=PIO_FOUT TLM(ng)%pioVar(idVmKK)%gtype=w3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idVmKK)%vd, & & PIO_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -3150,7 +3252,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idMtls)%dkind=PIO_FOUT TLM(ng)%pioVar(idMtls)%gtype=w3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idMtls)%vd, & & PIO_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname, & & SetFillVal = .FALSE.) @@ -3170,7 +3272,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idVmLS)%dkind=PIO_FOUT TLM(ng)%pioVar(idVmLS)%gtype=w3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, & + status=def_var(ng, model, TLM(ng)%pioFile, & & TLM(ng)%pioVar(idVmLS)%vd, & & PIO_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN @@ -3191,7 +3293,8 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idVmKP)%dkind=PIO_FOUT TLM(ng)%pioVar(idVmKP)%gtype=w3dvar ! - status=def_var(ng, iTLM, TLM(ng)%pioFile, TLM(ng)%pioVar(idVmKP), & + status=def_var(ng, model, TLM(ng)%pioFile, & + & TLM(ng)%pioVar(idVmKP), & & PIO_FOUT, nvd4, w3dgrd, Aval, Vinfo, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif @@ -3204,14 +3307,14 @@ SUBROUTINE tl_def_his_pio (ng, ldef) ! Leave definition mode. !----------------------------------------------------------------------- ! - CALL pio_netcdf_enddef (ng, iTLM, ncname, TLM(ng)%pioFile) + CALL pio_netcdf_enddef (ng, model, ncname, TLM(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! !----------------------------------------------------------------------- ! Write out time-recordless, information variables. !----------------------------------------------------------------------- ! - CALL wrt_info (ng, iTLM, TLM(ng)%pioFile, ncname) + CALL wrt_info (ng, model, TLM(ng)%pioFile, ncname) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF DEFINE ! @@ -3225,7 +3328,7 @@ SUBROUTINE tl_def_his_pio (ng, ldef) ! ! Open tangent linear history file for read/write. ! - CALL pio_netcdf_open (ng, iTLM, ncname, 1, TLM(ng)%pioFile) + CALL pio_netcdf_open (ng, model, ncname, 1, TLM(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) THEN WRITE (stdout,60) TRIM(ncname) RETURN @@ -3233,13 +3336,13 @@ SUBROUTINE tl_def_his_pio (ng, ldef) ! ! Inquire about the dimensions and check for consistency. ! - CALL pio_netcdf_check_dim (ng, iTLM, ncname, & + CALL pio_netcdf_check_dim (ng, model, ncname, & & pioFile = TLM(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! ! Inquire about the variables. ! - CALL pio_netcdf_inq_var (ng, iTLM, ncname, & + CALL pio_netcdf_inq_var (ng, model, ncname, & & pioFile = TLM(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! @@ -3395,6 +3498,16 @@ SUBROUTINE tl_def_his_pio (ng, ldef) TLM(ng)%pioVar(idSbry(isVvel))%dkind=PIO_FOUT TLM(ng)%pioVar(idSbry(isVvel))%gtype=v3dobc # endif + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idu3dE))) THEN + got_var(idu3dE)=.TRUE. + TLM(ng)%pioVar(idu3dE)%vd=var_desc(i) + TLM(ng)%pioVar(idu3dE)%dkind=PIO_FOUT + TLM(ng)%pioVar(idu3dE)%gtype=r3dvar + ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idv3dN))) THEN + got_var(idv3dN)=.TRUE. + TLM(ng)%pioVar(idv3dN)%vd=var_desc(i) + TLM(ng)%pioVar(idv3dN)%dkind=PIO_FOUT + TLM(ng)%pioVar(idv3dN)%gtype=r3dvar ELSE IF (TRIM(var_name(i)).eq.TRIM(Vname(1,idDano))) THEN got_var(idDano)=.TRUE. TLM(ng)%pioVar(idDano)%vd=var_desc(i) @@ -3655,6 +3768,18 @@ SUBROUTINE tl_def_his_pio (ng, ldef) RETURN END IF # endif + IF (.not.got_var(idu3dE).and.Hout(idu3dE,ng)) THEN + IF (Master) WRITE (stdout,70) TRIM(Vname(1,idu3dE)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF + IF (.not.got_var(idv3dN).and.Hout(idv3dN,ng)) THEN + IF (Master) WRITE (stdout,70) TRIM(Vname(1,idv3dN)), & + & TRIM(ncname) + exit_flag=3 + RETURN + END IF IF (.not.got_var(idDano).and.Hout(idDano,ng)) THEN IF (Master) WRITE (stdout,70) TRIM(Vname(1,idDano)), & & TRIM(ncname) diff --git a/ROMS/Tangent/tl_step3d_uv.F b/ROMS/Tangent/tl_step3d_uv.F index e27de51a..4ffcd024 100644 --- a/ROMS/Tangent/tl_step3d_uv.F +++ b/ROMS/Tangent/tl_step3d_uv.F @@ -19,6 +19,28 @@ MODULE tl_step3d_uv_mod ! Qsrc ! ! ! !======================================================================= +! + USE mod_param + USE mod_coupling +# ifdef DIAGNOSTICS_UV +!! USE mod_diags +# endif + USE mod_forces + USE mod_grid + USE mod_mixing + USE mod_ncparam + USE mod_ocean + USE mod_scalars + USE mod_sources +! + USE exchange_2d_mod + USE exchange_3d_mod +# ifdef DISTRIBUTE + USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d +# endif + USE tl_u3dbc_mod, ONLY : tl_u3dbc_tile + USE tl_v3dbc_mod, ONLY : tl_v3dbc_tile + USE uv_var_change_mod, ONLY : tl_uv_C2A_grid ! implicit none ! @@ -31,15 +53,6 @@ MODULE tl_step3d_uv_mod SUBROUTINE tl_step3d_uv (ng, tile) !*********************************************************************** ! - USE mod_param - USE mod_coupling -# ifdef DIAGNOSTICS_UV -!! USE mod_diags -# endif - USE mod_forces - USE mod_grid - USE mod_mixing - USE mod_ocean USE mod_stepping ! ! Imported variable declarations. @@ -166,19 +179,6 @@ SUBROUTINE tl_step3d_uv_tile (ng, tile, & & Huon, tl_Huon, & & Hvom, tl_Hvom) !*********************************************************************** -! - USE mod_param - USE mod_ncparam - USE mod_scalars - USE mod_sources -! - USE exchange_2d_mod - USE exchange_3d_mod -# ifdef DISTRIBUTE - USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d -# endif - USE tl_u3dbc_mod, ONLY : tl_u3dbc_tile - USE tl_v3dbc_mod, ONLY : tl_v3dbc_tile ! ! Imported variable declarations. ! @@ -2145,6 +2145,16 @@ SUBROUTINE tl_step3d_uv_tile (ng, tile, & & tl_ubar(:,:,1), tl_vbar(:,:,1), & & tl_ubar(:,:,2), tl_vbar(:,:,2)) # endif +! +!----------------------------------------------------------------------- +! Compute tangent linear 3D momentum (tl_ua, tl_va) at RHO-points +! (A-Grid) for output purposes and data assimilation where the +! observations and state vector is located at the cell-center. +!----------------------------------------------------------------------- +! +!> CALL uv_C2A_grid (ng, tile, iNLM, nnew) +!> + CALL tl_uv_C2A_grid (ng, tile, iTLM, nnew) ! RETURN END SUBROUTINE tl_step3d_uv_tile diff --git a/ROMS/Tangent/tl_wrt_his.F b/ROMS/Tangent/tl_wrt_his.F index 485453ee..e66bb730 100644 --- a/ROMS/Tangent/tl_wrt_his.F +++ b/ROMS/Tangent/tl_wrt_his.F @@ -96,7 +96,7 @@ SUBROUTINE tl_wrt_his (ng, tile) ! SELECT CASE (TLM(ng)%IOtype) CASE (io_nf90) - CALL tl_wrt_his_nf90 (ng, tile, & + CALL tl_wrt_his_nf90 (ng, iTLM, tile, & # ifdef ADJUST_BOUNDARY & LBij, UBij, & # endif @@ -104,7 +104,7 @@ SUBROUTINE tl_wrt_his (ng, tile) # if defined PIO_LIB && defined DISTRIBUTE CASE (io_pio) - CALL tl_wrt_his_pio (ng, tile, & + CALL tl_wrt_his_pio (ng, iTLM, tile, & # ifdef ADJUST_BOUNDARY & LBij, UBij, & # endif @@ -123,7 +123,7 @@ SUBROUTINE tl_wrt_his (ng, tile) END SUBROUTINE tl_wrt_his ! !*********************************************************************** - SUBROUTINE tl_wrt_his_nf90 (ng, tile, & + SUBROUTINE tl_wrt_his_nf90 (ng, model, tile, & # ifdef ADJUST_BOUNDARY & LBij, UBij, & # endif @@ -134,7 +134,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & ! ! Imported variable declarations. ! - integer, intent(in) :: ng, tile + integer, intent(in) :: ng, model, tile # ifdef ADJUST_BOUNDARY integer, intent(in) :: LBij, UBij # endif @@ -206,7 +206,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & ELSE Tval(1)=time(ng) END IF - CALL netcdf_put_fvar (ng, iTLM, TLM(ng)%name, & + CALL netcdf_put_fvar (ng, model, TLM(ng)%name, & & TRIM(Vname(1,idtime)), tval, & & (/TLM(ng)%Rindex/), (/1/), & & ncid = TLM(ng)%ncid, & @@ -221,7 +221,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & ! scale=1.0_dp ! m2/s2 gtype=gfactor*u3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idUsms, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idUsms, & & TLM(ng)%Vid(idUsms), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, Nfrec(ng), scale, & @@ -242,7 +242,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & ! scale=1.0_dp ! m2/s2 gtype=gfactor*v3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idVsms, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idVsms, & & TLM(ng)%Vid(idVsms), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, Nfrec(ng), scale, & @@ -269,7 +269,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Lstflux(itrc,ng)) THEN scale=1.0_dp ! kinematic flux units gtype=gfactor*r3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idTsur(itrc), & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idTsur(itrc), & & TLM(ng)%Vid(idTsur(itrc)), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, Nfrec(ng), scale, & @@ -296,7 +296,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idUsms,ng)) THEN scale=1.0_dp gtype=gfactor*u2dvar - status=nf_fwrite2d(ng, iTLM, TLM(ng)%ncid, idUsms, & + status=nf_fwrite2d(ng, model, TLM(ng)%ncid, idUsms, & & TLM(ng)%Vid(idUsms), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -319,7 +319,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idVsms,ng)) THEN scale=1.0_dp gtype=gfactor*v2dvar - status=nf_fwrite2d(ng, iTLM, TLM(ng)%ncid, idVsms, & + status=nf_fwrite2d(ng, model, TLM(ng)%ncid, idVsms, & & TLM(ng)%Vid(idVsms), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -345,7 +345,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idTsur(itrc),ng)) THEN scale=1.0_dp gtype=gfactor*r2dvar - status=nf_fwrite2d(ng, iTLM, TLM(ng)%ncid, idTsur(itrc), & + status=nf_fwrite2d(ng, model, TLM(ng)%ncid, idTsur(itrc), & & TLM(ng)%Vid(idTsur(itrc)), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -373,7 +373,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idpthR,ng)) THEN scale=1.0_dp gtype=gfactor*r3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idpthR, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idpthR, & & TLM(ng)%Vid(idpthR), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -397,7 +397,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idpthW,ng)) THEN scale=1.0_dp gtype=gfactor*w3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idpthW, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idpthW, & & TLM(ng)%Vid(idpthW), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -422,7 +422,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idFsur,ng)) THEN scale=1.0_dp gtype=gfactor*r2dvar - status=nf_fwrite2d(ng, iTLM, TLM(ng)%ncid, idFsur, & + status=nf_fwrite2d(ng, model, TLM(ng)%ncid, idFsur, & & TLM(ng)%Vid(idFsur), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -450,7 +450,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & # if defined FORWARD_WRITE && defined FORWARD_RHS ! - status=nf_fwrite2d(ng, iTLM, TLM(ng)%ncid, idRzet, & + status=nf_fwrite2d(ng, model, TLM(ng)%ncid, idRzet, & & TLM(ng)%Vid(idRzet), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -475,7 +475,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & ! IF (ANY(Lobc(:,isFsur,ng))) THEN scale=1.0_dp - status=nf_fwrite2d_bry(ng, iTLM, TLM(ng)%name, TLM(ng)%ncid, & + status=nf_fwrite2d_bry(ng, model, TLM(ng)%name, TLM(ng)%ncid, & & Vname(1,idSbry(isFsur)), & & TLM(ng)%Vid(idSbry(isFsur)), & & TLM(ng)%Rindex, r2dvar, & @@ -499,7 +499,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idUbar,ng)) THEN scale=1.0_dp gtype=gfactor*u2dvar - status=nf_fwrite2d(ng, iTLM, TLM(ng)%ncid, idUbar, & + status=nf_fwrite2d(ng, model, TLM(ng)%ncid, idUbar, & & TLM(ng)%Vid(idUbar), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -523,7 +523,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & # ifdef FORWARD_WRITE # ifdef FORWARD_RHS ! - status=nf_fwrite2d(ng, iTLM, TLM(ng)%ncid, idRu2d, & + status=nf_fwrite2d(ng, model, TLM(ng)%ncid, idRu2d, & & TLM(ng)%Vid(idRu2d), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -543,7 +543,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & # ifdef SOLVE3D # ifdef FORWARD_RHS ! - status=nf_fwrite2d(ng, iTLM, TLM(ng)%ncid, idRuct, & + status=nf_fwrite2d(ng, model, TLM(ng)%ncid, idRuct, & & TLM(ng)%Vid(idRuct), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -561,7 +561,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & END IF # endif ! - status=nf_fwrite2d(ng, iTLM, TLM(ng)%ncid, idUfx1, & + status=nf_fwrite2d(ng, model, TLM(ng)%ncid, idUfx1, & & TLM(ng)%Vid(idUfx1), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -578,7 +578,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & RETURN END IF ! - status=nf_fwrite2d(ng, iTLM, TLM(ng)%ncid, idUfx2, & + status=nf_fwrite2d(ng, model, TLM(ng)%ncid, idUfx2, & & TLM(ng)%Vid(idUfx2), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -604,7 +604,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & ! IF (ANY(Lobc(:,isUbar,ng))) THEN scale=1.0_dp - status=nf_fwrite2d_bry(ng, iTLM, TLM(ng)%name, TLM(ng)%ncid, & + status=nf_fwrite2d_bry(ng, model, TLM(ng)%name, TLM(ng)%ncid, & & Vname(1,idSbry(isUbar)), & & TLM(ng)%Vid(idSbry(isUbar)), & & TLM(ng)%Rindex, u2dvar, & @@ -628,7 +628,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idVbar,ng)) THEN scale=1.0_dp gtype=gfactor*v2dvar - status=nf_fwrite2d(ng, iTLM, TLM(ng)%ncid, idVbar, & + status=nf_fwrite2d(ng, model, TLM(ng)%ncid, idVbar, & & TLM(ng)%Vid(idVbar), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -652,7 +652,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & # ifdef FORWARD_WRITE # ifdef FORWARD_RHS ! - status=nf_fwrite2d(ng, iTLM, TLM(ng)%ncid, idRv2d, & + status=nf_fwrite2d(ng, model, TLM(ng)%ncid, idRv2d, & & TLM(ng)%Vid(idRv2d), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -672,7 +672,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & # ifdef SOLVE3D # ifdef FORWARD_RHS ! - status=nf_fwrite2d(ng, iTLM, TLM(ng)%ncid, idRvct, & + status=nf_fwrite2d(ng, model, TLM(ng)%ncid, idRvct, & & TLM(ng)%Vid(idRvct), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -690,7 +690,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & END IF # endif ! - status=nf_fwrite2d(ng, iTLM, TLM(ng)%ncid, idVfx1, & + status=nf_fwrite2d(ng, model, TLM(ng)%ncid, idVfx1, & & TLM(ng)%Vid(idVfx1), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -707,7 +707,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & RETURN END IF ! - status=nf_fwrite2d(ng, iTLM, TLM(ng)%ncid, idVfx2, & + status=nf_fwrite2d(ng, model, TLM(ng)%ncid, idVfx2, & & TLM(ng)%Vid(idVfx2), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & @@ -733,7 +733,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & ! IF (ANY(Lobc(:,isVbar,ng))) THEN scale=1.0_dp - status=nf_fwrite2d_bry(ng, iTLM, TLM(ng)%name, TLM(ng)%ncid, & + status=nf_fwrite2d_bry(ng, model, TLM(ng)%name, TLM(ng)%ncid, & & Vname(1,idSbry(isVbar)), & & TLM(ng)%Vid(idSbry(isVbar)), & & TLM(ng)%Rindex, v2dvar, & @@ -758,7 +758,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idUvel,ng)) THEN scale=1.0_dp gtype=gfactor*u3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idUvel, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idUvel, & & TLM(ng)%Vid(idUvel), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -781,7 +781,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & # if defined FORWARD_WRITE && defined FORWARD_RHS ! - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idRu3d, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idRu3d, & & TLM(ng)%Vid(idRu3d), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -806,7 +806,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & ! IF (ANY(Lobc(:,isUvel,ng))) THEN scale=1.0_dp - status=nf_fwrite3d_bry(ng, iTLM, TLM(ng)%name, TLM(ng)%ncid, & + status=nf_fwrite3d_bry(ng, model, TLM(ng)%name, TLM(ng)%ncid, & & Vname(1,idSbry(isUvel)), & & TLM(ng)%Vid(idSbry(isUvel)), & & TLM(ng)%Rindex, u3dvar, & @@ -830,7 +830,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idVvel,ng)) THEN scale=1.0_dp gtype=gfactor*v3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idVvel, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idVvel, & & TLM(ng)%Vid(idVvel), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -853,7 +853,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & # if defined FORWARD_WRITE && defined FORWARD_RHS ! - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idRv3d, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idRv3d, & & TLM(ng)%Vid(idRv3d), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -878,7 +878,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & ! IF (ANY(Lobc(:,isVvel,ng))) THEN scale=1.0_dp - status=nf_fwrite3d_bry(ng, iTLM, TLM(ng)%name, TLM(ng)%ncid, & + status=nf_fwrite3d_bry(ng, model, TLM(ng)%name, TLM(ng)%ncid, & & Vname(1,idSbry(isVvel)), & & TLM(ng)%Vid(idSbry(isVvel)), & & TLM(ng)%Rindex, v3dvar, & @@ -897,13 +897,57 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & END IF # endif ! +! Write out 3D Eastward momentum (m/s) at RHO-points, A-grid. +! + IF (Hout(idu3dE,ng)) THEN + scale=1.0_dp + gtype=gfactor*r3dvar + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idu3dE, & + & TLM(ng)%Vid(idu3dE), & + & TLM(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask_full, & +# endif + & OCEAN(ng) % tl_ua) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idu3dE)), TLM(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 3D Northward momentum (m/s) at RHO-points, A-grid. +! + IF (Hout(idv3dN,ng)) THEN + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idv3dN, & + & TLM(ng)%Vid(idv3dN), & + & TLM(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask_full, & +# endif + & OCEAN(ng) % tl_va) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idv3dN)), TLM(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! ! Write out tracer type variables. ! DO itrc=1,NT(ng) IF (Hout(idTvar(itrc),ng)) THEN scale=1.0_dp gtype=gfactor*r3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idTvar(itrc), & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idTvar(itrc), & & TLM(ng)%Tid(itrc), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -934,7 +978,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & DO itrc=1,NT(ng) IF (ANY(Lobc(:,isTvar(itrc),ng))) THEN scale=1.0_dp - status=nf_fwrite3d_bry(ng, iTLM, TLM(ng)%name, TLM(ng)%ncid, & + status=nf_fwrite3d_bry(ng, model, TLM(ng)%name, TLM(ng)%ncid, & & Vname(1,idSbry(isTvar(itrc))), & & TLM(ng)%Vid(idSbry(isTvar(itrc))), & & TLM(ng)%Rindex, r3dvar, & @@ -960,7 +1004,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idDano,ng)) THEN scale=1.0_dp gtype=gfactor*r3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idDano, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idDano, & & TLM(ng)%Vid(idDano), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -987,7 +1031,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idVvis,ng)) THEN scale=1.0_dp gtype=gfactor*w3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idVvis, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idVvis, & & TLM(ng)%Vid(idVvis), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -1015,7 +1059,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idTdif,ng)) THEN scale=1.0_dp gtype=gfactor*w3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idTdif, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idTdif, & & TLM(ng)%Vid(idTdif), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -1045,7 +1089,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idSdif,ng)) THEN scale=1.0_dp gtype=gfactor*w3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idSdif, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idSdif, & & TLM(ng)%Vid(idSdif), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -1075,7 +1119,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idMtke,ng)) THEN scale=1.0_dp gtype=gfactor*w3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idMtke, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idMtke, & & TLM(ng)%Vid(idMtke), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -1095,7 +1139,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & ! scale=1.0_dp gtype=gfactor*w3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idVmKK, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idVmKK, & & TLM(ng)%Vid(idVmKK), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -1118,7 +1162,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & IF (Hout(idMtls,ng)) THEN scale=1.0_dp gtype=gfactor*w3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idMtls, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idMtls, & & TLM(ng)%Vid(idMtls), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -1138,7 +1182,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & ! scale=1.0_dp gtype=gfactor*w3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idVmLS, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idVmLS, & & TLM(ng)%Vid(idVmLS), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -1158,7 +1202,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & # ifdef GSL_MIXING scale=1.0_dp gtype=gfactor*w3dvar - status=nf_fwrite3d(ng, iTLM, TLM(ng)%ncid, idVmKP, & + status=nf_fwrite3d(ng, model, TLM(ng)%ncid, idVmKP, & & TLM(ng)%Vid(idVmKP), & & TLM(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -1185,7 +1229,7 @@ SUBROUTINE tl_wrt_his_nf90 (ng, tile, & ! to access data immediately after it is written. !----------------------------------------------------------------------- ! - CALL netcdf_sync (ng, iTLM, TLM(ng)%name, TLM(ng)%ncid) + CALL netcdf_sync (ng, model, TLM(ng)%name, TLM(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! 10 FORMAT (2x,'TL_WRT_HIS_NF90 - writing history', t42, & @@ -1211,7 +1255,7 @@ END SUBROUTINE tl_wrt_his_nf90 # if defined PIO_LIB && defined DISTRIBUTE ! !*********************************************************************** - SUBROUTINE tl_wrt_his_pio (ng, tile, & + SUBROUTINE tl_wrt_his_pio (ng, model, tile, & # ifdef ADJUST_BOUNDARY & LBij, UBij, & # endif @@ -1222,7 +1266,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ! ! Imported variable declarations. ! - integer, intent(in) :: ng, tile + integer, intent(in) :: ng, model, tile # ifdef ADJUST_BOUNDARY integer, intent(in) :: LBij, UBij # endif @@ -1287,7 +1331,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ELSE Tval(1)=time(ng) END IF - CALL pio_netcdf_put_fvar (ng, iTLM, TLM(ng)%name, & + CALL pio_netcdf_put_fvar (ng, model, TLM(ng)%name, & & TRIM(Vname(1,idtime)), tval, & & (/TLM(ng)%Rindex/), (/1/), & & pioFile = TLM(ng)%pioFile, & @@ -1307,7 +1351,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u2dfrc(ng) END IF ! - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idUsms, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idUsms, & & TLM(ng)%pioVar(idUsms), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, Nfrec(ng), scale, & @@ -1333,7 +1377,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v2dfrc(ng) END IF ! - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idVsms, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idVsms, & & TLM(ng)%pioVar(idVsms), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, Nfrec(ng), scale, & @@ -1365,7 +1409,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_r2dfrc(ng) END IF ! - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idTsur(itrc), & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idTsur(itrc), & & TLM(ng)%pioVar(idTsur(itrc)), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, Nfrec(ng), scale, & @@ -1397,7 +1441,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u2dvar(ng) END IF ! - status=nf_fwrite2d(ng, iTLM, TLM(ng)%pioFile, idUsms, & + status=nf_fwrite2d(ng, model, TLM(ng)%pioFile, idUsms, & & TLM(ng)%pioVar(idUsms), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1425,7 +1469,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v2dvar(ng) END IF ! - status=nf_fwrite2d(ng, iTLM, TLM(ng)%pioFile, idVsms, & + status=nf_fwrite2d(ng, model, TLM(ng)%pioFile, idVsms, & & TLM(ng)%pioVar(idVsms), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1456,7 +1500,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_r2dvar(ng) END IF ! - status=nf_fwrite2d(ng, iTLM, TLM(ng)%pioFile, idTsur(itrc), & + status=nf_fwrite2d(ng, model, TLM(ng)%pioFile, idTsur(itrc), & & TLM(ng)%pioVar(idTsur(itrc)), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1488,7 +1532,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ELSE ioDesc => ioDesc_sp_r3dvar(ng) END IF - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idpthR, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idpthR, & & TLM(ng)%pioVar(idpthR), & & TLM(ng)%Rindex, & & ioDesc, & @@ -1517,7 +1561,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ELSE ioDesc => ioDesc_sp_w3dvar(ng) END IF - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idpthW, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idpthW, & & TLM(ng)%pioVar(idpthW), & & TLM(ng)%Rindex, & & ioDesc, & @@ -1548,7 +1592,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_r2dvar(ng) END IF - status=nf_fwrite2d(ng, iTLM, TLM(ng)%pioFile, idFsur, & + status=nf_fwrite2d(ng, model, TLM(ng)%pioFile, idFsur, & & TLM(ng)%pioVar(idFsur), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1582,7 +1626,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_r2dvar(ng) END IF - status=nf_fwrite2d(ng, iTLM, TLM(ng)%pioFile, idRzet, & + status=nf_fwrite2d(ng, model, TLM(ng)%pioFile, idRzet, & & TLM(ng)%pioVar(idRzet), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1614,7 +1658,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_r2dobc(ng) END IF ! - status=nf_fwrite2d_bry(ng, iTLM, TLM(ng)%name, & + status=nf_fwrite2d_bry(ng, model, TLM(ng)%name, & & TLM(ng)%pioFile, & & Vname(1,ifield), & & TLM(ng)%pioVar(ifield), & @@ -1643,7 +1687,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u2dvar(ng) END IF - status=nf_fwrite2d(ng, iTLM, TLM(ng)%pioFile, idUbar, & + status=nf_fwrite2d(ng, model, TLM(ng)%pioFile, idUbar, & & TLM(ng)%pioVar(idUbar), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1673,7 +1717,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u2dvar(ng) END IF - status=nf_fwrite2d(ng, iTLM, TLM(ng)%pioFile, idRu2d, & + status=nf_fwrite2d(ng, model, TLM(ng)%pioFile, idRu2d, & & TLM(ng)%pioVar(idRu2d), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1699,7 +1743,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u2dvar(ng) END IF - status=nf_fwrite2d(ng, iTLM, TLM(ng)%pioFile, idRuct, & + status=nf_fwrite2d(ng, model, TLM(ng)%pioFile, idRuct, & & TLM(ng)%pioVar(idRuct), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1723,7 +1767,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u2dvar(ng) END IF - status=nf_fwrite2d(ng, iTLM, TLM(ng)%pioFile, idUfx1, & + status=nf_fwrite2d(ng, model, TLM(ng)%pioFile, idUfx1, & & TLM(ng)%pioVar(idUfx1), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1746,7 +1790,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u2dvar(ng) END IF - status=nf_fwrite2d(ng, iTLM, TLM(ng)%pioFile, idUfx2, & + status=nf_fwrite2d(ng, model, TLM(ng)%pioFile, idUfx2, & & TLM(ng)%pioVar(idUfx2), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1779,7 +1823,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u2dobc(ng) END IF - status=nf_fwrite2d_bry(ng, iTLM, TLM(ng)%name, & + status=nf_fwrite2d_bry(ng, model, TLM(ng)%name, & & TLM(ng)%pioFile, & & Vname(1,ifield), & & TLM(ng)%pioVar(ifield), & @@ -1808,7 +1852,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v2dvar(ng) END IF - status=nf_fwrite2d(ng, iTLM, TLM(ng)%pioFile, idVbar, & + status=nf_fwrite2d(ng, model, TLM(ng)%pioFile, idVbar, & & TLM(ng)%pioVar(idVbar), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1838,7 +1882,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v2dvar(ng) END IF - status=nf_fwrite2d(ng, iTLM, TLM(ng)%pioFile, idRv2d, & + status=nf_fwrite2d(ng, model, TLM(ng)%pioFile, idRv2d, & & TLM(ng)%pioVar(idRv2d), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1864,7 +1908,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v2dvar(ng) END IF - status=nf_fwrite2d(ng, iTLM, TLM(ng)%pioFile, idRvct, & + status=nf_fwrite2d(ng, model, TLM(ng)%pioFile, idRvct, & & TLM(ng)%pioVar(idRvct), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1888,7 +1932,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v2dvar(ng) END IF - status=nf_fwrite2d(ng, iTLM, TLM(ng)%pioFile, idVfx1, & + status=nf_fwrite2d(ng, model, TLM(ng)%pioFile, idVfx1, & & TLM(ng)%pioVar(idVfx1), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1911,7 +1955,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v2dvar(ng) END IF - status=nf_fwrite2d(ng, iTLM, TLM(ng)%pioFile, idVfx2, & + status=nf_fwrite2d(ng, model, TLM(ng)%pioFile, idVfx2, & & TLM(ng)%pioVar(idVfx2), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, scale, & @@ -1944,7 +1988,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v2dobc(ng) END IF ! - status=nf_fwrite2d_bry(ng, iTLM, TLM(ng)%name, & + status=nf_fwrite2d_bry(ng, model, TLM(ng)%name, & & TLM(ng)%pioFile, & & Vname(1,ifield), & & TLM(ng)%pioVar(ifield), & @@ -1974,7 +2018,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u3dvar(ng) END IF - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idUvel, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idUvel, & & TLM(ng)%pioVar(idUvel), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -2003,7 +2047,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u3dvar(ng) END IF - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idRu3d, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idRu3d, & & TLM(ng)%pioVar(idRu3d), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -2035,7 +2079,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_u3dobc(ng) END IF ! - status=nf_fwrite3d_bry(ng, iTLM, TLM(ng)%name, & + status=nf_fwrite3d_bry(ng, model, TLM(ng)%name, & & TLM(ng)%pioFile, & & Vname(1,ifield), & & TLM(ng)%pioVar(ifield), & @@ -2064,7 +2108,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v3dvar(ng) END IF - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idVvel, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idVvel, & & TLM(ng)%pioVar(idVvel), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -2093,7 +2137,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v3dvar(ng) END IF - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idRv3d, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idRv3d, & & TLM(ng)%pioVar(idRv3d), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -2125,7 +2169,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_v3dobc(ng) END IF ! - status=nf_fwrite3d_bry(ng, iTLM, TLM(ng)%name, & + status=nf_fwrite3d_bry(ng, model, TLM(ng)%name, & & TLM(ng)%pioFile, & & Vname(1,ifield), & & TLM(ng)%pioVar(ifield), & @@ -2144,6 +2188,61 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & END IF # endif ! +! Write out 3D Eastward momentum (m/s) at RHO-points, A-grid +! + IF (Hout(idu3dE,ng)) THEN + scale=1.0_dp + IF (TLM(ng)%pioVar(idu3dE)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r3dvar(ng) + ELSE + ioDesc => ioDesc_sp_r3dvar(ng) + END IF + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idu3dE, & + & TLM(ng)%pioVar(idu3dE), & + & TLM(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask_full, & +# endif + & OCEAN(ng) % tl_ua) + IF (FoundError(status, PIO_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idu3dE)), TLM(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out 3D Northward momentum (m/s) at RHO-points, A-grid +! + IF (Hout(idv3dN,ng)) THEN + IF (TLM(ng)%pioVar(idV3dN)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r3dvar(ng) + ELSE + ioDesc => ioDesc_sp_r3dvar(ng) + END IF + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idv3dN, & + & TLM(ng)%pioVar(idv3dN), & + & TLM(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +# ifdef MASKING + & GRID(ng) % rmask_full, & +# endif + & OCEAN(ng) % tl_va) + IF (FoundError(status, PIO_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idv3dN)), TLM(ng)%Rindex + END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! ! Write out tracer type variables. ! DO itrc=1,NT(ng) @@ -2155,7 +2254,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_r3dvar(ng) END IF - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idTvar(itrc), & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idTvar(itrc), & & TLM(ng)%pioTrc(itrc), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -2193,7 +2292,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_r3dobc(ng) END IF ! - status=nf_fwrite3d_bry(ng, iTLM, TLM(ng)%name, & + status=nf_fwrite3d_bry(ng, model, TLM(ng)%name, & & TLM(ng)%pioFile, & & Vname(1,ifield), & & TLM(ng)%pioVar(ifield), & @@ -2224,7 +2323,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_r3dvar(ng) END IF ! - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idDano, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idDano, & & TLM(ng)%pioVar(idDano), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & @@ -2256,7 +2355,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_w3dvar(ng) END IF ! - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idVvis, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idVvis, & & TLM(ng)%pioVar(idVvis), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -2289,7 +2388,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_w3dvar(ng) END IF ! - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idTdif, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idTdif, & & TLM(ng)%pioVar(idTdif), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -2324,7 +2423,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_w3dvar(ng) END IF - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idSdif, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idSdif, & & TLM(ng)%pioVar(idSdif), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -2359,7 +2458,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_w3dvar(ng) END IF - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idMtke, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idMtke, & & TLM(ng)%pioVar(idMtke), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -2384,7 +2483,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_w3dvar(ng) END IF - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idVmKK, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idVmKK, & & TLM(ng)%pioVar(idVmKK), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -2412,7 +2511,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_w3dvar(ng) END IF - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idMtls, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idMtls, & & TLM(ng)%pioVar(idMtls), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -2437,7 +2536,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_w3dvar(ng) END IF - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idVmLS, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idVmLS, & & TLM(ng)%pioVar(idVmLS), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -2463,7 +2562,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ioDesc => ioDesc_sp_w3dvar(ng) END IF - status=nf_fwrite3d(ng, iTLM, TLM(ng)%pioFile, idVmKP, & + status=nf_fwrite3d(ng, model, TLM(ng)%pioFile, idVmKP, & & TLM(ng)%pioVar(idVmKP), & & TLM(ng)%Rindex, ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & @@ -2490,7 +2589,7 @@ SUBROUTINE tl_wrt_his_pio (ng, tile, & ! to access data immediately after it is written. !----------------------------------------------------------------------- ! - CALL pio_netcdf_sync (ng, iTLM, TLM(ng)%name, TLM(ng)%pioFile) + CALL pio_netcdf_sync (ng, model, TLM(ng)%name, TLM(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! 10 FORMAT (2x,'TL_WRT_HIS_PIO - writing history', t42, & diff --git a/ROMS/Utility/CMakeLists.txt b/ROMS/Utility/CMakeLists.txt index 285e1ae2..7dddd500 100644 --- a/ROMS/Utility/CMakeLists.txt +++ b/ROMS/Utility/CMakeLists.txt @@ -170,6 +170,7 @@ list( APPEND _files ROMS/Utility/time_corr.F ROMS/Utility/timers.F ROMS/Utility/uv_rotate.F + ROMS/Utility/uv_var_change.F ROMS/Utility/vorticity.F ROMS/Utility/white_noise.F ROMS/Utility/wpoints.F diff --git a/ROMS/Utility/def_his.F b/ROMS/Utility/def_his.F index a89a8db6..c233c68b 100644 --- a/ROMS/Utility/def_his.F +++ b/ROMS/Utility/def_his.F @@ -1108,7 +1108,7 @@ SUBROUTINE def_his_nf90 (ng, model, ldef) END IF # endif ! -! Define 3D Eastward momentum component at RHO-points. +! Define 3D Eastward momentum at RHO-points, A-grid. ! IF (Hout(idu3dE,ng)) THEN Vinfo( 1)=Vname(1,idu3dE) @@ -1127,7 +1127,7 @@ SUBROUTINE def_his_nf90 (ng, model, ldef) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF ! -! Define 3D Northward momentum component at RHO-points. +! Define 3D Northward momentum at RHO-points, A-grid. ! IF (Hout(idv3dN,ng)) THEN Vinfo( 1)=Vname(1,idv3dN) @@ -3893,7 +3893,7 @@ SUBROUTINE def_his_pio (ng, model, ldef) END IF # endif ! -! Define 3D Eastward momentum component at RHO-points. +! Define 3D Eastward momentum at RHO-points, A-grid. ! IF (Hout(idu3dE,ng)) THEN Vinfo( 1)=Vname(1,idu3dE) @@ -3916,7 +3916,7 @@ SUBROUTINE def_his_pio (ng, model, ldef) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN END IF ! -! Define 3D Northward momentum component at RHO-points. +! Define 3D Northward momentum at RHO-points, A-grid. ! IF (Hout(idv3dN,ng)) THEN Vinfo( 1)=Vname(1,idv3dN) diff --git a/ROMS/Utility/uv_var_change.F b/ROMS/Utility/uv_var_change.F new file mode 100644 index 00000000..72860982 --- /dev/null +++ b/ROMS/Utility/uv_var_change.F @@ -0,0 +1,1104 @@ +#include "cppdefs.h" + MODULE uv_var_change_mod +#ifdef SOLVE3D +! +!git $Id$ +!======================================================================= +! Copyright (c) 2002-2024 The ROMS/TOMS Group ! +! Licensed under a MIT/X style license ! +! See License_ROMS.md Hernan G. Arango ! +!======================================================================= +! ! +! These routines are used for ocean current variable changes from ! +! C-grid to A-grid and vice versa. It is done for output purposes ! +! and data assimilation where the state vector is located at the ! +! cell-center (Arakawa A-grid). ! +! ! +! * If transforming vector components from C-grid to A-grid, rotate ! +! to geographical Eastward and Northward directions. ! +! ! +! Ur(i,j,k) = 0.5 * [u(i,j,k,ninp) + u(i+1,j,k,ninp)] i=Istr:Iend ! +! Vr(i,j,k) = 0.5 * [v(i,j,k,ninp) + v(i,j+1,k,ninp)] j=Jstr:Jend ! +! ! +! Apply lateral boundary conditions (gradient) via 'bc_r3d_tile' ! +! ! +! ua(i,j,k) = Ur(i,j,k) * CosAngler(i,j) - Vr(i,j,k) * SinAngler(i,j) ! +! va(i,j,k) = Vr(i,j,k) * CosAngler(i,j) + Ur(i,j,k) * SinAngler(i,j) ! +! ! +! PUBLIC: uv_C2A_grid, ad_uv_C2A_grid, tl_uv_C2A_grid ! +! PRIVATE: uv_C2A_grid_tile, ad_uv_C2A_grid_tile, tl_uv_C2A_grid_tile ! +! ! +! * If transforming vector components from A-grid to C-grid, rotate ! +! to computational XI and ETA directions. ! +! ! +! Ur(i,j,k) = ua(i,j,k) * CosAngler(i,j) + va(i,j,k) * SinAngler(i,j) ! +! Vr(i,j,k) = va(i,j,k) * CosAngler(i,j) - ua(i,j,k) * SinAngler(i,j) ! +! ! +! u(i,j,k,nout) = 0.5 * [Ur(i-1,j,k) + Ur(i,j,k)] i=Istr:IendR ! +! v(i,j,k Urho(i,j)=0.5_r8*(u(i,j,k,ninp)+u(i+1,j,k,ninp)) +!> + tl_Urho(i,j)=0.5_r8*(tl_u(i,j,k,ninp)+tl_u(i+1,j,k,ninp)) + IF (.not.EWperiodic(ng)) THEN + IF (DOMAIN(ng)%Western_Edge(tile)) THEN +!> Urho(Istr-1,j)=Urho(Istr,j) +!> + tl_Urho(Istr-1,j)=tl_Urho(Istr,j) + END IF + IF (DOMAIN(ng)%Eastern_Edge(tile)) THEN +!> Urho(Iend+1,j)=Urho(Iend,j) +!> + tl_Urho(Iend+1,j)=tl_Urho(Iend,j) + END IF + END IF + END DO + END DO +! + DO j=Jstr,Jend + DO i=IstrR,IendR +!> Vrho(i,j)=0.5_r8*(v(i,j,k,ninp)+v(i,j+1,k,ninp)) +!> + tl_Vrho(i,j)=0.5_r8*(tl_v(i,j,k,ninp)+tl_v(i,j+1,k,ninp)) + IF (.not.NSperiodic(ng)) THEN + IF (DOMAIN(ng)%Southern_Edge(tile)) THEN +!> Vrho(i,Jstr-1) = Vrho(i,Jstr) +!> + tl_Vrho(i,Jstr-1) = tl_Vrho(i,Jstr) + END IF + IF (DOMAIN(ng)%Northern_Edge(tile)) THEN +!> Vrho(i,Jend+1) = Vrho(i,Jend) +!> + tl_Vrho(i,Jend+1) = tl_Vrho(i,Jend) + END IF + END IF + END DO + END DO +! +! Rotate from computational to gegraphical Eastward and Northward +! directions. +! + DO j=JstrR,JendR + DO i=IstrR,IendR +!> ua(i,j,k)=Urho(i,j)*CosAngler(i,j)- & +!> & Vrho(i,j)*SinAngler(i,j) +!> + tl_ua(i,j,k)=tl_Urho(i,j)*CosAngler(i,j)- & + & tl_Vrho(i,j)*SinAngler(i,j) +!> va(i,j,k)=Vrho(i,j)*CosAngler(i,j)+ & +!> & Urho(i,j)*SinAngler(i,j) +!> + tl_va(i,j,k)=tl_Vrho(i,j)*CosAngler(i,j)+ & + & tl_Urho(i,j)*SinAngler(i,j) +# ifdef MASKING +!> ua(i,j,k)=ua(i,j,k)*rmask(i,j) +!> + tl_ua(i,j,k)=tl_ua(i,j,k)*rmask(i,j) +!> va(i,j,k)=va(i,j,k)*rmask(i,j) +!> + tl_va(i,j,k)=tl_va(i,j,k)*rmask(i,j) +# endif + END DO + END DO + END DO K_LOOP + +# ifdef DISTRIBUTE +! +! Exchange boundary data. +! +!> CALL mp_exchange3d (ng, tile, model, 2, & +!> & LBi, UBi, LBj, UBj, 1, N(ng), & +!> & NghostPoints, & +!> & EWperiodic(ng), NSperiodic(ng), & +!> & ua, va) +!> + CALL mp_exchange3d (ng, tile, model, 2, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & tl_ua, tl_va) +# endif +! + RETURN + END SUBROUTINE tl_uv_C2A_grid_tile +! +!*********************************************************************** + SUBROUTINE tl_uv_A2C_grid (ng, tile, model, nout) +!*********************************************************************** +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile, model, nout +! +! Local variable declarations. +! + character (len=*), parameter :: MyFile = & + & __FILE__ +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, model, 34, __LINE__, MyFile) +# endif + CALL tl_uv_A2C_grid_tile (ng, tile, model, nout, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & +# ifdef MASKING + & GRID(ng) % umask_full, & + & GRID(ng) % vmask_full, & +# endif + & GRID(ng) % CosAngler, & + & GRID(ng) % SinAngler, & + & OCEAN(ng) % tl_ua, & + & OCEAN(ng) % tl_va, & + & OCEAN(ng) % tl_u, & + & OCEAN(ng) % tl_v) +# ifdef PROFILE + CALL wclock_off (ng, model, 34, __LINE__, MyFile) +# endif +! + RETURN + END SUBROUTINE tl_uv_A2C_grid +! +!*********************************************************************** + SUBROUTINE tl_uv_A2C_grid_tile (ng, tile, model, nout, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & +# ifdef MASKING + & umask, vmask, & +# endif + & CosAngler, SinAngler, & + & tl_ua, tl_va, tl_u, tl_v) +!*********************************************************************** +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile, model, nout + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS +! +# ifdef ASSUMED_SHAPE + real(r8), intent(in) :: CosAngler(LBi:,LBj:) + real(r8), intent(in) :: SinAngler(LBi:,LBj:) +# ifdef MASKING + real(r8), intent(in) :: umask(LBi:,LBj:) + real(r8), intent(in) :: vmask(LBi:,LBj:) +# endif + real(r8), intent(in) :: tl_ua(LBi:,LBj:,:) + real(r8), intent(in) :: tl_va(LBi:,LBj:,:) + + real(r8), intent(inout) :: tl_u(LBi:,LBj:,:,:) + real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:) +# else + real(r8), intent(in) :: CosAngler(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: SinAngler(LBi:UBi,LBj:UBj) +# ifdef MASKING + real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj) +# endif + real(r8), intent(in) :: tl_ua(LBi:UBi,LBj:UBj,N(ng)) + real(r8), intent(in) :: tl_va(LBi:UBi,LBj:UBj,N(ng)) + + real(r8), intent(inout) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2) + real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2) +# endif +! +! Local variable declarations. +! + integer :: i, j, k +! + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_Urho, tl_Vrho + +# include "set_bounds.h" +! +!----------------------------------------------------------------------- +! Transform vector components from A-grid to C-grid. +!----------------------------------------------------------------------- +! + K_LOOP : DO k=1,N(ng) +! +! Rotate vector components to computational (XI,ETA) directions. +! + DO j=Jstr-1,JendR + DO i=Istr-1,IendR +!> Urho(i,j)=ua(i,j,k)*CosAngler(i,j)+ & +!> & va(i,j,k)*SinAngler(i,j) +!> + tl_Urho(i,j)=tl_ua(i,j,k)*CosAngler(i,j)+ & + & tl_va(i,j,k)*SinAngler(i,j) +!> Vrho(i,j)=va(i,j,k)*CosAngler(i,j)- & +!> & ua(i,j,k)*SinAngler(i,j) +!> + tl_Vrho(i,j)=tl_va(i,j,k)*CosAngler(i,j)- & + & tl_ua(i,j,k)*SinAngler(i,j) + END DO + END DO +! +! Compute staggered C-grid components. +! + DO j=JstrR,JendR + DO i=Istr,IstrR +!> u(i,j,k,nout)=0.5_r8*(Urho(i-1,j)+Urho(i,j)) +!> + tl_u(i,j,k,nout)=0.5_r8*(tl_Urho(i-1,j)+tl_Urho(i,j)) +# ifdef MASKING +!> u(i,j,k,nout)=u(i,j,k,nout)*umask(i,j) +!> + tl_u(i,j,k,nout)=tl_u(i,j,k,nout)*umask(i,j) +# endif + END DO + END DO +! + DO j=Jstr,JendR + DO i=IstrR,IendR +!> v(i,j,k,nout)=0.5_r8*(Vrho(i,j-1)+Vrho(i,j)) +!> + tl_v(i,j,k,nout)=0.5_r8*(tl_Vrho(i,j-1)+tl_Vrho(i,j)) +# ifdef MASKING +!> v(i,j,k,nout)=v(i,j,k,nout)*vmask(i,j) +!> + tl_v(i,j,k,nout)=tl_v(i,j,k,nout)*vmask(i,j) +# endif + END DO + END DO + END DO K_LOOP + +# ifdef DISTRIBUTE +! +! Exchange boundary data. +! +!> CALL mp_exchange3d (ng, tile, model, 2, & +!> & LBi, UBi, LBj, UBj, 1, N(ng), & +!> & NghostPoints, & +!> & EWperiodic(ng), NSperiodic(ng), & +!> & u(:,:,:,nout), v(:,:,:,nout)) +!> + CALL mp_exchange3d (ng, tile, model, 2, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & tl_u(:,:,:,nout), tl_v(:,:,:,nout)) +# endif +! + RETURN + END SUBROUTINE tl_uv_A2C_grid_tile +# endif + +# ifdef ADJOINT +! +!*********************************************************************** + SUBROUTINE ad_uv_C2A_grid (ng, tile, model, ninp) +!*********************************************************************** +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile, model, ninp +! +! Local variable declarations. +! + character (len=*), parameter :: MyFile = & + & __FILE__ +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, model, 34, __LINE__, MyFile) +# endif + CALL ad_uv_C2A_grid_tile (ng, tile, model, ninp, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & +# ifdef MASKING + & GRID(ng) % rmask_full, & +# endif + & GRID(ng) % CosAngler, & + & GRID(ng) % SinAngler, & + & OCEAN(ng) % ad_u, & + & OCEAN(ng) % ad_v, & + & OCEAN(ng) % ad_ua, & + & OCEAN(ng) % ad_va) +# ifdef PROFILE + CALL wclock_off (ng, model, 34, __LINE__, MyFile) +# endif +! + RETURN + END SUBROUTINE ad_uv_C2A_grid +! +!*********************************************************************** + SUBROUTINE ad_uv_C2A_grid_tile (ng, tile, model, ninp, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & +# ifdef MASKING + & rmask, & +# endif + & CosAngler, SinAngler, & + & ad_u, ad_v, ad_ua, ad_va) +!*********************************************************************** +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile, model, ninp + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS +! +# ifdef ASSUMED_SHAPE + real(r8), intent(in) :: CosAngler(LBi:,LBj:) + real(r8), intent(in) :: SinAngler(LBi:,LBj:) +# ifdef MASKING + real(r8), intent(in) :: rmask(LBi:,LBj:) +# endif + real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:) + real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:) + + real(r8), intent(inout) :: ad_ua(LBi:,LBj:,:) + real(r8), intent(inout) :: ad_va(LBi:,LBj:,:) +# else + real(r8), intent(in) :: CosAngler(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: SinAngler(LBi:UBi,LBj:UBj) +# ifdef MASKING + real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj) +# endif + real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2) + real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2) + + real(r8), intent(inout) :: ad_ua(LBi:UBi,LBj:UBj,N(ng)) + real(r8), intent(inout) :: tl_va(LBi:UBi,LBj:UBj,N(ng)) +# endif +! +! Local variable declarations. +! + integer :: i, j, k +! + real(r8) :: adfac, adfac1, adfac2 + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ad_Urho, ad_Vrho + +# include "set_bounds.h" +! +!----------------------------------------------------------------------- +! Adjoint of transform vector components from C-grid to A-grid. +!----------------------------------------------------------------------- +! +! Initialize. +! + adfac=0.0_r8 + adfac1=0.0_r8 + adfac2=0.0_r8 + ad_Urho=0.0_r8 + ad_Vrho=0.0_r8 + +# ifdef DISTRIBUTE +! +! Adjoint of exchange boundary data. +! +!> CALL mp_exchange3d (ng, tile, model, 2, & +!> & LBi, UBi, LBj, UBj, 1, N(ng), & +!> & NghostPoints, & +!> & EWperiodic(ng), NSperiodic(ng), & +!> & tl_ua, tl_va) +!> + CALL ad_mp_exchange3d (ng, tile, model, 2, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & ad_ua, ad_va) +# endif +! +! Adjoint of variable change from C-grid to A-grid. +! + K_LOOP : DO k=1,N(ng) +! +! Adjoint of rotate from computational to gegraphical Eastward and +! Northward directions. +! + DO j=JstrR,JendR + DO i=IstrR,IendR +# ifdef MASKING +!> tl_va(i,j,k)=tl_va(i,j,k)*rmask(i,j) +!> + ad_va(i,j,k)=ad_va(i,j,k)*rmask(i,j) +!> tl_ua(i,j,k)=tl_ua(i,j,k)*rmask(i,j) +!> + ad_ua(i,j,k)=ad_ua(i,j,k)*rmask(i,j) +# endif +!> tl_va(i,j,k)=tl_Vrho(i,j)*CosAngler(i,j)+ & +!> & tl_Urho(i,j)*SinAngler(i,j) +!> + adfac1=CosAngler(i,j)*ad_va(i,j,k) + adfac2=SinAngler(i,j)*ad_va(i,j,k) + ad_Vrho(i,j)=ad_Vrho(i,j)+adfac1 + ad_Urho(i,j)=ad_Urho(i,j)+adfac2 + ad_va(i,j,k)=0.0_r8 +!> tl_ua(i,j,k)=tl_Urho(i,j)*CosAngler(i,j) & +!> & tl_Vrho(i,j)*SinAngler(i,j) +!> + adfac1=CosAngler(i,j)*ad_ua(i,j,k) + adfac2=SinAngler(i,j)*ad_ua(i,j,k) + ad_Urho=ad_Urho+adfac1 + ad_Vrho=ad_Vrho-adfac2 + ad_ua(i,j,k)=0.0_r8 + END DO + END DO +! +! Adjoint of compute A-grid (cell center) vector components. +! + DO j=Jstr,Jend + DO i=IstrR,IendR + IF (.not.NSperiodic(ng)) THEN + IF (DOMAIN(ng)%Northern_Edge(tile)) THEN +!> tl_Vrho(i,Jend+1)=tl_Vrho(i,Jend) +!> + ad_Vrho(i,Jend)=ad_Vrho(i,Jend)+ad_Vrho(i,Jend+1) + END IF + IF (DOMAIN(ng)%Southern_Edge(tile)) THEN +!> tl_Vrho(i,Jstr-1)=tl_Vrho(i,Jstr) +!> + ad_Vrho(i,Jstr)=ad_Vrho(i,Jstr)+ad_Vrho(i,Jstr-1) + END IF + END IF +!> tl_Vrho(i,j)=0.5_r8*(tl_v(i,j,k,ninp)+tl_v(i,j+1,k,ninp)) +!> + adfac=0.5_r8*ad_Vrho(i,j) + ad_v(i,j ,k,ninp)=ad_v(i,j ,k,ninp)+adfac + ad_v(i,j+1,k,ninp)=ad_v(i,j+1,k,ninp)+adfac + ad_Vrho(i,j)=0.0_r8 + END DO + END DO +! + DO j=JstrR,JendR + DO i=Istr,Iend + IF (.not.EWperiodic(ng)) THEN + IF (DOMAIN(ng)%Eastern_Edge(tile)) THEN +!> tl_Urho(Iend+1,j)=tl_Urho(Iend,j) +!> + ad_Urho(Iend,j)=ad_Urho(Iend,j)+ad_Urho(Iend+1,j) + END IF + IF (DOMAIN(ng)%Western_Edge(tile)) THEN +!> tl_Urho(Istr-1,j)=tl_Urho(Istr,j) +!> + ad_Urho(Istr,j)=ad_Urho(Istr,j)+ad_Urho(Istr-1,j) + END IF + END IF +!> tl_Urho(i,j)=0.5_r8*(tl_u(i,j,k,ninp)+tl_u(i+1,j,k,ninp)) +!> + adfac=0.5_r8*ad_Urho(i,j) + ad_u(i ,j,k,ninp)=ad_u(i ,j,k,ninp)+adfac + ad_u(i+1,j,k,ninp)=AD_u(i+1,j,k,ninp)+adfac + ad_Urho(i,j)=0.0_r8 + END DO + END DO + END DO K_LOOP +! + RETURN + END SUBROUTINE ad_uv_C2A_grid_tile +! +!*********************************************************************** + SUBROUTINE ad_uv_A2C_grid (ng, tile, model, nout) +!*********************************************************************** +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile, model, nout +! +! Local variable declarations. +! + character (len=*), parameter :: MyFile = & + & __FILE__ +! +# include "tile.h" +! +# ifdef PROFILE + CALL wclock_on (ng, model, 34, __LINE__, MyFile) +# endif + CALL ad_uv_A2C_grid_tile (ng, tile, model, nout, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & +# ifdef MASKING + & GRID(ng) % umask, & + & GRID(ng) % vmask, & +# endif + & GRID(ng) % CosAngler, & + & GRID(ng) % SinAngler, & + & OCEAN(ng) % ad_ua, & + & OCEAN(ng) % ad_va, & + & OCEAN(ng) % ad_u, & + & OCEAN(ng) % ad_v) +# ifdef PROFILE + CALL wclock_off (ng, model, 34, __LINE__, MyFile) +# endif +! + RETURN + END SUBROUTINE ad_uv_A2C_grid +! +!*********************************************************************** + SUBROUTINE ad_uv_A2C_grid_tile (ng, tile, model, nout, & + & LBi, UBi, LBj, UBj, & + & IminS, ImaxS, JminS, JmaxS, & +# ifdef MASKING + & umask, vmask, & +# endif + & CosAngler, SinAngler, & + & ad_ua, ad_va, ad_u, ad_v) +!*********************************************************************** +! +! Imported variable declarations. +! + integer, intent(in) :: ng, tile, model, nout + integer, intent(in) :: LBi, UBi, LBj, UBj + integer, intent(in) :: IminS, ImaxS, JminS, JmaxS +! +# ifdef ASSUMED_SHAPE + real(r8), intent(in) :: CosAngler(LBi:,LBj:) + real(r8), intent(in) :: SinAngler(LBi:,LBj:) +# ifdef MASKING + real(r8), intent(in) :: umask(LBi:,LBj:) + real(r8), intent(in) :: vmask(LBi:,LBj:) +# endif + real(r8), intent(inout) :: ad_ua(LBi:,LBj:,:) + real(r8), intent(inout) :: ad_va(LBi:,LBj:,:) + + real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:) + real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:) +# else + real(r8), intent(in) :: CosAngler(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: SinAngler(LBi:UBi,LBj:UBj) +# ifdef MASKING + real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj) + real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj) +# endif + real(r8), intent(inout) :: ad_ua(LBi:UBi,LBj:UBj,N(ng)) + real(r8), intent(inout) :: ad_va(LBi:UBi,LBj:UBj,N(ng)) + + real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2) + real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2) +# endif +! +! Local variable declarations. +! + integer :: i, j, k +! + real(r8) :: adfac, adfac1, adfac2 +! + real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: ad_Urho, ad_Vrho + +# include "set_bounds.h" +! +!----------------------------------------------------------------------- +! Adjoint of transform vector components from A-grid to C-grid. +!----------------------------------------------------------------------- +! +! Initialize. +! + adfac=0.0_r8 + adfac1=0.0_r8 + adfac2=0.0_r8 + ad_Urho=0.0_r8 + ad_Vrho=0.0_r8 + +# ifdef DISTRIBUTE +! +! Adjoint of exchange boundary data. +! +!> CALL mp_exchange3d (ng, tile, model, 2, & +!> & LBi, UBi, LBj, UBj, 1, N(ng), & +!> & NghostPoints, & +!> & EWperiodic(ng), NSperiodic(ng), & +!> & tl_u(:,:,:,nout), tl_v(:,:,:,nout)) +!> + CALL ad_mp_exchange3d (ng, tile, model, 2, & + & LBi, UBi, LBj, UBj, 1, N(ng), & + & NghostPoints, & + & EWperiodic(ng), NSperiodic(ng), & + & ad_u(:,:,:,nout), ad_v(:,:,:,nout)) +# endif +! +! Adjoint of variable change from A-grid to C-grid. +! + K_LOOP :DO k=1,N(ng) +! +! Adjoint of compute staggered C-grid components. +! + DO j=Jstr,JendR + DO i=IstrR,IendR +# ifdef MASKING +!> tl_v(i,j,k,nout)=tl_v(i,j,k,nout)*vmask(i,j) +!> + ad_v(i,j,k,nout)=ad_v(i,j,k,nout)*vmask(i,j) +# endif +!> tl_v(i,j,k,nout)=0.5_r8*(tl_Vrho(i,j-1)+tl_Vrho(i,j)) +!> + adfac=0.5_r8*ad_v(i,j,k,nout) + ad_Vrho(i,j-1)=ad_Vrho(i,j-1)+adfac + ad_Vrho(i,j )=ad_Vrho(i,j )+adfac + ad_v(i,j,k,nout)=0.0_r8 + END DO + END DO +! + DO j=JstrR,JendR + DO i=Istr,IendR +# ifdef MASKING +!> tl_u(i,j,k,nout)=tl_u(i,j,k,nout)*umask(i,j) +!> + ad_u(i,j,k,nout)=ad_u(i,j,k,nout)*umask(i,j) +# endif +!> tl_u(i,j,k,nout)=0.5_r8*(tl_Urho(i-1,j)+tl_Urho(i,j)) +!> + adfac=0.5_r8*ad_u(i,j,k,nout) + ad_Urho(i-1,j)=ad_Urho(i-1,j)+adfac + ad_Urho(i ,j)=ad_Urho(i ,j)+adfac + ad_u(i,j,k,nout)=0.0_r8 + END DO + END DO +! +! Adjoint of rotate vector components to computations (XI,ETA) +! directions. +! + DO j=Jstr-1,JendR + DO i=Istr-1,IendR +!> tl_Vrho(i,j)=tl_va(i,j,k)*CosAngler(i,j)- & +!> & tl_ua(i,j,k)*SinAngler(i,j) +!> + adfac1=CosAngler(i,j)*ad_Vrho(i,j) + adfac2=SinAngler(i,j)*ad_Vrho(i,j) + ad_va(i,j,k)=ad_va(i,j,k)+adfac1 + ad_ua(i,j,k)=ad_ua(i,j,k)-adfac2 + ad_Vrho(i,j)=0.0_r8 +!> tl_Urho(i,j)=tl_ua(i,j,k)*CosAngler(i,j)+ & +!> & tl_va(i,j,k)*SinAngler(i,j) +!> + adfac1=CosAngler(i,j)*ad_Urho(i,j) + adfac2=SinAngler(i,j)*ad_Urho(i,j) + ad_ua(i,j,k)=ad_ua(i,j,k)+adfac1 + ad_va(i,j,k)=ad_va(i,j,k)+adfac2 + ad_Urho(i,j)=0.0_r8 + END DO + END DO + END DO K_LOOP +! + RETURN + END SUBROUTINE ad_uv_A2C_grid_tile +# endif +#endif + END MODULE uv_var_change_mod diff --git a/ROMS/Utility/wrt_his.F b/ROMS/Utility/wrt_his.F index 9866ec77..4d1ecaa6 100644 --- a/ROMS/Utility/wrt_his.F +++ b/ROMS/Utility/wrt_his.F @@ -182,8 +182,6 @@ SUBROUTINE wrt_his_nf90 (ng, model, tile, & real(r8), allocatable :: Ur2d(:,:) real(r8), allocatable :: Vr2d(:,:) #ifdef SOLVE3D - real(r8), allocatable :: Ur3d(:,:,:) - real(r8), allocatable :: Vr3d(:,:,:) real(r8), allocatable :: Wr3d(:,:,:) #endif ! @@ -947,29 +945,9 @@ SUBROUTINE wrt_his_nf90 (ng, model, tile, & END IF # endif ! -! Write out 3D Eastward and Northward momentum components (m/s) at -! RHO-points. -! - IF (Hout(idu3dE,ng).and.Hout(idv3dN,ng)) THEN - IF (.not.allocated(Ur3d)) THEN - allocate (Ur3d(LBi:UBi,LBj:UBj,N(ng))) - Ur3d(LBi:UBi,LBj:UBj,1:N(ng))=0.0_r8 - END IF - IF (.not.allocated(Vr3d)) THEN - allocate (Vr3d(LBi:UBi,LBj:UBj,N(ng))) - Vr3d(LBi:UBi,LBj:UBj,1:N(ng))=0.0_r8 - END IF - CALL uv_rotate3d (ng, tile, .FALSE., .TRUE., & - & LBi, UBi, LBj, UBj, 1, N(ng), & - & GRID(ng) % CosAngler, & - & GRID(ng) % SinAngler, & -# ifdef MASKING - & GRID(ng) % rmask_full, & -# endif - & OCEAN(ng) % u(:,:,:,NOUT), & - & OCEAN(ng) % v(:,:,:,NOUT), & - & Ur3d, Vr3d) +! Write out 3D Eastward momentum (m/s) at RHO-points, A-grid. ! + IF (Hout(idu3dE,ng)) THEN scale=1.0_dp gtype=gfactor*r3dvar status=nf_fwrite3d(ng, model, HIS(ng)%ncid, idu3dE, & @@ -979,7 +957,7 @@ SUBROUTINE wrt_his_nf90 (ng, model, tile, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif - & Ur3d) + & OCEAN(ng) % ua) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idu3dE)), HIS(ng)%Rindex @@ -988,7 +966,11 @@ SUBROUTINE wrt_his_nf90 (ng, model, tile, & ioerror=status RETURN END IF - + END IF +! +! Write out 3D Northward momentum (m/s) at RHO-points, A-grid. +! + IF (Hout(idv3dN,ng)) THEN status=nf_fwrite3d(ng, model, HIS(ng)%ncid, idv3dN, & & HIS(ng)%Vid(idv3dN), & & HIS(ng)%Rindex, gtype, & @@ -996,7 +978,7 @@ SUBROUTINE wrt_his_nf90 (ng, model, tile, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif - & Vr3d) + & OCEAN(ng) % va) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idv3dN)), HIS(ng)%Rindex @@ -1005,8 +987,6 @@ SUBROUTINE wrt_his_nf90 (ng, model, tile, & ioerror=status RETURN END IF - deallocate (Ur3d) - deallocate (Vr3d) END IF ! ! Write out S-coordinate omega vertical velocity (m/s). @@ -2012,8 +1992,6 @@ SUBROUTINE wrt_his_pio (ng, model, tile, & real(r8), allocatable :: Ur2d(:,:) real(r8), allocatable :: Vr2d(:,:) # ifdef SOLVE3D - real(r8), allocatable :: Ur3d(:,:,:) - real(r8), allocatable :: Vr3d(:,:,:) real(r8), allocatable :: Wr3d(:,:,:) # endif ! @@ -2968,29 +2946,9 @@ SUBROUTINE wrt_his_pio (ng, model, tile, & END IF # endif ! -! Write out 3D Eastward and Northward momentum components (m/s) at -! RHO-points. -! - IF (Hout(idu3dE,ng).and.Hout(idv3dN,ng)) THEN - IF (.not.allocated(Ur3d)) THEN - allocate (Ur3d(LBi:UBi,LBj:UBj,N(ng))) - Ur3d(LBi:UBi,LBj:UBj,1:N(ng))=0.0_r8 - END IF - IF (.not.allocated(Vr3d)) THEN - allocate (Vr3d(LBi:UBi,LBj:UBj,N(ng))) - Vr3d(LBi:UBi,LBj:UBj,1:N(ng))=0.0_r8 - END IF - CALL uv_rotate3d (ng, tile, .FALSE., .TRUE., & - & LBi, UBi, LBj, UBj, 1, N(ng), & - & GRID(ng) % CosAngler, & - & GRID(ng) % SinAngler, & -# ifdef MASKING - & GRID(ng) % rmask_full, & -# endif - & OCEAN(ng) % u(:,:,:,NOUT), & - & OCEAN(ng) % v(:,:,:,NOUT), & - & Ur3d, Vr3d) +! Write out 3D Eastward momentum (m/s) at RHO-points, A-grid ! + IF (Hout(idu3dE,ng)) THEN scale=1.0_dp IF (HIS(ng)%pioVar(idu3dE)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_r3dvar(ng) @@ -3005,7 +2963,7 @@ SUBROUTINE wrt_his_pio (ng, model, tile, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif - & Ur3d) + & OCEAN(ng) % ua) IF (FoundError(status, PIO_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idu3dE)), HIS(ng)%Rindex @@ -3014,7 +2972,11 @@ SUBROUTINE wrt_his_pio (ng, model, tile, & ioerror=status RETURN END IF + END IF +! +! Write out 3D Eastward momentum (m/s) at RHO-points, A-grid ! + IF (Hout(idv3dN,ng)) THEN IF (HIS(ng)%pioVar(idV3dN)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_r3dvar(ng) ELSE @@ -3028,7 +2990,7 @@ SUBROUTINE wrt_his_pio (ng, model, tile, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif - & Vr3d) + & OCEAN(ng) % va) IF (FoundError(status, PIO_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idv3dN)), HIS(ng)%Rindex @@ -3037,8 +2999,6 @@ SUBROUTINE wrt_his_pio (ng, model, tile, & ioerror=status RETURN END IF - deallocate (Ur3d) - deallocate (Vr3d) END IF ! ! Write out S-coordinate omega vertical velocity (m/s). diff --git a/ROMS/Utility/wrt_quick.F b/ROMS/Utility/wrt_quick.F index f1255aba..4eeea971 100644 --- a/ROMS/Utility/wrt_quick.F +++ b/ROMS/Utility/wrt_quick.F @@ -155,8 +155,6 @@ SUBROUTINE wrt_quick_nf90 (ng, model, tile, & real(r8), allocatable :: Ur2d(:,:) real(r8), allocatable :: Vr2d(:,:) #ifdef SOLVE3D - real(r8), allocatable :: Ur3d(:,:,:) - real(r8), allocatable :: Vr3d(:,:,:) real(r8), allocatable :: Wr3d(:,:,:) #endif ! @@ -648,112 +646,92 @@ SUBROUTINE wrt_quick_nf90 (ng, model, tile, & END IF END IF ! -! Write out 3D Eastward and Northward momentum components (m/s) at -! RHO-points. -! - IF ((Qout(idu3dE,ng).and.Qout(idv3dN,ng)).or. & - & (Qout(idUsuE,ng).and.Qout(idVsuN,ng))) THEN - IF (.not.allocated(Ur3d)) THEN - allocate (Ur3d(LBi:UBi,LBj:UBj,N(ng))) - Ur3d(LBi:UBi,LBj:UBj,1:N(ng))=0.0_r8 - END IF - IF (.not.allocated(Vr3d)) THEN - allocate (Vr3d(LBi:UBi,LBj:UBj,N(ng))) - Vr3d(LBi:UBi,LBj:UBj,1:N(ng))=0.0_r8 - END IF - CALL uv_rotate3d (ng, tile, .FALSE., .TRUE., & - & LBi, UBi, LBj, UBj, 1, N(ng), & - & GRID(ng) % CosAngler, & - & GRID(ng) % SinAngler, & -# ifdef MASKING - & GRID(ng) % rmask_full, & -# endif - & OCEAN(ng) % u(:,:,:,NOUT), & - & OCEAN(ng) % v(:,:,:,NOUT), & - & Ur3d, Vr3d) +! Write out 3D Eastward momentum (m/s) at RHO-points, A-grid. ! - IF ((Qout(idu3dE,ng).and.Qout(idv3dN,ng))) THEN - scale=1.0_dp - gtype=gfactor*r3dvar - status=nf_fwrite3d(ng, model, QCK(ng)%ncid, idu3dE, & - & QCK(ng)%Vid(idu3dE), & - & QCK(ng)%Rindex, gtype, & - & LBi, UBi, LBj, UBj, 1, N(ng), scale, & + IF (Qout(idu3dE,ng)) THEN + scale=1.0_dp + gtype=gfactor*r3dvar + status=nf_fwrite3d(ng, model, QCK(ng)%ncid, idu3dE, & + & QCK(ng)%Vid(idu3dE), & + & QCK(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING - & GRID(ng) % rmask_full, & + & GRID(ng) % rmask_full, & # endif - & Ur3d) - IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN - IF (Master) THEN - WRITE (stdout,20) TRIM(Vname(1,idu3dE)), QCK(ng)%Rindex - END IF - exit_flag=3 - ioerror=status - RETURN + & OCEAN(ng) % ua) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idu3dE)), QCK(ng)%Rindex END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF ! - status=nf_fwrite3d(ng, model, QCK(ng)%ncid, idv3dN, & - & QCK(ng)%Vid(idv3dN), & - & QCK(ng)%Rindex, gtype, & - & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +! Write out 3D Northward momentum (m/s) at RHO-points, A-grid. +! + IF (Qout(idv3dN,ng)) THEN + status=nf_fwrite3d(ng, model, QCK(ng)%ncid, idv3dN, & + & QCK(ng)%Vid(idv3dN), & + & QCK(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING - & GRID(ng) % rmask_full, & + & GRID(ng) % rmask_full, & # endif - & Vr3d) - IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN - IF (Master) THEN - WRITE (stdout,20) TRIM(Vname(1,idv3dN)), QCK(ng)%Rindex - END IF - exit_flag=3 - ioerror=status - RETURN + & OCEAN(ng) % va) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idv3dN)), QCK(ng)%Rindex END IF - deallocate (Ur3d) - deallocate (Vr3d) + exit_flag=3 + ioerror=status + RETURN END IF + END IF ! -! Write out surface Eastward and Northward momentum components (m/s) at -! RHO-points. +! Write out surface Eastward momentum (m/s) at RHO-points, A-grid. ! - IF ((Qout(idUsuE,ng).and.Qout(idVsuN,ng))) THEN - scale=1.0_dp - gtype=gfactor*r2dvar - status=nf_fwrite2d(ng, model, QCK(ng)%ncid, idUsuE, & - & QCK(ng)%Vid(idUsuE), & - & QCK(ng)%Rindex, gtype, & - & LBi, UBi, LBj, UBj, scale, & + IF (Qout(idUsuE,ng)) THEN + scale=1.0_dp + gtype=gfactor*r2dvar + status=nf_fwrite2d(ng, model, QCK(ng)%ncid, idUsuE, & + & QCK(ng)%Vid(idUsuE), & + & QCK(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING - & GRID(ng) % rmask_full, & + & GRID(ng) % rmask_full, & # endif - & Ur3d(:,:,N(ng))) - IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN - IF (Master) THEN - WRITE (stdout,20) TRIM(Vname(1,idUsuE)), QCK(ng)%Rindex - END IF - exit_flag=3 - ioerror=status - RETURN + & OCEAN(ng) % ua(:,:,N(ng))) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idUsuE)), QCK(ng)%Rindex END IF - - status=nf_fwrite2d(ng, model, QCK(ng)%ncid, idVsuN, & - & QCK(ng)%Vid(idVsuN), & - & QCK(ng)%Rindex, gtype, & - & LBi, UBi, LBj, UBj, scale, & + exit_flag=3 + ioerror=status + RETURN + END IF + END IF +! +! Write out surface Northward momentum (m/s) at RHO-points, A-grid. +! + IF (Qout(idVsuN,ng)) THEN + status=nf_fwrite2d(ng, model, QCK(ng)%ncid, idVsuN, & + & QCK(ng)%Vid(idVsuN), & + & QCK(ng)%Rindex, gtype, & + & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING - & GRID(ng) % rmask_full, & + & GRID(ng) % rmask_full, & # endif - & Vr3d(:,:,N(ng))) - IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN - IF (Master) THEN - WRITE (stdout,20) TRIM(Vname(1,idVsuN)), QCK(ng)%Rindex - END IF - exit_flag=3 - ioerror=status - RETURN + & OCEAN(ng) % va(:,:,N(ng))) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idVsuN)), QCK(ng)%Rindex END IF + exit_flag=3 + ioerror=status + RETURN END IF - deallocate (Ur3d) - deallocate (Vr3d) END IF ! ! Write out S-coordinate omega vertical velocity (m/s). @@ -1621,8 +1599,6 @@ SUBROUTINE wrt_quick_pio (ng, model, tile, & real(r8), allocatable :: Ur2d(:,:) real(r8), allocatable :: Vr2d(:,:) # ifdef SOLVE3D - real(r8), allocatable :: Ur3d(:,:,:) - real(r8), allocatable :: Vr3d(:,:,:) real(r8), allocatable :: Wr3d(:,:,:) # endif ! @@ -2193,134 +2169,116 @@ SUBROUTINE wrt_quick_pio (ng, model, tile, & END IF END IF ! -! Write out 3D Eastward and Northward momentum components (m/s) at -! RHO-points. +! Write out 3D Eastward momentum (m/s) at RHO-points, A-grid. ! - IF ((Qout(idu3dE,ng).and.Qout(idv3dN,ng)).or. & - & (Qout(idUsuE,ng).and.Qout(idVsuN,ng))) THEN - IF (.not.allocated(Ur3d)) THEN - allocate (Ur3d(LBi:UBi,LBj:UBj,N(ng))) - Ur3d(LBi:UBi,LBj:UBj,1:N(ng))=0.0_r8 - END IF - IF (.not.allocated(Vr3d)) THEN - allocate (Vr3d(LBi:UBi,LBj:UBj,N(ng))) - Vr3d(LBi:UBi,LBj:UBj,1:N(ng))=0.0_r8 + IF (Qout(idu3dE,ng)) THEN + scale=1.0_dp + IF (QCK(ng)%pioVar(idu3dE)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r3dvar(ng) + ELSE + ioDesc => ioDesc_sp_r3dvar(ng) END IF - CALL uv_rotate3d (ng, tile, .FALSE., .TRUE., & - & LBi, UBi, LBj, UBj, 1, N(ng), & - & GRID(ng) % CosAngler, & - & GRID(ng) % SinAngler, & -# ifdef MASKING - & GRID(ng) % rmask_full, & -# endif - & OCEAN(ng) % u(:,:,:,NOUT), & - & OCEAN(ng) % v(:,:,:,NOUT), & - & Ur3d, Vr3d) -! - IF ((Qout(idu3dE,ng).and.Qout(idv3dN,ng))) THEN - scale=1.0_dp - IF (QCK(ng)%pioVar(idu3dE)%dkind.eq.PIO_double) THEN - ioDesc => ioDesc_dp_r3dvar(ng) - ELSE - ioDesc => ioDesc_sp_r3dvar(ng) - END IF - status=nf_fwrite3d(ng, model, QCK(ng)%pioFile, idu3dE, & - & QCK(ng)%pioVar(idu3dE), & - & QCK(ng)%Rindex, & - & ioDesc, & - & LBi, UBi, LBj, UBj, 1, N(ng), scale, & + status=nf_fwrite3d(ng, model, QCK(ng)%pioFile, idu3dE, & + & QCK(ng)%pioVar(idu3dE), & + & QCK(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING - & GRID(ng) % rmask_full, & + & GRID(ng) % rmask_full, & # endif - & Ur3d) - IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN - IF (Master) THEN - WRITE (stdout,20) TRIM(Vname(1,idu3dE)), QCK(ng)%Rindex - END IF - exit_flag=3 - ioerror=status - RETURN + & OCEAN(ng) % ua) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idu3dE)), QCK(ng)%Rindex END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF ! - IF (QCK(ng)%pioVar(idv3dN)%dkind.eq.PIO_double) THEN - ioDesc => ioDesc_dp_r3dvar(ng) - ELSE - ioDesc => ioDesc_sp_r3dvar(ng) - END IF - status=nf_fwrite3d(ng, model, QCK(ng)%pioFile, idv3dN, & - & QCK(ng)%pioVar(idv3dN), & - & QCK(ng)%Rindex, & - & ioDesc, & - & LBi, UBi, LBj, UBj, 1, N(ng), scale, & +! Write out 3D Northward momentum (m/s) at RHO-points, A-grid. +! + IF (Qout(idv3dN,ng)) THEN + scale=1.0_dp + IF (QCK(ng)%pioVar(idv3dN)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r3dvar(ng) + ELSE + ioDesc => ioDesc_sp_r3dvar(ng) + END IF + status=nf_fwrite3d(ng, model, QCK(ng)%pioFile, idv3dN, & + & QCK(ng)%pioVar(idv3dN), & + & QCK(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING - & GRID(ng) % rmask_full, & + & GRID(ng) % rmask_full, & # endif - & Vr3d) - IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN - IF (Master) THEN - WRITE (stdout,20) TRIM(Vname(1,idv3dN)), QCK(ng)%Rindex - END IF - exit_flag=3 - ioerror=status - RETURN + & OCEAN(ng) % va) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idv3dN)), QCK(ng)%Rindex END IF - deallocate (Ur3d) - deallocate (Vr3d) + exit_flag=3 + ioerror=status + RETURN END IF + END IF ! -! Write out surface Eastward and Northward momentum components (m/s) at -! RHO-points. +! Write out surface Eastward momentum (m/s) at RHO-points, A-grid. ! - IF ((Qout(idUsuE,ng).and.Qout(idVsuN,ng))) THEN - scale=1.0_dp - IF (QCK(ng)%pioVar(idUsuE)%dkind.eq.PIO_double) THEN - ioDesc => ioDesc_dp_r2dvar(ng) - ELSE - ioDesc => ioDesc_sp_r2dvar(ng) - END IF - status=nf_fwrite2d(ng, model, QCK(ng)%pioFile, idUsuE, & - & QCK(ng)%pioVar(idUsuE), & - & QCK(ng)%Rindex, & - & ioDesc, & - & LBi, UBi, LBj, UBj, scale, & + IF (Qout(idUsuE,ng)) THEN + scale=1.0_dp + IF (QCK(ng)%pioVar(idUsuE)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r2dvar(ng) + ELSE + ioDesc => ioDesc_sp_r2dvar(ng) + END IF + status=nf_fwrite2d(ng, model, QCK(ng)%pioFile, idUsuE, & + & QCK(ng)%pioVar(idUsuE), & + & QCK(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING - & GRID(ng) % rmask_full, & + & GRID(ng) % rmask_full, & # endif - & Ur3d(:,:,N(ng))) - IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN - IF (Master) THEN - WRITE (stdout,20) TRIM(Vname(1,idUsuE)), QCK(ng)%Rindex - END IF - exit_flag=3 - ioerror=status - RETURN + & OCEAN(ng) % ua(:,:,N(ng))) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idUsuE)), QCK(ng)%Rindex END IF + exit_flag=3 + ioerror=status + RETURN + END IF + END IF ! - IF (QCK(ng)%pioVar(idVsuN)%dkind.eq.PIO_double) THEN - ioDesc => ioDesc_dp_r2dvar(ng) - ELSE - ioDesc => ioDesc_sp_r2dvar(ng) - END IF - status=nf_fwrite2d(ng, model, QCK(ng)%pioFile, idVsuN, & - & QCK(ng)%pioVar(idVsuN), & - & QCK(ng)%Rindex, & - & ioDesc, & - & LBi, UBi, LBj, UBj, scale, & +! Write out surface Northward momentum (m/s) at RHO-points, A-grid. +! + IF (Qout(idVsuN,ng)) THEN + scale=1.0_dp + IF (QCK(ng)%pioVar(idVsuN)%dkind.eq.PIO_double) THEN + ioDesc => ioDesc_dp_r2dvar(ng) + ELSE + ioDesc => ioDesc_sp_r2dvar(ng) + END IF + status=nf_fwrite2d(ng, model, QCK(ng)%pioFile, idVsuN, & + & QCK(ng)%pioVar(idVsuN), & + & QCK(ng)%Rindex, & + & ioDesc, & + & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING - & GRID(ng) % rmask_full, & + & GRID(ng) % rmask_full, & # endif - & Vr3d(:,:,N(ng))) - IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN - IF (Master) THEN - WRITE (stdout,20) TRIM(Vname(1,idVsuN)), QCK(ng)%Rindex - END IF - exit_flag=3 - ioerror=status - RETURN + & OCEAN(ng) % va(:,:,N(ng))) + IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN + IF (Master) THEN + WRITE (stdout,20) TRIM(Vname(1,idVsuN)), QCK(ng)%Rindex END IF + exit_flag=3 + ioerror=status + RETURN END IF - deallocate (Ur3d) - deallocate (Vr3d) END IF ! ! Write out S-coordinate omega vertical velocity (m/s).