WAVEWATCH III  beta 0.0.1
Functions/Subroutines
w3iopomd Module Reference

Process point output. More...

Functions/Subroutines

subroutine w3iopp (NPT, XPT, YPT, PNAMES, IMOD)
 Preprocessing of point output. More...
 
subroutine w3iope (A)
 Extract point output data and store in output COMMONs. More...
 
integer function nf90_err_check (errcode, ILINE)
 Handle netCDF return code. More...
 
subroutine w3iopon_read (IOTST, IMOD_IN, filename, ncerr)
 Read point output in netCDF format. More...
 
subroutine w3iopon_write (timestep_only, filename, ncerr)
 Write point output in netCDF format. More...
 
subroutine w3iopon (INXOUT, NDSOP, IOTST, IMOD)
 Read or write the netCDF point output file, depending on the value of the first parameter. More...
 
subroutine w3iopo (INXOUT, NDSOP, IOTST, IMOD ifdef W3_ASCII
 Read or write point output. More...
 

Detailed Description

Process point output.

Allocation of allocatable arrays takes place at different places throughout the code, in W3IOPP on write, and in W3IOPO on read.

Author
H. L. Tolman
Date
05-Jun-2018

Function/Subroutine Documentation

◆ nf90_err_check()

integer function w3iopomd::nf90_err_check ( integer, intent(in)  errcode,
integer, intent(in)  ILINE 
)

Handle netCDF return code.

Parameters
errcodeNetCDF error code. 0 for no error.
Author
Edward Hartnett
Date
1-Nov-2023

Definition at line 1126 of file w3iopomd.F90.

1126  USE netcdf
1127  USE w3odatmd, ONLY: ndse
1128  implicit none
1129  integer, intent(in) :: errcode, ILINE
1130 
1131  nf90_err_check = errcode
1132  if(errcode /= nf90_noerr) then
1133  WRITE(ndse,*) ' *** WAVEWATCH III ERROR IN W3IOPO :'
1134  WRITE(ndse,*) ' LINE NUMBER ', iline
1135  WRITE(ndse,*) ' NETCDF ERROR MESSAGE: '
1136  WRITE(ndse,*) 'Error: ', trim(nf90_strerror(errcode))
1137  return
1138  endif

References w3odatmd::ndse.

◆ w3iope()

subroutine w3iopomd::w3iope ( real, dimension(nth,nk,0:nseal), intent(in)  A)

Extract point output data and store in output COMMONs.

This action is taken from an earlier version of W3IOPO so that the point output postprocessor does not need the full sea-point grid to be able to run. Note that the output spectrum is F(f,theta). Interpolation is performed for this spectrum.

Parameters
[in]AAction spectra on storage grid.
Author
H. L. Tolman
Date
12-Jun-2012

Definition at line 697 of file w3iopomd.F90.

697  !/
698  !/ +-----------------------------------+
699  !/ | WAVEWATCH III NOAA/NCEP |
700  !/ | H. L. Tolman |
701  !/ | FORTRAN 90 |
702  !/ | Last update : 12-Jun-2012 |
703  !/ +-----------------------------------+
704  !/
705  !/ 12-Jan-1999 : Distributed FORTRAN 77 version. ( version 1.18 )
706  !/ 25-Jan-2000 : Upgrade to FORTRAN 90 ( version 2.00 )
707  !/ Major changes to logistics.
708  !/ 11-Jun-2001 : Clean-up. ( version 2.11 )
709  !/ 09-Nov-2004 : Multiple grid version. ( version 3.06 )
710  !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 )
711  !/ (W. E. Rogers & T. J. Campbell, NRL)
712  !/ 29-Oct-2010 : Implement unstructured grids ( version 3.14.4 )
713  !/ (A. Roland and F. Ardhuin)
714  !/ 12-Jun-2012 : Add /RTD option or rotated grid option.
715  !/ (Jian-Guo Li) ( version 4.06 )
716  !/ 01-Mar-2018 : Add option to unrotate spectra ( version 6.02 )
717  !/ from RTD grid models
718  !/ 19-Jul-2021 : Momentum and air density support ( version 7.14 )
719  !/
720  ! 1. Purpose :
721  !
722  ! Extract point output data and store in output COMMONs. This
723  ! action is taken from an earlier version of W3IOPO so that the
724  ! point output postprocessor does not need the full sea-point
725  ! grid to be able to run.
726  ! Note that the output spectrum is F(f,theta). Interpolation
727  ! is performed for this spectrum.
728  !
729  ! 3. Parameters :
730  !
731  ! Parameter list
732  ! ----------------------------------------------------------------
733  ! A R.A. I Action spectra on storage grid.
734  ! ----------------------------------------------------------------
735  !
736  ! 4. Subroutines used :
737  !
738  ! See module documentation.
739  !
740  ! 5. Called by :
741  !
742  ! Name Type Module Description
743  ! ----------------------------------------------------------------
744  ! W3WAVE Subr. W3WAVEMD Actual wave model routine.
745  ! ----------------------------------------------------------------
746  !
747  ! 6. Error messages :
748  !
749  ! None.
750  !
751  ! 7. Remarks :
752  !
753  ! - To allow for dynamic ice edges, interpolation factors are
754  ! calculated for every time step separately.
755  ! - Wind current and depth data are interpolated ignoring ice,
756  ! spectrum is interpolated removing ice points.
757  ! - Spectra are left in par list to allow for change of shape of
758  ! arrays.
759  ! - IMOD is not passed to this routine. Since it is used only
760  ! in W3WAVE, it is assumed that the pointer are set
761  ! appropriately outside this routine.
762  !
763  ! 8. Structure :
764  !
765  ! See source code.
766  !
767  ! 9. Switches :
768  !
769  ! !/SHRD Switch for shared / distributed memory architecture.
770  ! !/DIST Id.
771  ! !/MPI Switch for message passing method.
772  !
773  ! !/S Enable subroutine tracing.
774  ! !/T Test output.
775  !
776  ! 10. Source code :
777  !
778  !/ ------------------------------------------------------------------- /
779  USE constants
780  USE w3gdatmd, ONLY: nk, nth, sig, nx, ny, nsea, nseal, &
781  mapsta, mapfs
782 #ifdef W3_RTD
783  !! Use spectral rotation sub and angle. JGLi12Jun2012
784  USE w3gdatmd, ONLY: nspec, angld, flagunr
785  USE w3servmd, ONLY: w3acturn
786 #endif
787  USE w3wdatmd, ONLY: ice, iceh, icef
788 #ifdef W3_FLX5
789  USE w3wdatmd, ONLY: rhoair
790 #endif
791  USE w3adatmd, ONLY: cg, dw, ua, ud, as, cx, cy, &
792  sp => sppnt
793 #ifdef W3_FLX5
794  USE w3adatmd, ONLY: taua, tauadir
795 #endif
796  USE w3odatmd, ONLY: ndst, nopts, iptint, ptifac, il, iw, ii, &
797  dpo, wao, wdo, aso, cao, cdo, iceo, iceho, &
798  icefo, spco, naproc
799 #ifdef W3_FLX5
800  USE w3odatmd, ONLY: tauao, taudo, dairo
801 #endif
802 #ifdef W3_SETUP
803  USE w3wdatmd, ONLY: zeta_setup
804  USE w3odatmd, ONLY: zet_seto
805 #endif
806 #ifdef W3_MPI
807  USE w3odatmd, ONLY: irqpo2
808 #endif
809  USE w3servmd, ONLY: extcde
810 #ifdef W3_S
811  USE w3servmd, ONLY: strace
812 #endif
813 #ifdef W3_T
814  USE w3arrymd, ONLY: prt2ds
815 #endif
816  !
817  IMPLICIT NONE
818  !
819 #ifdef W3_MPI
820  include "mpif.h"
821 #endif
822  !/
823  !/ ------------------------------------------------------------------- /
824  !/ Parameter list
825  !/
826  REAL, INTENT(IN) :: A(NTH,NK,0:NSEAL)
827  !/
828  !/ ------------------------------------------------------------------- /
829  !/ Local parameters
830  !/
831  INTEGER :: I, IX1, IY1, IX(4), IY(4), J, IS(4), &
832  IM(4), IK, ITH, ISP
833 #ifdef W3_MPI
834  INTEGER :: IOFF, IERR_MPI
835  INTEGER :: STAT(MPI_STATUS_SIZE,4*NOPTS)
836 #endif
837 #ifdef W3_S
838  INTEGER, SAVE :: IENT = 0
839 #endif
840  REAL :: RD(4), RDS, RDI, FACRD, &
841  WNDX, WNDY, CURX, CURY, FAC1(NK), &
842  FAC2(NK), FAC3(NK), FAC4(NK)
843 #ifdef W3_FLX5
844  REAL :: TAUX, TAUY
845 #endif
846  INTEGER :: JSEA, ISEA
847 #ifdef W3_T
848  REAL :: SPTEST(NK,NTH)
849 #endif
850 #ifdef W3_RTD
851  REAL :: Spectr(NSPEC), AnglDIS
852  INTEGER :: IROT
853 #endif
854  !/
855  !/ ------------------------------------------------------------------- /
856  !/
857 #ifdef W3_S
858  CALL strace (ient, 'W3IOPE')
859 #endif
860  !
861  cx(0) = 0.
862  cy(0) = 0.
863  !
864  ! Loop over spectra -------------------------------------------------- *
865  !
866  DO i=1, nopts
867  !
868 #ifdef W3_T
869  WRITE (ndst,9000) i
870 #endif
871  !
872  ! Unpack interpolation data
873  !
874  ix(:) = iptint(1,:,i)
875  iy(:) = iptint(2,:,i)
876  rd(:) = ptifac(:,i)
877  !
878 #ifdef W3_T
879  ! WRITE (NDST,9001) IX1, IY1, IX(2)
880 #endif
881  !
882  !
883  ! Correct for land and ice and get sea point counters
884  !
885  il(i) = 0
886  iw(i) = 0
887  ii(i) = 0
888  rds = 0.
889  rdi = 0.
890  !
891  DO j=1, 4
892  is(j) = mapfs(iy(j),ix(j))
893  im(j) = mapsta(iy(j),ix(j))
894  IF ( im(j).GT.0 ) THEN
895  iw(i) = iw(i) + 1
896  rds = rds + rd(j)
897 #ifdef W3_RTD
898  irot = is(j) ! For rotation angle
899 #endif
900  ELSE
901  IF ( im(j).LT.0 ) THEN
902  ii(i) = ii(i) + 1
903  rdi = rdi + rd(j)
904  ELSE
905  il(i) = il(i) + 1
906  rd(j) = 0.
907  END IF
908  END IF
909  END DO
910  !
911  ! Depth, wind and current, ignore ice
912  !
913  IF ( rds+rdi .GT. 1.e-7 ) THEN
914  facrd = 1. / (rds+rdi)
915  rd = rd * facrd
916  END IF
917  !
918 #ifdef W3_T
919  WRITE (ndst,9002) (is(j),j=1,4), (im(j),j=1,4), (rd(j),j=1,4)
920 #endif
921  !
922  ! Interpolate ice depth, wind, stresses, rho air and current
923  !
924  IF (.NOT. lpdlib) THEN
925  icefo(i) = 0
926  DO j=1, 4
927  isea = mapfs(iy(j),ix(j))
928 #ifdef W3_DIST
929  jsea = 1 + (isea-1)/naproc
930 #endif
931 #ifdef W3_SHRD
932  jsea = isea
933 #endif
934  icefo(i) = icefo(i) + rd(j)*icef(jsea)
935  END DO
936  ELSE
937  icefo(i) = rd(1)*icef(is(1)) + rd(2)*icef(is(2)) + &
938  rd(3)*icef(is(3)) + rd(4)*icef(is(4))
939  END IF
940 
941  iceo(i) = rd(1)*ice(is(1)) + rd(2)*ice(is(2)) + &
942  rd(3)*ice(is(3)) + rd(4)*ice(is(4))
943 
944  iceho(i) = rd(1)*iceh(is(1)) + rd(2)*iceh(is(2)) + &
945  rd(3)*iceh(is(3)) + rd(4)*iceh(is(4))
946  !
947  dpo(i) = rd(1)*dw(is(1)) + rd(2)*dw(is(2)) + &
948  rd(3)*dw(is(3)) + rd(4)*dw(is(4))
949 #ifdef W3_SETUP
950  dpo(i) = rd(1)*zeta_setup(is(1)) + &
951  rd(2)*zeta_setup(is(2)) + &
952  rd(3)*zeta_setup(is(3)) + &
953  rd(4)*zeta_setup(is(4))
954 #endif
955  !
956 #ifdef W3_FLX5
957  dairo(i) = rd(1)*rhoair(is(1)) + rd(2)*rhoair(is(2)) + &
958  rd(3)*rhoair(is(3)) + rd(4)*rhoair(is(4))
959 #endif
960  !
961  wndx = rd(1) * ua(is(1)) * cos(ud(is(1))) + &
962  rd(2) * ua(is(2)) * cos(ud(is(2))) + &
963  rd(3) * ua(is(3)) * cos(ud(is(3))) + &
964  rd(4) * ua(is(4)) * cos(ud(is(4)))
965  wndy = rd(1) * ua(is(1)) * sin(ud(is(1))) + &
966  rd(2) * ua(is(2)) * sin(ud(is(2))) + &
967  rd(3) * ua(is(3)) * sin(ud(is(3))) + &
968  rd(4) * ua(is(4)) * sin(ud(is(4)))
969  !
970  wao(i) = sqrt( wndx**2 + wndy**2 )
971  IF ( wao(i).GT.1.e-7 ) THEN
972  wdo(i) = atan2(wndy,wndx)
973 #ifdef W3_RTD
974  IF ( flagunr ) wdo(i) = wdo(i) - angld(is(1))*dera
975 #endif
976  ELSE
977  wdo(i) = 0.
978  END IF
979  !
980 #ifdef W3_FLX5
981  taux = rd(1) * taua(is(1)) * cos(tauadir(is(1))) + &
982  rd(2) * taua(is(2)) * cos(tauadir(is(2))) + &
983  rd(3) * taua(is(3)) * cos(tauadir(is(3))) + &
984  rd(4) * taua(is(4)) * cos(tauadir(is(4)))
985  tauy = rd(1) * taua(is(1)) * sin(tauadir(is(1))) + &
986  rd(2) * taua(is(2)) * sin(tauadir(is(2))) + &
987  rd(3) * taua(is(3)) * sin(tauadir(is(3))) + &
988  rd(4) * taua(is(4)) * sin(tauadir(is(4)))
989  !
990  tauao(i) = sqrt( taux**2 + tauy**2 )
991  IF ( tauao(i).GT.1.e-7 ) THEN
992  taudo(i) = atan2(tauy,taux)
993 #ifdef W3_RTD
994  IF ( flagunr ) taudo(i) = taudo(i) - angld(is(1))*dera
995 #endif
996  ELSE
997  taudo(i) = 0.
998  END IF
999  !
1000 #endif
1001  aso(i) = rd(1)*as(is(1)) + rd(2)*as(is(2)) + &
1002  rd(3)*as(is(3)) + rd(4)*as(is(4))
1003  !
1004  curx = rd(1)*cx(is(1)) + rd(2)*cx(is(2)) + &
1005  rd(3)*cx(is(3)) + rd(4)*cx(is(4))
1006  cury = rd(1)*cy(is(1)) + rd(2)*cy(is(2)) + &
1007  rd(3)*cy(is(3)) + rd(4)*cy(is(4))
1008  !
1009  cao(i) = sqrt( curx**2 + cury**2 )
1010  IF ( cao(i).GT.1.e-7 ) THEN
1011  cdo(i) = atan2(cury,curx)
1012 #ifdef W3_RTD
1013  IF ( flagunr ) cdo(i) = cdo(i) - angld(is(1))*dera
1014 #endif
1015  ELSE
1016  cdo(i) = 0.
1017  END IF
1018  !
1019  ! Interp. weights for spectra, no ice points (spectra by def. zero)
1020  !
1021  IF ( rds .GT. 1.e-7 ) THEN
1022  facrd = (rds+rdi) / rds
1023  rd = rd * facrd
1024  END IF
1025  !
1026 #ifdef W3_T
1027  WRITE (ndst,9003) (rd(j),j=1,4)
1028 #endif
1029  !
1030  ! Extract spectra, shared memory version
1031  ! (done in separate step for MPP compatibility)
1032  !
1033 #ifdef W3_SHRD
1034  DO j=1, 4
1035  DO ik=1, nk
1036  DO ith=1, nth
1037  sp(ith,ik,j) = a(ith,ik,is(j))
1038  END DO
1039  END DO
1040  END DO
1041 #endif
1042  !
1043  ! Extract spectra, distributed memory version(s)
1044  !
1045 #ifdef W3_MPI
1046  ioff = 1 + 4*(i-1)
1047  CALL mpi_startall ( 4, irqpo2(ioff), ierr_mpi )
1048  CALL mpi_waitall ( 4, irqpo2(ioff), stat, ierr_mpi )
1049 #endif
1050  !
1051  ! Interpolate spectrum
1052  !
1053  DO ik=1, nk
1054  fac1(ik) = tpi * sig(ik) / cg(ik,is(1))
1055  fac2(ik) = tpi * sig(ik) / cg(ik,is(2))
1056  fac3(ik) = tpi * sig(ik) / cg(ik,is(3))
1057  fac4(ik) = tpi * sig(ik) / cg(ik,is(4))
1058  END DO
1059  !
1060  DO ik=1,nk
1061  DO ith=1,nth
1062  isp = ith + (ik-1)*nth
1063  spco(isp,i) = rd(1) * sp(ith,ik,1) * fac1(ik) &
1064  + rd(2) * sp(ith,ik,2) * fac2(ik) &
1065  + rd(3) * sp(ith,ik,3) * fac3(ik) &
1066  + rd(4) * sp(ith,ik,4) * fac4(ik)
1067 #ifdef W3_T
1068  sptest(ik,ith) = spco(isp,i)
1069 #endif
1070  END DO
1071  END DO
1072  !
1073 #ifdef W3_RTD
1074  !! Rotate the interpolated spectrum by -AnglD(IS(1)). JGLi12Jun2012
1075  !! SPCO still holds action not energy spectrum yet. JGLi18Jun2013
1076  !! Use new index IROT rather than IS(1) as in some cases
1077  !! IS(1) will be a coast point and have an index of 0. C.Bunney 15/02/2011
1078  IF ( flagunr ) THEN
1079  spectr = spco(:,i)
1080  angldis = -angld(irot)
1081  CALL w3acturn( nth, nk, angldis, spectr )
1082  spco(:,i) = spectr
1083  END IF
1084 
1085 #endif
1086  !
1087 #ifdef W3_T
1088  WRITE (ndst,9004) dpo(i), wao(i), wdo(i)*rade, &
1089  cao(i), cdo(i)*rade
1090 #endif
1091 
1092  ! FA COMMENTED OUT: BUG
1093  !At line 1974 of file w3arrymd.f90
1094  !Fortran runtime error: Index '52' of dimension 1 of array 'pnum2' above upper bound of 51
1095 #ifdef W3_T
1096  ! CALL PRT2DS (NDST, NK, NK, NTH, SPTEST, SIG(1:), ' ', 1.,0.,&
1097  ! 0.0001, 'E(f,theta)', 'm**2s', 'TEST OUTPUT' )
1098 #endif
1099  !
1100  END DO
1101  !
1102  RETURN
1103  !
1104  ! Formats
1105  !
1106 #ifdef W3_T
1107 9000 FORMAT (' TEST W3IOPE : POINT NR.:',i3)
1108 9001 FORMAT (' TEST W3IOPE :',2i8,' (',i3,')')
1109 9002 FORMAT (' TEST W3IOPE :',4i7,2x,4i2,2x,4f5.2)
1110 9003 FORMAT (' TEST W3IOPE :',40x,4f5.2)
1111 9004 FORMAT (' TEST W3IOPE :',f8.1,2(f7.2,f7.1))
1112 #endif
1113  !/
1114  !/ End of W3IOPE ----------------------------------------------------- /
1115  !/

References w3gdatmd::angld, w3adatmd::as, w3odatmd::aso, w3adatmd::cg, w3adatmd::cx, w3adatmd::cy, constants::dera, w3odatmd::dpo, w3adatmd::dw, w3servmd::extcde(), w3gdatmd::flagunr, w3wdatmd::ice, w3wdatmd::icef, w3wdatmd::iceh, w3odatmd::ii, w3odatmd::il, include(), w3odatmd::iptint, w3odatmd::irqpo2, w3odatmd::iw, constants::lpdlib, w3gdatmd::mapfs, w3gdatmd::mapsta, w3odatmd::naproc, w3odatmd::ndst, w3gdatmd::nk, w3odatmd::nopts, w3gdatmd::nsea, w3gdatmd::nseal, w3gdatmd::nspec, w3gdatmd::nth, w3gdatmd::nx, w3gdatmd::ny, w3arrymd::prt2ds(), w3odatmd::ptifac, constants::rade, w3wdatmd::rhoair, w3gdatmd::sig, w3adatmd::sppnt, w3servmd::strace(), w3adatmd::taua, w3adatmd::tauadir, constants::tpi, w3adatmd::ua, w3adatmd::ud, w3servmd::w3acturn(), w3odatmd::wao, w3odatmd::wdo, w3odatmd::zet_seto, and w3wdatmd::zeta_setup.

Referenced by w3wavemd::w3wave(), and wmwavemd::wmwave().

◆ w3iopo()

subroutine w3iopomd::w3iopo ( character, dimension(*), intent(in)  INXOUT,
integer, intent(in)  NDSOP,
integer, intent(out)  IOTST,
integer, intent(in), optional  IMOD,
  ifdef,
  W3_ASCII 
)

Read or write point output.

This subroutine can either read or write the point output file, depending on the value of the first parameter.

When reading, the entire file is read with one call to this subroutine.

When writing, this subroutine can either write one timestep or the whole model run. This is an option in the input file. If the entire model run is to be written, then OFILES(2) is 0. If only one timestep is to be written, then OFILES(2) is 1.

If OFILES(2) is 0, the output file is names out_pnt.ww3. If OFILES(2) is 1, the output file is named TIMETAG.out_pnt.ww3.

The format of the point output file is:

Size (bytes) Type Variable Meaning
40 character*40 IDTST ID string
4 integer VERTST Model definition file version number
4 integer NK Number of discrete wavenumbers
4 integer NTH Number of discrete directions.
4 integer NOPTS Number of output points.
8*NOPTS real(2,NOPTS) PTLOC Point locations
7*NOPTS character*7 PTNME Point names
8 integer(2) TIME Valid time
reclen*NOPTS * * records

Each record contains:

Size (bytes) Type Variable Meaning
4 integer IW Number of water points in interpolation box for output point.
4 integer II Number of ice points in interpolation box for output point.
4 integer IL Number of land points in interpolation box for output point.
4 real DPO Interpolated depths.
4 real WAO Interpolated wind speeds.
4 real WDO Interpolated wind directions.
4 real TAUAO (W3_FLX5 only) Interpolated atmospheric stresses.
4 real TAUDO (W3_FLX5 only) Interpolated atmospheric stress directions.
4 real DAIRO (W3_FLX5 only) Interpolated rho atmosphere.
4 real ZET_SETO (W3_SETUP only) Used for wave setup.
4 real ASO Interpolated air-sea temperature difference
4 real CAO Interpolated current speeds.
4 real CDO Interpolated current directions.
4 real ICEO Interpolated ice concentration.
4 real ICEHO Interpolated ice thickness.
4 real ICEFO Interpolated ice floe.
13 char GRDID Originating grid ID
4 real SPCO(J,I),J=1,NSPEC Output spectra

In the event of error, EXTCDE() will be called with the following exit codes:

  • 1 INXOUT must be 'READ' or 'WRITE'.
  • 2 Unexpectedly changed from WRITE to READ in subsequent call.
  • 10 Unexpected IDSTR
  • 11 Unexpected VEROPT
  • 12 Unexpected MK or MTH
  • 20 Error opening file.
  • 21 Unexpected end of file during read.
  • 22 Error reading file.
  • 23 Unexpected end of file during read.
Parameters
[in]INXOUTString indicating read/write. Must be 'READ' or 'WRITE'.
[in]NDSOPThis is set by this subroutine to the netCDF file ID (ncid) of the opened file. User does not have to initialize this value, and should not change it.
[out]IOTSTError code:
  • 0 No error.
  • -1 Unexpected end of file when reading.
[in]IMODModel number for W3GDAT etc.
[in]NDSOAFile unit number for ASCII output.
Author
H. L. Tolman
Date
25-Jul-2006

Definition at line 1907 of file w3iopomd.F90.

1907  ,ndsoa &
1908 #endif
1909  )
1910  !/
1911  !/ +-----------------------------------+
1912  !/ | WAVEWATCH III NOAA/NCEP |
1913  !/ | H. L. Tolman |
1914  !/ | FORTRAN 90 |
1915  !/ | Last update : 25-Jul-2006 |
1916  !/ +-----------------------------------+
1917  !/
1918  !/ 07-Jan-1999 : Distributed FORTRAN 77 version. ( version 1.18 )
1919  !/ 30-Dec-1999 : Upgrade to FORTRAN 90 ( version 2.00 )
1920  !/ Major changes to logistics.
1921  !/ 10-Nov-2004 : Multiple grid version. ( version 3.06 )
1922  !/ 27-Jun-2006 : Adding file name preamble. ( version 3.09 )
1923  !/ 25-Jul-2006 : Adding grid ID per point. ( version 3.10 )
1924  !/ 27-Aug-2015 : Adding interpolation for the ice. ( version 5.10 )
1925  !/ 19-Jul-2021 : Momentum and air density support ( version 7.14 )
1926  !/
1927  ! 1. Purpose :
1928  !
1929  ! Read/write point output.
1930  !
1931  ! 3. Parameters :
1932  !
1933  ! Parameter list
1934  ! ----------------------------------------------------------------
1935  ! INXOUT C*(*) I Test string for read/write, valid are:
1936  ! 'READ' and 'WRITE'.
1937  ! NDSOP Int. I File unit number. for binary
1938  ! NDSOA Int. I File unit number. for ASCII
1939  ! IOTST Int. O Test indictor for reading.
1940  ! 0 : Data read.
1941  ! -1 : Past end of file.
1942  ! IMOD I(O) I Model number for W3GDAT etc.
1943  ! ----------------------------------------------------------------
1944  !
1945  ! 4. Subroutines used :
1946  !
1947  ! See module documentation.
1948  !
1949  ! 5. Called by :
1950  !
1951  ! Name Type Module Description
1952  ! ----------------------------------------------------------------
1953  ! W3WAVE Subr. W3WAVEMD Actual wave model routine.
1954  ! WW3_OUTP Prog. N/A Postprocessing for point output.
1955  ! GX_OUTP Prog. N/A Grads postprocessing for point output.
1956  ! ----------------------------------------------------------------
1957  !
1958  ! 6. Error messages :
1959  !
1960  ! Tests on INXOUT, file status and on array dimensions.
1961  !
1962  ! 7. Remarks :
1963  !
1964  ! - The output file has the pre-defined name 'out_pnt.FILEXT'.
1965  ! - In MPP version of model data is supposed to be gatherd at the
1966  ! correct processor before the routine is called.
1967  ! - No error output filtering needed.
1968  !
1969  ! 8. Structure :
1970  !
1971  ! See source code.
1972  !
1973  ! 9. Switches :
1974  !
1975  ! !/SHRD Switch for shared / distributed memory architecture.
1976  ! !/DIST Id.
1977  !
1978  ! !/S Enable subroutine tracing.
1979  ! !/T Test output.
1980  !
1981  ! 10. Source code :
1982  !
1983  !/ ------------------------------------------------------------------- /
1984  USE w3gdatmd, ONLY: w3setg
1985  USE w3wdatmd, ONLY: w3setw
1986  USE w3odatmd, ONLY: w3seto, w3dmo2
1987  !/
1988  USE w3gdatmd, ONLY: nth, nk, nspec, filext
1989  USE w3wdatmd, ONLY: time
1990  USE w3odatmd, ONLY: ndst, ndse, ipass => ipass2, nopts, iptint, &
1991  il, iw, ii, ptloc, ptifac, dpo, wao, wdo, &
1992  aso, cao, cdo, spco, ptnme, o2init, fnmpre, &
1993  grdid, iceo, iceho, icefo
1994 #ifdef W3_FLX5
1995  USE w3odatmd, ONLY: tauao, taudo, dairo
1996 #endif
1997  USE w3odatmd, ONLY : ofiles
1998  !/
1999 #ifdef W3_SETUP
2000  USE w3odatmd, ONLY: zet_seto
2001 #endif
2002  !/
2003  USE w3servmd, ONLY: extcde
2004 #ifdef W3_S
2005  USE w3servmd, ONLY: strace
2006 #endif
2007 
2008  use constants, only: file_endian
2009  !
2010  IMPLICIT NONE
2011  !/
2012  !/ ------------------------------------------------------------------- /
2013  !/ Parameter list
2014  !/
2015  INTEGER, INTENT(IN) :: NDSOP
2016 #ifdef W3_ASCII
2017  INTEGER, INTENT(IN), OPTIONAL :: NDSOA
2018 #endif
2019  INTEGER, INTENT(OUT) :: IOTST
2020  INTEGER, INTENT(IN), OPTIONAL :: IMOD
2021  CHARACTER, INTENT(IN) :: INXOUT*(*)
2022  !/
2023  !/ ------------------------------------------------------------------- /
2024  !/ local parameters
2025  !/
2026  INTEGER :: IGRD, IERR, MK, MTH, I, J
2027 #ifdef W3_S
2028  INTEGER, SAVE :: IENT = 0
2029 #endif
2030  LOGICAL,SAVE :: WRITE
2031  CHARACTER(LEN=31) :: IDTST
2032  CHARACTER(LEN=10) :: VERTST
2033  !/
2034  CHARACTER(LEN=15) :: TIMETAG
2035  !/
2036  !/ ------------------------------------------------------------------- /
2037  !/
2038 #ifdef W3_S
2039  CALL strace (ient, 'W3IOPO')
2040 #endif
2041  ipass = ipass + 1
2042  iotst = 0
2043  !
2044  ! test input parameters ---------------------------------------------- *
2045  !
2046  IF ( PRESENT(imod) ) THEN
2047  igrd = imod
2048  ELSE
2049  igrd = 1
2050  END IF
2051  !
2052  CALL w3seto ( igrd, ndse, ndst )
2053  CALL w3setg ( igrd, ndse, ndst )
2054  CALL w3setw ( igrd, ndse, ndst )
2055  !
2056  IF (inxout.NE.'READ' .AND. inxout.NE.'WRITE' ) THEN
2057  WRITE (ndse,900) inxout
2058  CALL extcde ( 1 )
2059  END IF
2060  !
2061  ! First pass to this file and we are only writing 1 file for all time
2062  IF ( ipass.EQ.1 .AND. ofiles(2) .EQ. 0) THEN
2063  WRITE = inxout.EQ.'WRITE'
2064  ELSE
2065  IF ( WRITE .AND. inxout.EQ.'READ' ) THEN
2066  WRITE (ndse,901) inxout
2067  CALL extcde ( 2 )
2068  END IF
2069  END IF
2070  !
2071  ! open file ---------------------------------------------------------- *
2072  !
2073  IF ( ipass.EQ.1 .AND. ofiles(2) .EQ. 0 ) THEN
2074 
2075  i = len_trim(filext)
2076  j = len_trim(fnmpre)
2077 
2078 #ifdef W3_T
2079  WRITE (ndst,9001) fnmpre(:j)//'out_pnt.'//filext(:i)
2080 #endif
2081  IF ( WRITE ) THEN
2082  OPEN (ndsop,file=fnmpre(:j)//'out_pnt.'//filext(:i), &
2083  form='UNFORMATTED', convert=file_endian,err=800,iostat=ierr)
2084 #ifdef W3_ASCII
2085  OPEN (ndsoa,file=fnmpre(:j)//'out_pnt.'//filext(:i)//'.txt', &
2086  form='FORMATTED', err=800,iostat=ierr)
2087 #endif
2088  ELSE
2089  OPEN (ndsop,file=fnmpre(:j)//'out_pnt.'//filext(:i), &
2090  form='UNFORMATTED', convert=file_endian,err=800,iostat=ierr,status='OLD')
2091  END IF
2092  !
2093  rewind( ndsop )
2094  !
2095  ! test info ---------------------------------------------------------- *
2096  ! ( IPASS = 1 )
2097  !
2098  IF ( WRITE ) THEN
2099  WRITE (ndsop) &
2100  idstr, veropt, nk, nth, nopts
2101 #ifdef W3_ASCII
2102  WRITE (ndsoa,*) &
2103  'IDSTR, VEROPT, NK, NTH, NOPTS:', &
2104  idstr, veropt, nk, nth, nopts
2105 #endif
2106  ELSE
2107  READ (ndsop,END=801,ERR=802,IOSTAT=IERR) &
2108  idtst, vertst, mk, mth, nopts
2109  !
2110  IF ( idtst .NE. idstr ) THEN
2111  WRITE (ndse,902) idtst, idstr
2112  CALL extcde ( 10 )
2113  END IF
2114  IF ( vertst .NE. veropt ) THEN
2115  WRITE (ndse,903) vertst, veropt
2116  CALL extcde ( 11 )
2117  END IF
2118  IF (nk.NE.mk .OR. nth.NE.mth) THEN
2119  WRITE (ndse,904) mk, mth, nk, nth
2120  CALL extcde ( 12 )
2121  END IF
2122  IF ( .NOT. o2init ) &
2123  CALL w3dmo2 ( igrd, ndse, ndst, nopts )
2124  END IF
2125  !
2126 #ifdef W3_T
2127  WRITE (ndst,9002) idstr, veropt, nk, nth, nopts
2128 #endif
2129  !
2130  ! Point specific info ------------------------------------------------ *
2131  ! ( IPASS = 1 )
2132  !
2133  IF ( WRITE ) THEN
2134  WRITE (ndsop) &
2135  ((ptloc(j,i),j=1,2),i=1,nopts), (ptnme(i),i=1,nopts)
2136 #ifdef W3_ASCII
2137  WRITE (ndsoa,*) &
2138  '((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS):', &
2139  ((ptloc(j,i),j=1,2),i=1,nopts), (ptnme(i),i=1,nopts)
2140 #endif
2141  ELSE
2142  READ (ndsop,END=801,ERR=802,IOSTAT=IERR) &
2143  ((ptloc(j,i),j=1,2),i=1,nopts), (ptnme(i),i=1,nopts)
2144  END IF
2145  !
2146 #ifdef W3_T
2147  WRITE (ndst,9003)
2148  DO i=1, nopts
2149  WRITE (ndst,9004) i, ptloc(1,i), ptloc(2,i), ptnme(i)
2150  END DO
2151 #endif
2152  !
2153  END IF
2154  !
2155  !
2156  IF ( ipass.GE. 1 .AND. ofiles(2) .EQ. 1) THEN
2157  WRITE = inxout.EQ.'WRITE'
2158  ELSE
2159  IF ( WRITE .AND. inxout.EQ.'READ' ) THEN
2160  WRITE (ndse,901) inxout
2161  CALL extcde ( 2 )
2162  END IF
2163  END IF
2164 
2165  ! open file ---------------------------------------------------------- *
2166  !
2167  IF ( ipass.GE.1 .AND. ofiles(2) .EQ. 1) THEN
2168  !
2169  i = len_trim(filext)
2170  j = len_trim(fnmpre)
2171 
2172  ! Create TIMETAG for file name using YYYYMMDD.HHMMS prefix
2173  WRITE(timetag,"(i8.8,'.'i6.6)")time(1),time(2)
2174  !
2175 #ifdef W3_T
2176  WRITE (ndst,9001) fnmpre(:j)//timetag//'.out_pnt.'// &
2177  filext(:i)
2178 #endif
2179  IF ( WRITE ) THEN
2180  OPEN (ndsop,file=fnmpre(:j)//timetag//'.out_pnt.' &
2181  //filext(:i),form='UNFORMATTED', convert=file_endian,err=800,iostat=ierr)
2182 #ifdef W3_ASCII
2183  OPEN (ndsoa,file=fnmpre(:j)//timetag//'.out_pnt.' &
2184  //filext(:i)//'.txt',form='FORMATTED', err=800,iostat=ierr)
2185 #endif
2186  END IF
2187  !
2188  rewind( ndsop )
2189  !
2190  !
2191  ! test info ---------------------------------------------------------- *
2192  ! ( IPASS GE.1 .AND. OFILES(2) .EQ. 1)
2193  !
2194  IF ( WRITE ) THEN
2195  WRITE (ndsop) &
2196  idstr, veropt, nk, nth, nopts
2197 #ifdef W3_ASCII
2198  WRITE (ndsoa,*) &
2199  'IDSTR, VEROPT, NK, NTH, NOPTS:', &
2200  idstr, veropt, nk, nth, nopts
2201 #endif
2202  ELSE
2203  READ (ndsop,END=801,ERR=802,IOSTAT=IERR) &
2204  idtst, vertst, mk, mth, nopts
2205  !
2206  IF ( idtst .NE. idstr ) THEN
2207  WRITE (ndse,902) idtst, idstr
2208  CALL extcde ( 10 )
2209  END IF
2210  IF ( vertst .NE. veropt ) THEN
2211  WRITE (ndse,903) vertst, veropt
2212  CALL extcde ( 11 )
2213  END IF
2214  IF (nk.NE.mk .OR. nth.NE.mth) THEN
2215  WRITE (ndse,904) mk, mth, nk, nth
2216  CALL extcde ( 12 )
2217  END IF
2218  IF ( .NOT. o2init ) &
2219  CALL w3dmo2 ( igrd, ndse, ndst, nopts )
2220  END IF
2221  !
2222 #ifdef W3_T
2223  WRITE (ndst,9002) idstr, veropt, nk, nth, nopts
2224 #endif
2225  !
2226  ! Point specific info ------------------------------------------------ *
2227  ! ( IPASS GE.1 .AND. OFILES(2) .EQ. 1)
2228  !
2229  IF ( WRITE ) THEN
2230  WRITE (ndsop) &
2231  ((ptloc(j,i),j=1,2),i=1,nopts), (ptnme(i),i=1,nopts)
2232 #ifdef W3_ASCII
2233  WRITE (ndsoa,*) &
2234  '((PTLOC(J,I),J=1,2),I=1,NOPTS), (PTNME(I),I=1,NOPTS):', &
2235  ((ptloc(j,i),j=1,2),i=1,nopts), (ptnme(i),i=1,nopts)
2236 #endif
2237  ELSE
2238  READ (ndsop,END=801,ERR=802,IOSTAT=IERR) &
2239  ((ptloc(j,i),j=1,2),i=1,nopts), (ptnme(i),i=1,nopts)
2240  END IF
2241  !
2242 #ifdef W3_T
2243  WRITE (ndst,9003)
2244  DO i=1, nopts
2245  WRITE (ndst,9004) i, ptloc(1,i), ptloc(2,i), ptnme(i)
2246  END DO
2247 #endif
2248  !
2249  END IF
2250  !
2251  !
2252  ! TIME --------------------------------------------------------------- *
2253  !
2254  IF ( WRITE ) THEN
2255  WRITE (ndsop) time
2256 #ifdef W3_ASCII
2257  WRITE (ndsoa,*) 'TIME:', time
2258 #endif
2259  ELSE
2260  READ (ndsop,END=803,ERR=802,IOSTAT=IERR) time
2261  END IF
2262  !
2263 #ifdef W3_T
2264  WRITE (ndst,9010) time
2265 #endif
2266  !
2267  !
2268  ! Loop over spectra -------------------------------------------------- *
2269  !
2270  DO i=1, nopts
2271  !
2272  IF ( WRITE ) THEN
2273  ! set IW, II and IL to 0 because it is not used and gives &
2274  ! outlier values in out_pnt.points
2275  iw(i) = 0
2276  ii(i) = 0
2277  il(i) = 0
2278  WRITE (ndsop) &
2279  iw(i), ii(i), il(i), dpo(i), wao(i), wdo(i), &
2280 #ifdef W3_FLX5
2281  tauao(i), taudo(i), dairo(i), &
2282 #endif
2283 #ifdef W3_SETUP
2284  zet_seto(i), &
2285 #endif
2286  aso(i), cao(i), cdo(i), iceo(i), iceho(i), &
2287  icefo(i), grdid(i), (spco(j,i),j=1,nspec)
2288 #ifdef W3_ASCII
2289  WRITE (ndsoa,*) &
2290  'IW(I), II(I), IL(I), DPO(I), WAO(I), WDO(I):', &
2291  iw(i), ii(i), il(i), dpo(i), wao(i), wdo(i), &
2292 #ifdef W3_FLX5
2293  'TAUAO(I), TAUDO(I), DAIRO(I):', &
2294  tauao(i), taudo(i), dairo(i), &
2295 #endif
2296 #ifdef W3_SETUP
2297  'ZET_SETO(I):', &
2298  zet_seto(i), &
2299 #endif
2300  'ASO(I), CAO(I), CDO(I), ICEO(I), ICEHO(I):', &
2301  aso(i), cao(i), cdo(i), iceo(i), iceho(i), &
2302  'ICEFO(I), GRDID(I), (SPCO(J,I),J=1,NSPEC):', &
2303  icefo(i), grdid(i), (spco(j,i),j=1,nspec)
2304 #endif
2305  ELSE
2306  READ (ndsop,END=801,ERR=802,IOSTAT=IERR) &
2307  iw(i), ii(i), il(i), dpo(i), wao(i), wdo(i), &
2308 #ifdef W3_FLX5
2309  tauao(i), taudo(i), dairo(i), &
2310 #endif
2311 #ifdef W3_SETUP
2312  zet_seto(i), &
2313 #endif
2314  aso(i), cao(i), cdo(i), iceo(i), iceho(i), &
2315  icefo(i), grdid(i), (spco(j,i),j=1,nspec)
2316  END IF
2317  !
2318  END DO
2319  IF (ofiles(2) .EQ. 1) CLOSE (ndsop)
2320  !
2321  RETURN
2322  !
2323  ! Escape locations read errors
2324  !
2325 800 CONTINUE
2326  WRITE (ndse,1000) ierr
2327  CALL extcde ( 20 )
2328  !
2329 801 CONTINUE
2330  WRITE (ndse,1001)
2331  CALL extcde ( 21 )
2332  !
2333 802 CONTINUE
2334  WRITE (ndse,1002) ierr
2335  CALL extcde ( 22 )
2336  !
2337 803 CONTINUE
2338  iotst = -1
2339 #ifdef W3_T
2340  WRITE (ndst,9011)
2341 #endif
2342  RETURN
2343  !
2344  ! Formats
2345  !
2346 900 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO :'/ &
2347  ' ILEGAL INXOUT VALUE: ',a/)
2348 901 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO :'/ &
2349  ' MIXED READ/WRITE, LAST REQUEST: ',a/)
2350 902 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO :'/ &
2351  ' ILEGAL IDSTR, READ : ',a/ &
2352  ' CHECK : ',a/)
2353 903 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO :'/ &
2354  ' ILEGAL VEROPT, READ : ',a/ &
2355  ' CHECK : ',a/)
2356 904 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO :'/ &
2357  ' ERROR IN SPECTRA, MK, MTH : ',2i8/ &
2358  ' ARRAY DIMENSIONS : ',2i8/)
2359  !
2360 1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO : '/ &
2361  ' ERROR IN OPENING FILE'/ &
2362  ' IOSTAT =',i5/)
2363 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO : '/ &
2364  ' PREMATURE END OF FILE'/)
2365 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO : '/ &
2366  ' ERROR IN READING FROM FILE'/ &
2367  ' IOSTAT =',i5/)
2368  !
2369 #ifdef W3_T
2370 9000 FORMAT (' TEST W3IOPO : IPASS =',i4,' INXOUT = ',a, &
2371  ' WRITE = ',l1,' UNIT =',i3/ &
2372  ' IGRD =',i3,' FEXT = ',a)
2373 
2374 9001 FORMAT (' TEST W3IOPO : OPENING NEW FILE [',a,']')
2375 9002 FORMAT (' TEST W3IOPO : TEST PARAMETERS:'/ &
2376  ' IDSTR : ',a/ &
2377  ' VEROPT : ',a/ &
2378  ' NK,NTH :',i5,i8/ &
2379  ' NOPT :',i5)
2380 9003 FORMAT (' TEST W3IOPO : POINT LOCATION AND ID')
2381 9004 FORMAT (3x,i4,2f10.2,2x,a)
2382  !
2383 9010 FORMAT (' TEST W3IOPO : TIME :',i9.8,i7.6)
2384 9011 FORMAT (' TEST W3IOPO : END OF FILE REACHED')
2385  !
2386 9020 FORMAT (' TEST W3IOPO : POINT NR.:',i5)
2387 9021 FORMAT (' TEST W3IOPO :',2i4,2f6.3)
2388 9022 FORMAT (' TEST W3IOPO :',4i7,2x,4i2,2x,4f5.2)
2389 9030 FORMAT (' TEST W3IOPO :',f8.1,2(f7.2,f7.1))
2390 #endif
2391  !/
2392  !/ End of W3IOPO ----------------------------------------------------- /
2393  !/

References w3odatmd::aso, w3odatmd::dpo, w3servmd::extcde(), file(), constants::file_endian, w3gdatmd::filext, w3odatmd::fnmpre, w3odatmd::grdid, w3odatmd::ii, w3odatmd::il, w3odatmd::ipass2, w3odatmd::iptint, w3odatmd::iw, w3odatmd::ndse, w3odatmd::ndst, w3gdatmd::nk, w3odatmd::nopts, w3gdatmd::nspec, w3gdatmd::nth, w3odatmd::o2init, w3odatmd::ofiles, w3odatmd::ptifac, w3odatmd::ptloc, w3odatmd::ptnme, w3servmd::strace(), w3wdatmd::time, w3odatmd::w3dmo2(), w3gdatmd::w3setg(), w3odatmd::w3seto(), w3wdatmd::w3setw(), w3odatmd::wao, w3odatmd::wdo, and w3odatmd::zet_seto.

Referenced by gxoutp(), w3ounp(), w3outp(), w3wavemd::w3wave(), and wmiopomd::wmiopo().

◆ w3iopon()

subroutine w3iopomd::w3iopon ( character, dimension(*), intent(in)  INXOUT,
integer, intent(in)  NDSOP,
integer, intent(out)  IOTST,
integer, intent(in), optional  IMOD 
)

Read or write the netCDF point output file, depending on the value of the first parameter.

When reading, the entire file is read with one call to this subroutine.

When writing, this subroutine can either write one timestep or the whole model run. This is an option in the input file. If the entire model run is to be written, then OFILES(2) is 0. If only one timestep is to be written, then OFILES(2) is 1.

If OFILES(2) is 0, the output file is names out_pnt.ww3. If OFILES(2) is 1, the output file is named TIMETAG.out_pnt.ww3.

Parameters
[in]INXOUTString indicating read/write. Must be 'READ' or 'WRITE'.
[in]NDSOPFile unit number.
[out]IOTSTError code:
  • 0 No error.
  • -1 Unexpected end of file when reading.
[in]IMODModel number for W3GDAT etc.
Author
Edward Hartnett
Date
1-Nov-2023

Definition at line 1747 of file w3iopomd.F90.

1747  USE w3gdatmd, ONLY: w3setg
1748  USE w3wdatmd, ONLY: w3setw
1749  USE w3odatmd, ONLY: w3seto
1750  USE w3gdatmd, ONLY: filext
1751  USE w3wdatmd, ONLY: time
1752  USE w3odatmd, ONLY: ndst, ndse, ipass => ipass2, fnmpre
1753  USE w3odatmd, ONLY: ofiles
1754  USE w3servmd, ONLY: extcde
1755 #ifdef W3_S
1756  USE w3servmd, ONLY: strace
1757 #endif
1758  use netcdf
1759  IMPLICIT NONE
1760 
1761  CHARACTER, INTENT(IN) :: INXOUT*(*)
1762  INTEGER, INTENT(IN) :: NDSOP
1763  INTEGER, INTENT(OUT) :: IOTST
1764  INTEGER, INTENT(IN), OPTIONAL :: IMOD
1765 
1766  CHARACTER(LEN=15) :: TIMETAG
1767  INTEGER :: IGRD
1768  character(len = 124) :: filename
1769  integer :: ncerr
1770 
1771 #ifdef W3_S
1772  CALL strace (ient, 'W3IOPON')
1773 #endif
1774 
1775  ! IPASS essentially is the time variable dimension
1776  ipass = ipass + 1
1777 
1778  ! Optimistically assume success.
1779  iotst = 0
1780 
1781  ! Has a model number been specified?
1782  IF (PRESENT(imod)) THEN
1783  igrd = imod
1784  ELSE
1785  igrd = 1
1786  END IF
1787 
1788  CALL w3seto(igrd, ndse, ndst)
1789  CALL w3setg(igrd, ndse, ndst)
1790  CALL w3setw(igrd, ndse, ndst)
1791 
1792  ! INXOUT must be 'READ' or 'WRITE'.
1793  IF (inxout .NE. 'READ' .AND. inxout .NE. 'WRITE') THEN
1794  WRITE (ndse, 900) inxout
1795  CALL extcde(1)
1796  END IF
1797 
1798  ! Determine filename.
1799  IF ( ofiles(2) .EQ. 1 ) THEN
1800  ! Create TIMETAG for file name using YYYYMMDD.HHMMS prefix
1801  WRITE(timetag,"(i8.8,'.'i6.6)")time(1),time(2)
1802  filename = fnmpre(:len_trim(fnmpre))//timetag//'.out_pnt.'//filext(:len_trim(filext))//'.nc'
1803  ELSE
1804  filename = fnmpre(:len_trim(fnmpre))//'out_pnt.'//filext(:len_trim(filext))//'.nc'
1805  END IF
1806 
1807  ! Do a read or a write of the point file.
1808  IF (inxout .EQ. 'READ') THEN
1809  CALL w3iopon_read(iotst, imod, filename, ncerr)
1810  ELSE
1811  CALL w3iopon_write(ofiles(2), filename, ncerr)
1812  ENDIF
1813  if (nf90_err(ncerr) .ne. 0) then
1814  WRITE(ndse,*) ' *** WAVEWATCH III ERROR IN W3IOPO :'
1815  WRITE(ndse,*) 'Nonzero return at end of W3IOPON'
1816  WRITE(ndse,*) 'Error: ', trim(nf90_strerror(ncerr))
1817  CALL extcde(21)
1818  endif
1819 
1820  !/
1821  !/ End of W3IOPON ----------------------------------------------------- /
1822  !/
1823 
1824 900 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO :'/ &
1825  ' ILEGAL INXOUT VALUE: ',a/)

References w3servmd::extcde(), w3gdatmd::filext, w3odatmd::fnmpre, w3odatmd::ipass2, w3odatmd::ndse, w3odatmd::ndst, w3odatmd::ofiles, w3servmd::strace(), w3wdatmd::time, w3iopon_read(), w3iopon_write(), w3gdatmd::w3setg(), w3odatmd::w3seto(), and w3wdatmd::w3setw().

Referenced by gxoutp(), w3ounp(), w3outp(), w3wavemd::w3wave(), and wmiopomd::wmiopo().

◆ w3iopon_read()

subroutine w3iopomd::w3iopon_read ( integer, intent(out)  IOTST,
integer, intent(in), optional  IMOD_IN,
character(*), intent(in)  filename,
integer, intent(inout)  ncerr 
)

Read point output in netCDF format.

Parameters
[out]IOTSTTest indictor for reading.
[in]IMOD_INModel number for W3GDAT etc.
[in]filenameName of file to read.
[in,out]ncerrError code, 0 for success, netCDF error code otherwise.
Author
Edward Hartnett
Date
1-Nov-2023

Definition at line 1152 of file w3iopomd.F90.

1152  USE netcdf
1153  USE w3odatmd, ONLY: w3dmo2
1154  USE w3wdatmd, ONLY: time
1155  USE w3gdatmd, ONLY: nth, nk, nspec, filext
1156  USE w3odatmd, ONLY: ndst, ndse, ipass => ipass2, nopts, iptint, &
1157  il, iw, ii, ptloc, ptifac, dpo, wao, wdo, &
1158  aso, cao, cdo, spco, ptnme, o2init, fnmpre, &
1159  grdid, iceo, iceho, icefo, w3dmo2
1160  USE w3servmd, ONLY: extcde
1161 #ifdef W3_FLX5
1162  USE w3odatmd, ONLY: tauao, taudo, dairo
1163 #endif
1164 #ifdef W3_SETUP
1165  USE w3odatmd, ONLY: zet_seto
1166 #endif
1167  IMPLICIT NONE
1168 
1169  INTEGER, INTENT(OUT) :: IOTST
1170  INTEGER, INTENT(IN), OPTIONAL :: IMOD_IN
1171  character(*), intent(in) :: filename
1172  integer, intent(inout) :: ncerr
1173  INTEGER :: IGRD,MK,MTH
1174  integer :: fh
1175  integer :: d_nopts, d_nspec, d_vsize, d_namelen, d_grdidlen, d_time, d_ww3time
1176  integer :: d_nopts_len, d_nspec_len, d_vsize_len, d_namelen_len, d_grdidlen_len, d_time_len, d_ww3time_len
1177  integer :: v_idtst, v_vertst, v_nk, v_nth, v_ptloc, v_ptnme, v_time, v_ww3time
1178  integer :: v_dpo, v_wao, v_wdo
1179 #ifdef W3_FLX5
1180  integer :: v_tauao,v_taudo, v_dairo
1181 #endif
1182 #ifdef W3_SETUP
1183  integer :: v_zet_seto
1184 #endif
1185  integer :: v_aso, v_cao, v_cdo, v_iceo
1186  integer :: v_iceho, v_icefo, v_grdid, v_spco
1187  integer :: v_title_len, v_version_len
1188  CHARACTER(LEN=31) :: IDTST
1189  CHARACTER(LEN=10) :: VERTST
1190 
1191  iotst = 0
1192 
1193  IF (PRESENT(imod_in)) THEN
1194  igrd = imod_in
1195  ELSE
1196  igrd = 1
1197  END IF
1198 
1199  ! Open the netCDF file.
1200  ncerr = nf90_open(filename, nf90_nowrite, fh)
1201  if (nf90_err(ncerr) .ne. 0) return
1202 
1203  ! Read and check the version:
1204  ncerr = nf90_inquire_attribute(fh, nf90_global, 'title', len = v_title_len)
1205  if (nf90_err(ncerr) .ne. 0) return
1206  ncerr = nf90_get_att(fh, nf90_global, 'title', idtst)
1207  if (nf90_err(ncerr) .ne. 0) return
1208  ncerr = nf90_inquire_attribute(fh, nf90_global, 'version', len = v_version_len)
1209  if (nf90_err(ncerr) .ne. 0) return
1210  ncerr = nf90_get_att(fh, nf90_global, 'version', vertst)
1211  if (nf90_err(ncerr) .ne. 0) return
1212 
1213  IF ( idtst .NE. idstr ) THEN
1214  WRITE (ndse,902) idtst, idstr
1215  CALL extcde ( 10 )
1216  END IF
1217  IF ( vertst .NE. veropt ) THEN
1218  WRITE (ndse,903) vertst, veropt
1219  CALL extcde ( 11 )
1220  END IF
1221 
1222  ! Read the dimension information for NOPTS.
1223  ncerr = nf90_inq_dimid(fh, dname_nopts, d_nopts)
1224  if (nf90_err(ncerr) .ne. 0) return
1225  ncerr = nf90_inquire_dimension(fh, d_nopts, len = d_nopts_len)
1226  if (nf90_err(ncerr) .ne. 0) return
1227  nopts=d_nopts_len
1228 
1229  ! Read the dimension information for NSPEC.
1230  ncerr = nf90_inq_dimid(fh, dname_nspec, d_nspec)
1231  if (nf90_err(ncerr) .ne. 0) return
1232  ncerr = nf90_inquire_dimension(fh, d_nspec, len = d_nspec_len)
1233  if (nf90_err(ncerr) .ne. 0) return
1234 
1235  ! Read the dimension information for VSIZE.
1236  ncerr = nf90_inq_dimid(fh, dname_vsize, d_vsize)
1237  if (nf90_err(ncerr) .ne. 0) return
1238  ncerr = nf90_inquire_dimension(fh, d_vsize, len = d_vsize_len)
1239  if (nf90_err(ncerr) .ne. 0) return
1240 
1241  ! Read the dimension information for NAMELEN.
1242  ncerr = nf90_inq_dimid(fh, dname_namelen, d_namelen)
1243  if (nf90_err(ncerr) .ne. 0) return
1244  ncerr = nf90_inquire_dimension(fh, d_namelen, len = d_namelen_len)
1245  if (nf90_err(ncerr) .ne. 0) return
1246 
1247  ! Read the dimension information for GRDIDLEN.
1248  ncerr = nf90_inq_dimid(fh, dname_grdidlen, d_grdidlen)
1249  if (nf90_err(ncerr) .ne. 0) return
1250  ncerr = nf90_inquire_dimension(fh, d_grdidlen, len = d_grdidlen_len)
1251  if (nf90_err(ncerr) .ne. 0) return
1252 
1253  ! Read the dimention information from time
1254  ncerr = nf90_inq_dimid(fh, dname_time, d_time)
1255  if (nf90_err(ncerr) .ne. 0) return
1256  ncerr = nf90_inquire_dimension(fh, d_time, len = d_time_len)
1257  if (nf90_err(ncerr) .ne. 0) return
1258 
1259  IF ( ipass .LE. d_time_len ) THEN
1260 
1261  IF ( ipass.EQ.1 ) THEN
1262 
1263  ! Read scalar variables.
1264  ncerr = nf90_inq_varid(fh, vname_nk, v_nk)
1265  if (nf90_err(ncerr) .ne. 0) return
1266  ncerr = nf90_get_var(fh, v_nk, mk)
1267  if (nf90_err(ncerr) .ne. 0) return
1268  ncerr = nf90_inq_varid(fh, vname_nth, v_nth)
1269  if (nf90_err(ncerr) .ne. 0) return
1270  ncerr = nf90_get_var(fh, v_nth, mth)
1271  if (nf90_err(ncerr) .ne. 0) return
1272 
1273  !read in written variables NK, NTH as MK and MTH
1274  !and ensure they match
1275  IF (nk.NE.mk .OR. nth.NE.mth) THEN
1276  WRITE (ndse,904) mk, mth, nk, nth
1277  CALL extcde ( 12 )
1278  END IF
1279 
1280  ! Allocate variables:
1281  IF ( .NOT. o2init ) &
1282  CALL w3dmo2 ( igrd, ndse, ndst, nopts )
1283 
1284  ! Read vars with nopts as a dimension.
1285  ncerr = nf90_inq_varid(fh, vname_ptloc, v_ptloc)
1286  if (nf90_err(ncerr) .ne. 0) return
1287  ncerr = nf90_get_var(fh, v_ptloc, ptloc, start = (/ 1, 1/), &
1288  count = (/ d_vsize_len, d_nopts_len /))
1289  if (nf90_err(ncerr) .ne. 0) return
1290  ncerr = nf90_inq_varid(fh, vname_ptnme, v_ptnme)
1291  if (nf90_err(ncerr) .ne. 0) return
1292  ncerr = nf90_get_var(fh, v_ptnme, ptnme)
1293  if (nf90_err(ncerr) .ne. 0) return
1294  END IF
1295 
1296  !Variables read based on time (IPASS):
1297 
1298  ncerr = nf90_inq_varid(fh, vname_ww3time, v_ww3time)
1299  if (nf90_err(ncerr) .ne. 0) return
1300  ncerr = nf90_get_var(fh, v_ww3time, time, start = (/ 1, ipass/), &
1301  count = (/ d_vsize_len, 1 /))
1302  if (nf90_err(ncerr) .ne. 0) return
1303 
1304  ! set IW, II and IL to 0,
1305  ! These values are set to 0 in binary file and have been removed
1306  ! from netcdf file. Possible can be completely removed.
1307  iw = 0
1308  ii = 0
1309  il = 0
1310 
1311  ncerr = nf90_inq_varid(fh, vname_dpo, v_dpo)
1312  if (nf90_err(ncerr) .ne. 0) return
1313  ncerr = nf90_get_var(fh, v_dpo, dpo, start = (/ 1, ipass/), &
1314  count = (/ nopts, 1 /))
1315  if (nf90_err(ncerr) .ne. 0) return
1316  ncerr = nf90_inq_varid(fh, vname_wao, v_wao)
1317  if (nf90_err(ncerr) .ne. 0) return
1318  ncerr = nf90_get_var(fh, v_wao, wao, start = (/ 1, ipass/), &
1319  count = (/ nopts, 1 /))
1320  if (nf90_err(ncerr) .ne. 0) return
1321  ncerr = nf90_inq_varid(fh, vname_wdo, v_wdo)
1322  if (nf90_err(ncerr) .ne. 0) return
1323  ncerr = nf90_get_var(fh, v_wdo, wdo, start = (/ 1, ipass/), &
1324  count = (/ nopts, 1 /))
1325  if (nf90_err(ncerr) .ne. 0) return
1326 #ifdef W3_FLX5
1327  ncerr = nf90_inq_varid(fh, vname_tauao, v_tauao)
1328  if (nf90_err(ncerr) .ne. 0) return
1329  ncerr = nf90_get_var(fh, v_tauao, tauao, start = (/ 1, ipass/), &
1330  count = (/ nopts, 1 /))
1331  if (nf90_err(ncerr) .ne. 0) return
1332  ncerr = nf90_inq_varid(fh, vname_taudo, v_taudo)
1333  if (nf90_err(ncerr) .ne. 0) return
1334  ncerr = nf90_get_var(fh, v_taudo, taudo, start = (/ 1, ipass/), &
1335  count = (/ nopts, 1 /))
1336  if (nf90_err(ncerr) .ne. 0) return
1337  ncerr = nf90_inq_varid(fh, vname_dairo, v_dairo)
1338  if (nf90_err(ncerr) .ne. 0) return
1339  ncerr = nf90_get_var(fh, v_dairo, dairo, start = (/ 1, ipass/), &
1340  count = (/ nopts, 1 /))
1341  if (nf90_err(ncerr) .ne. 0) return
1342 #endif
1343 #ifdef W3_SETUP
1344  ncerr = nf90_inq_varid(fh, zet_seto, v_zet_seto)
1345  if (nf90_err(ncerr) .ne. 0) return
1346  ncerr = nf90_get_var(fh, v_zet_seto, zet_seto, start = (/ 1, ipass/), &
1347  count = (/ nopts, 1 /))
1348  if (nf90_err(ncerr) .ne. 0) return
1349 #endif
1350  ncerr = nf90_inq_varid(fh, vname_aso, v_aso)
1351  if (nf90_err(ncerr) .ne. 0) return
1352  ncerr = nf90_get_var(fh, v_aso, aso, start = (/ 1, ipass/), &
1353  count = (/ nopts, 1 /))
1354  if (nf90_err(ncerr) .ne. 0) return
1355  ncerr = nf90_inq_varid(fh, vname_cao, v_cao)
1356  if (nf90_err(ncerr) .ne. 0) return
1357  ncerr = nf90_get_var(fh, v_cao, cao, start = (/ 1, ipass/), &
1358  count = (/ nopts, 1 /))
1359  if (nf90_err(ncerr) .ne. 0) return
1360  ncerr = nf90_inq_varid(fh, vname_cdo, v_cdo)
1361  if (nf90_err(ncerr) .ne. 0) return
1362  ncerr = nf90_get_var(fh, v_cdo, cdo, start = (/ 1, ipass/), &
1363  count = (/ nopts, 1 /))
1364  if (nf90_err(ncerr) .ne. 0) return
1365  ncerr = nf90_inq_varid(fh, vname_iceo, v_iceo)
1366  if (nf90_err(ncerr) .ne. 0) return
1367  ncerr = nf90_get_var(fh, v_iceo, iceo, start = (/ 1, ipass/), &
1368  count = (/ nopts, 1 /))
1369  if (nf90_err(ncerr) .ne. 0) return
1370  ncerr = nf90_inq_varid(fh, vname_iceho, v_iceho)
1371  if (nf90_err(ncerr) .ne. 0) return
1372  ncerr = nf90_get_var(fh, v_iceho, iceho, start = (/ 1, ipass/), &
1373  count = (/ nopts, 1 /))
1374  if (nf90_err(ncerr) .ne. 0) return
1375  ncerr = nf90_inq_varid(fh, vname_icefo, v_icefo)
1376  if (nf90_err(ncerr) .ne. 0) return
1377  ncerr = nf90_get_var(fh, v_icefo, icefo, start = (/ 1, ipass/), &
1378  count = (/ nopts, 1 /))
1379  if (nf90_err(ncerr) .ne. 0) return
1380  ncerr = nf90_inq_varid(fh, vname_grdid, v_grdid)
1381  if (nf90_err(ncerr) .ne. 0) return
1382  ncerr = nf90_get_var(fh, v_grdid, grdid, start = (/ 1, 1, ipass/), &
1383  count = (/ 13, nopts, 1 /))
1384  if (nf90_err(ncerr) .ne. 0) return
1385  ncerr = nf90_inq_varid(fh, vname_spco, v_spco)
1386  if (nf90_err(ncerr) .ne. 0) return
1387  ncerr = nf90_get_var(fh, v_spco, spco, start = (/ 1, 1, ipass/), &
1388  count = (/nspec, nopts, 1 /))
1389  if (nf90_err(ncerr) .ne. 0) return
1390 
1391  ELSE
1392  ! Set flag to indicate IPASS > d_time_len
1393  ! and are at the end of the
1394  iotst = -1
1395  END IF
1396 
1397  ! Close the file.
1398  ncerr = nf90_close(fh)
1399  if (nf90_err(ncerr) .ne. 0) return
1400 
1401 902 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPON :'/ &
1402  ' ILEGAL IDSTR, READ : ',a/ &
1403  ' CHECK : ',a/)
1404 903 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPON :'/ &
1405  ' ILEGAL VEROPT, READ : ',a/ &
1406  ' CHECK : ',a/)
1407 904 FORMAT (/' *** WAVEWATCH III ERROR IN W3IOPO :'/ &
1408  ' ERROR IN SPECTRA, MK, MTH : ',2i8/ &
1409  ' ARRAY DIMENSIONS : ',2i8/)
1410 
1411 

References w3odatmd::aso, w3odatmd::dpo, w3servmd::extcde(), w3gdatmd::filext, w3odatmd::fnmpre, w3odatmd::grdid, w3odatmd::ii, w3odatmd::il, w3odatmd::ipass2, w3odatmd::iptint, w3odatmd::iw, w3odatmd::ndse, w3odatmd::ndst, w3gdatmd::nk, w3odatmd::nopts, w3gdatmd::nspec, w3gdatmd::nth, w3odatmd::o2init, w3odatmd::ptifac, w3odatmd::ptloc, w3odatmd::ptnme, w3wdatmd::time, w3odatmd::w3dmo2(), w3odatmd::wao, w3odatmd::wdo, and w3odatmd::zet_seto.

Referenced by w3iopon(), and w3outp().

◆ w3iopon_write()

subroutine w3iopomd::w3iopon_write ( integer, intent(in)  timestep_only,
character(*), intent(in)  filename,
integer, intent(inout)  ncerr 
)

Write point output in netCDF format.

Parameters
[in]filenameName of file to write.
[in]timestep_onlyWill be 0 if whole model run should be written, 1 if only one timestep should be written.
[in,out]ncerrError code, 0 for success, netCDF error code otherwise.
Author
Edward Hartnett
Date
1-Nov-2023

Definition at line 1427 of file w3iopomd.F90.

1427  USE netcdf
1428  USE w3gdatmd, ONLY: nth, nk, nspec
1429  USE w3wdatmd, ONLY: time
1430  USE w3odatmd, ONLY: ndst, ndse, ipass => ipass2, nopts, iptint, &
1431  ptloc, ptifac, dpo, wao, wdo, &
1432  aso, cao, cdo, spco, ptnme, o2init, fnmpre, &
1433  grdid, iceo, iceho, icefo
1434  USE w3timemd, ONLY: caltype, t2d, u2d, tsub
1435 #ifdef W3_FLX5
1436  USE w3odatmd, ONLY: tauao, taudo, dairo
1437 #endif
1438 #ifdef W3_SETUP
1439  USE w3odatmd, ONLY: zet_seto
1440 #endif
1441 
1442  IMPLICIT NONE
1443  integer, intent(in) :: timestep_only ! 1 if only timestep should be written.
1444  character(*), intent(in) :: filename
1445  integer, intent(inout) :: ncerr
1446  integer :: ndim, nvar, fmt, itime, fh
1447  integer :: d_nopts, d_nspec, d_vsize, d_namelen, d_grdidlen, d_time
1448  integer :: v_idtst, v_vertst, v_nk, v_nth, v_ptloc, v_ptnme, v_time, v_ww3time
1449  integer :: v_dpo, v_wao, v_wdo
1450 #ifdef W3_FLX5
1451  integer :: v_tauao, v_taudo, v_dairo
1452 #endif
1453 #ifdef W3_SETUP
1454  integer :: v_zet_seto
1455 #endif
1456  integer :: v_aso, v_cao, v_cdo, v_iceo
1457  integer :: v_iceho, v_icefo, v_grdid, v_spco
1458  integer :: curdate(8), refdate(8),ierr
1459  double precision :: outjulday
1460 
1461  !If first pass, or if you are writting a file for every time-step:
1462  IF ( ipass.EQ.1 .OR. timestep_only.EQ.1 ) THEN
1463  ! Create the netCDF file.
1464  ncerr = nf90_create(filename, nf90_netcdf4, fh)
1465  if (nf90_err(ncerr) .ne. 0) return
1466 
1467  ! Define dimensions.
1468  ncerr = nf90_def_dim(fh, dname_nopts, nopts, d_nopts)
1469  if (nf90_err(ncerr) .ne. 0) return
1470  ncerr = nf90_def_dim(fh, dname_nspec, nspec, d_nspec)
1471  if (nf90_err(ncerr) .ne. 0) return
1472  ncerr = nf90_def_dim(fh, dname_vsize, 2, d_vsize)
1473  if (nf90_err(ncerr) .ne. 0) return
1474  ncerr = nf90_def_dim(fh, dname_namelen, 40, d_namelen)
1475  if (nf90_err(ncerr) .ne. 0) return
1476  ncerr = nf90_def_dim(fh, dname_grdidlen, 13, d_grdidlen)
1477  if (nf90_err(ncerr) .ne. 0) return
1478  ncerr = nf90_def_dim(fh, dname_time, nf90_unlimited, d_time)
1479  if (nf90_err(ncerr) .ne. 0) return
1480 
1481  ! Define global attributes.
1482  ncerr = nf90_put_att(fh, nf90_global, 'title', idstr)
1483  if (nf90_err(ncerr) .ne. 0) return
1484  ncerr = nf90_put_att(fh, nf90_global, 'version', veropt)
1485  if (nf90_err(ncerr) .ne. 0) return
1486 
1487  ! Define scalar variables.
1488  ncerr = nf90_def_var(fh, vname_nk, nf90_int, v_nk)
1489  if (nf90_err(ncerr) .ne. 0) return
1490  ncerr = nf90_def_var(fh, vname_nth, nf90_int, v_nth)
1491  if (nf90_err(ncerr) .ne. 0) return
1492 
1493  ! Define vars with nopts as a dimension. Point location and name
1494  ncerr = nf90_def_var(fh, vname_ptloc, nf90_float, (/d_vsize, d_nopts/), v_ptloc)
1495  if (nf90_err(ncerr) .ne. 0) return
1496  ncerr = nf90_def_var(fh, vname_ptnme, nf90_char, (/d_namelen, d_nopts/), v_ptnme)
1497  if (nf90_err(ncerr) .ne. 0) return
1498 
1499  ! Define time for each time step
1500  ncerr = nf90_def_var(fh, vname_ww3time, nf90_int, (/d_vsize, d_time/),v_ww3time)
1501  if (nf90_err(ncerr) .ne. 0) return
1502  ncerr = nf90_def_var(fh, vname_time, nf90_double, (/d_time/),v_time)
1503  if (nf90_err(ncerr) .ne. 0) return
1504  SELECT CASE (trim(caltype))
1505  CASE ('360_day')
1506  ncerr = nf90_put_att(fh, v_time, 'long_name', 'time in 360 day calendar')
1507  if (nf90_err(ncerr) .ne. 0) return
1508  CASE ('365_day')
1509  ncerr = nf90_put_att(fh, v_time, 'long_name', 'time in 365 day calendar')
1510  if (nf90_err(ncerr) .ne. 0) return
1511  CASE ('standard')
1512  ncerr = nf90_put_att(fh, v_time, 'long_name', 'Julian day (UT)')
1513  if (nf90_err(ncerr) .ne. 0) return
1514  END SELECT
1515  ncerr = nf90_put_att(fh, v_time, 'standard_name', 'time')
1516  if (nf90_err(ncerr) .ne. 0) return
1517  ncerr = nf90_put_att(fh, v_time, 'units', 'days since 1990-01-01 00:00:00')
1518  if (nf90_err(ncerr) .ne. 0) return
1519  ncerr = nf90_put_att(fh, v_time, 'conventions','Relative Julian days with decimal part (as parts of the day)')
1520  if (nf90_err(ncerr) .ne. 0) return
1521  ncerr = nf90_put_att(fh, v_time, 'axis', 'T')
1522  if (nf90_err(ncerr) .ne. 0) return
1523  ncerr = nf90_put_att(fh, v_time, 'calendar', trim(caltype))
1524  if (nf90_err(ncerr) .ne. 0) return
1525 
1526  ! Define vars with nopts and time as dimensions
1527  ncerr = nf90_def_var(fh, vname_dpo, nf90_float, (/d_nopts, d_time/), v_dpo)
1528  if (nf90_err(ncerr) .ne. 0) return
1529  ncerr = nf90_def_var(fh, vname_wao, nf90_float, (/d_nopts, d_time/), v_wao)
1530  if (nf90_err(ncerr) .ne. 0) return
1531  ncerr = nf90_def_var(fh, vname_wdo, nf90_float, (/d_nopts, d_time/), v_wdo)
1532  if (nf90_err(ncerr) .ne. 0) return
1533 #ifdef W3_FLX5
1534  ncerr = nf90_def_var(fh, vname_tauao, nf90_float, (/d_nopts, d_time/), v_tauao)
1535  if (nf90_err(ncerr) .ne. 0) return
1536  ncerr = nf90_def_var(fh, vname_taudo, nf90_float, (/d_nopts, d_time/), v_taudo)
1537  if (nf90_err(ncerr) .ne. 0) return
1538  ncerr = nf90_def_var(fh, vname_dairo, nf90_float, (/d_nopts, d_time/), v_dairo)
1539  if (nf90_err(ncerr) .ne. 0) return
1540 #endif
1541 #ifdef W3_SETUP
1542  ncerr = nf90_def_var(fh, vname_zet_seto, nf90_float, (/d_nopts, d_time/), v_zet_seto)
1543  if (nf90_err(ncerr) .ne. 0) return
1544 #endif
1545  ncerr = nf90_def_var(fh, vname_aso, nf90_float, (/d_nopts, d_time/), v_aso)
1546  if (nf90_err(ncerr) .ne. 0) return
1547  ncerr = nf90_def_var(fh, vname_cao, nf90_float, (/d_nopts, d_time/), v_cao)
1548  if (nf90_err(ncerr) .ne. 0) return
1549  ncerr = nf90_def_var(fh, vname_cdo, nf90_float, (/d_nopts, d_time/), v_cdo)
1550  if (nf90_err(ncerr) .ne. 0) return
1551  ncerr = nf90_def_var(fh, vname_iceo, nf90_float, (/d_nopts, d_time/), v_iceo)
1552  if (nf90_err(ncerr) .ne. 0) return
1553  ncerr = nf90_def_var(fh, vname_iceho, nf90_float, (/d_nopts, d_time/), v_iceho)
1554  if (nf90_err(ncerr) .ne. 0) return
1555  ncerr = nf90_def_var(fh, vname_icefo, nf90_float, (/d_nopts, d_time/), v_icefo)
1556  if (nf90_err(ncerr) .ne. 0) return
1557  ncerr = nf90_def_var(fh, vname_grdid, nf90_char, (/d_grdidlen, d_nopts, d_time/), v_grdid)
1558  if (nf90_err(ncerr) .ne. 0) return
1559 
1560  ! Define spectral output with dimensions nspec, nopts and time
1561  ncerr = nf90_def_var(fh, vname_spco, nf90_float, (/d_nspec, d_nopts, d_time/), v_spco)
1562  if (nf90_err(ncerr) .ne. 0) return
1563 
1564  ! End of all variable definitions
1565  ncerr = nf90_enddef(fh)
1566  if (nf90_err(ncerr) .ne. 0) return
1567 
1568  ! Write the scalar data.
1569  ncerr = nf90_put_var(fh, v_nk, nk)
1570  if (nf90_err(ncerr) .ne. 0) return
1571  ncerr = nf90_put_var(fh, v_nth, nth)
1572  if (nf90_err(ncerr) .ne. 0) return
1573 
1574  ! Write the data with NOPTS as a dimension. (no time dimension)
1575  if (associated(ptloc)) then
1576  ncerr = nf90_put_var(fh, v_ptloc, ptloc(:,1:nopts))
1577  if (nf90_err(ncerr) .ne. 0) return
1578  endif
1579  if (associated(ptnme)) then
1580  ncerr = nf90_put_var(fh, v_ptnme, ptnme(1:nopts))
1581  if (nf90_err(ncerr) .ne. 0) return
1582  endif
1583 
1584  ELSE
1585  ! If we are writing to the same file, re-open the file
1586  ncerr = nf90_open(filename, nf90_write, fh)
1587  if (nf90_err(ncerr) .ne. 0) return
1588  END IF
1589 
1590  !Determine the start for the time dimension
1591  IF ( timestep_only.EQ.1 ) THEN
1592  itime=1
1593  ELSE
1594  itime=ipass
1595  END IF
1596 
1597  ! Write Time
1598  IF ( itime > 1 ) THEN
1599  ncerr = nf90_inq_varid(fh, vname_ww3time, v_ww3time)
1600  if (nf90_err(ncerr) .ne. 0) return
1601  ncerr = nf90_inq_varid(fh, vname_time, v_time)
1602  if (nf90_err(ncerr) .ne. 0) return
1603  END IF
1604  ncerr = nf90_put_var(fh, v_ww3time, time, start = (/ 1, itime/), &
1605  count = (/ 2, 1 /))
1606  if (nf90_err(ncerr) .ne. 0) return
1607 
1608  CALL u2d('days since 1990-01-01 00:00:00',refdate,ierr)
1609  CALL t2d(time,curdate,ierr)
1610  outjulday=tsub(refdate,curdate)
1611 
1612  ncerr = nf90_put_var(fh, v_time, outjulday, start = (/itime/))
1613  if (nf90_err(ncerr) .ne. 0) return
1614 
1615 
1616  ! If itime > 1 need to inquire varid
1617  IF ( itime > 1 ) THEN
1618  ncerr = nf90_inq_varid(fh, vname_dpo, v_dpo)
1619  if (nf90_err(ncerr) .ne. 0) return
1620  ncerr = nf90_inq_varid(fh, vname_wao, v_wao)
1621  if (nf90_err(ncerr) .ne. 0) return
1622  ncerr = nf90_inq_varid(fh, vname_wdo, v_wdo)
1623  if (nf90_err(ncerr) .ne. 0) return
1624 #ifdef W3_FLX5
1625  ncerr = nf90_inq_varid(fh, vname_tauao, v_tauao)
1626  if (nf90_err(ncerr) .ne. 0) return
1627  ncerr = nf90_inq_varid(fh, vname_taudo, v_taudo)
1628  if (nf90_err(ncerr) .ne. 0) return
1629  ncerr = nf90_inq_varid(fh, vname_dairo, v_dairo)
1630  if (nf90_err(ncerr) .ne. 0) return
1631 #endif
1632 #ifdef W3_SETUP
1633  ncerr = nf90_inq_varid(fh, vname_zet_seto, v_zet_seto)
1634  if (nf90_err(ncerr) .ne. 0) return
1635 #endif
1636  ncerr = nf90_inq_varid(fh, vname_aso, v_aso)
1637  if (nf90_err(ncerr) .ne. 0) return
1638  ncerr = nf90_inq_varid(fh, vname_cao, v_cao)
1639  if (nf90_err(ncerr) .ne. 0) return
1640  ncerr = nf90_inq_varid(fh, vname_cdo, v_cdo)
1641  if (nf90_err(ncerr) .ne. 0) return
1642  ncerr = nf90_inq_varid(fh, vname_iceo, v_iceo)
1643  if (nf90_err(ncerr) .ne. 0) return
1644  ncerr = nf90_inq_varid(fh, vname_iceho, v_iceho)
1645  if (nf90_err(ncerr) .ne. 0) return
1646  ncerr = nf90_inq_varid(fh, vname_icefo, v_icefo)
1647  if (nf90_err(ncerr) .ne. 0) return
1648  ncerr = nf90_inq_varid(fh, vname_grdid, v_grdid)
1649  if (nf90_err(ncerr) .ne. 0) return
1650  ncerr = nf90_inq_varid(fh, vname_spco, v_spco)
1651  if (nf90_err(ncerr) .ne. 0) return
1652  END IF
1653 
1654  ncerr = nf90_put_var(fh, v_dpo, dpo, start = (/ 1, itime/), &
1655  count = (/ nopts, 1 /))
1656  if (nf90_err(ncerr) .ne. 0) return
1657 
1658  ncerr = nf90_put_var(fh, v_wao, wao, start = (/ 1, itime/), &
1659  count = (/ nopts, 1 /))
1660  if (nf90_err(ncerr) .ne. 0) return
1661 
1662  ncerr = nf90_put_var(fh, v_wdo, wdo, start = (/ 1, itime/), &
1663  count = (/ nopts, 1 /))
1664  if (nf90_err(ncerr) .ne. 0) return
1665 
1666 #ifdef W3_FLX5
1667  ncerr = nf90_put_var(fh, v_tauao, tauao, start = (/ 1, itime/), &
1668  count = (/ nopts, 1 /))
1669  if (nf90_err(ncerr) .ne. 0) return
1670 
1671  ncerr = nf90_put_var(fh, v_taudo, taudo, start = (/ 1, itime/), &
1672  count = (/ nopts, 1 /))
1673  if (nf90_err(ncerr) .ne. 0) return
1674 
1675  ncerr = nf90_put_var(fh, v_dairo, dairo, start = (/ 1, itime/), &
1676  count = (/ nopts, 1 /))
1677  if (nf90_err(ncerr) .ne. 0) return
1678 #endif
1679 #ifdef W3_SETUP
1680  ncerr = nf90_put_var(fh, v_zet_seto, zet_seto, start = (/ 1, itime/), &
1681  count = (/ nopts, 1 /))
1682  if (nf90_err(ncerr) .ne. 0) return
1683 #endif
1684  ncerr = nf90_put_var(fh, v_aso, aso, start = (/ 1, itime/), &
1685  count = (/ nopts, 1 /))
1686  if (nf90_err(ncerr) .ne. 0) return
1687 
1688  ncerr = nf90_put_var(fh, v_cao, cao, start = (/ 1, itime/), &
1689  count = (/ nopts, 1 /))
1690  if (nf90_err(ncerr) .ne. 0) return
1691 
1692  ncerr = nf90_put_var(fh, v_cdo, cdo, start = (/ 1, itime/), &
1693  count = (/ nopts, 1 /))
1694  if (nf90_err(ncerr) .ne. 0) return
1695 
1696  ncerr = nf90_put_var(fh, v_iceo, iceo, start = (/ 1, itime/), &
1697  count = (/ nopts, 1 /))
1698  if (nf90_err(ncerr) .ne. 0) return
1699 
1700  ncerr = nf90_put_var(fh, v_iceho, iceho, start = (/ 1, itime/), &
1701  count = (/ nopts, 1 /))
1702  if (nf90_err(ncerr) .ne. 0) return
1703 
1704  ncerr = nf90_put_var(fh, v_icefo, icefo, start = (/ 1, itime/), &
1705  count = (/ nopts, 1 /))
1706  if (nf90_err(ncerr) .ne. 0) return
1707 
1708  ncerr = nf90_put_var(fh, v_grdid, grdid, start = (/ 1, 1, itime/), &
1709  count = (/ 13, nopts, 1 /))
1710  if (nf90_err(ncerr) .ne. 0) return
1711 
1712  !write spectral output
1713  ncerr = nf90_put_var(fh, v_spco, spco, start = (/ 1, 1, itime/), &
1714  count = (/nspec, nopts, 1 /))
1715  if (nf90_err(ncerr) .ne. 0) return
1716 
1717  ! Close the file.
1718  ncerr = nf90_close(fh)
1719  if (nf90_err(ncerr) .ne. 0) return
1720 

References w3odatmd::aso, w3timemd::caltype, w3odatmd::dpo, w3odatmd::fnmpre, w3odatmd::grdid, w3odatmd::ipass2, w3odatmd::iptint, w3odatmd::ndse, w3odatmd::ndst, w3gdatmd::nk, w3odatmd::nopts, w3gdatmd::nspec, w3gdatmd::nth, w3odatmd::o2init, w3odatmd::ptifac, w3odatmd::ptloc, w3odatmd::ptnme, w3timemd::t2d(), w3wdatmd::time, w3timemd::tsub(), w3timemd::u2d(), w3odatmd::wao, w3odatmd::wdo, and w3odatmd::zet_seto.

Referenced by w3iopon(), and w3outp().

◆ w3iopp()

subroutine w3iopomd::w3iopp ( integer, intent(in)  NPT,
real, dimension(npt), intent(inout)  XPT,
real, dimension(npt), intent(inout)  YPT,
character(len=40), dimension(npt), intent(in)  PNAMES,
integer, intent(in)  IMOD 
)

Preprocessing of point output.

Check location of points in grid and calculate interpolation factors.

Parameters
[in]NPTNumber of output points in input.
[in,out]XPTX (longitude) coordinates of output points.
[in,out]YPTY (latitude) coordinates of output points.
[in]PNAMESNames of output points.
[in]IMODGrid ID number.
Author
H. L. Tolman
Date
02-Sep-2012

Definition at line 230 of file w3iopomd.F90.

230  !/
231  !/ +-----------------------------------+
232  !/ | WAVEWATCH III NOAA/NCEP |
233  !/ | H. L. Tolman |
234  !/ | FORTRAN 90 |
235  !/ | Last update : 02-Sep-2012 |
236  !/ +-----------------------------------+
237  !/
238  !/ 14-Jan-1999 : Distributed FORTRAN 77 version. ( version 1.18 )
239  !/ 30-Dec-1999 : Upgrade to FORTRAN 90 ( version 2.00 )
240  !/ Major changes to logistics.
241  !/ 24-Jan-2001 : Flat grid version. ( version 2.06 )
242  !/ 09-Nov-2004 : Multiple grid version. ( version 3.06 )
243  !/ 25-Jul-2006 : Adding grid ID per point. ( version 3.10 )
244  !/ 01-May-2007 : Move O7a output from W3INIT. ( version 3.11 )
245  !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 )
246  !/ (W. E. Rogers & T. J. Campbell, NRL)
247  !/ 30-Oct-2009 : Implement curvilinear grid type. ( version 3.14 )
248  !/ (W. E. Rogers & T. J. Campbell, NRL)
249  !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
250  !/ specify index closure for a grid. ( version 3.14 )
251  !/ (T. J. Campbell, NRL)
252  !/ 12-Jun-2012 : Add /RTD option or rotated grid option.
253  !/ (Jian-Guo Li) ( version 4.06 )
254  !/ 02-Sep-2012 : Clean up of open BC for UG grids ( version 4.07 )
255  !/ 01-Mar-2018 : Add option to unrotate spectra ( version 6.02 )
256  !/ from RTD grid models
257  !/
258  ! 1. Purpose :
259  !
260  ! Preprocessing of point output.
261  !
262  ! 2. Method :
263  !
264  ! Check location of points in grid and calculate interpolation
265  ! factors.
266  !
267  ! 3. Parameters :
268  !
269  ! Parameter list
270  ! ----------------------------------------------------------------
271  ! NPT Int. I Number of output points in input.
272  ! XPT R.A. I/O X (longitude) coordinates of output points.
273  ! YPT R.A. I/O Id. Y.
274  ! PNAMES C*40 I Names of output points.
275  ! IMOD Int. I Grid ID number.
276  ! ----------------------------------------------------------------
277  !
278  ! Local data
279  ! ----------------------------------------------------------------
280  ! ACC Real "Accuracy" factor to determine if output point
281  ! is grid point.
282  ! ----------------------------------------------------------------
283  !
284  ! 4. Subroutines used :
285  !
286  ! See module documentation.
287  !
288  ! 5. Called by :
289  !
290  ! Name Type Module Description
291  ! ----------------------------------------------------------------
292  ! W3INIT Subr. W3INITMD Wave model initialization routine.
293  ! ----------------------------------------------------------------
294  !
295  ! 6. Error messages :
296  !
297  ! - Warnings for points out of the grid or on land.
298  !
299  ! 7. Remarks :
300  !
301  ! - The output points are obtained by bi-linear interpolation from
302  ! the spectra at the grid points. Given the possibility of ice
303  ! coverage, the actual interpolation factors can only be
304  ! determined at the actual output time. Hence only the basic
305  ! bilinear interpolation factors are stored.
306  ! - Implementation of the /O7a diagnostic output section is
307  ! currently incomplete and non-functional for curvilinear grids
308  ! and/or tripole grids
309  !
310  ! 8. Structure :
311  !
312  ! -------------------------------------------
313  ! Determine grid range
314  ! do for all defined points
315  ! -----------------------------------------
316  ! Check if point within grid
317  ! Calculate interpolation data
318  ! Check if point not on land
319  ! Store interpolation data
320  ! -------------------------------------------
321  !
322  ! 9. Switches :
323  !
324  ! !/S Enable subroutine tracing.
325  ! !/T Test output.
326  !
327  ! !/O7a Diagnostic output for output points.
328  !
329  ! 10. Source code :
330  !
331  !/ ------------------------------------------------------------------- /
332  USE w3gsrumd
333  USE w3gdatmd, ONLY: nth, nk, nspec, nx, ny, x0, y0, sx, gsu,&
334  rlgtype, clgtype, ungtype, gtype, flagll, &
335  iclose,iclose_none,iclose_smpl,iclose_trpl, &
336  mapsta, mapfs, filext, zb, trnx, trny
337  USE w3gdatmd, ONLY: trigp,maxx, maxy, dxymax
338 #ifdef W3_RTD
339  !! Use rotated N-Pole lat/lon and conversion sub. JGLi12Jun2012
340  USE w3gdatmd, ONLY: polat, polon, flagunr
341  USE w3servmd, ONLY: w3lltoeq
342 #endif
343  USE w3odatmd, ONLY: w3dmo2
344  USE w3odatmd, ONLY: ndse, ndst, iaproc, naperr, napout, screen, &
345  nopts, ptloc, ptnme, grdid, iptint, ptifac
346  USE w3servmd, ONLY: extcde
347 #ifdef W3_S
348  USE w3servmd, ONLY: strace
349 #endif
350  USE w3triamd
351  !
352  IMPLICIT NONE
353  !/
354  !/ ------------------------------------------------------------------- /
355  !/ Parameter list
356  !/
357  INTEGER, INTENT(IN) :: NPT, IMOD
358  REAL, INTENT(INOUT) :: XPT(NPT), YPT(NPT)
359  CHARACTER(LEN=40),INTENT(IN) :: PNAMES(NPT)
360  !/
361  !/ ------------------------------------------------------------------- /
362  !/ Local parameters
363  !/
364  LOGICAL :: INGRID
365  INTEGER :: IPT, J, K
366  INTEGER :: IX1, IY1, IXS, IYS
367 #ifdef W3_S
368  INTEGER, SAVE :: IENT = 0
369 #endif
370  INTEGER :: IX(4), IY(4) ! Indices of points used in interp.
371  REAL :: RD(4) ! Interpolation coefficient
372  REAL, PARAMETER :: ACC = 0.05
373  REAL :: FACTOR
374  INTEGER :: ITOUT ! Triangle index in unstructured grids
375 #ifdef W3_O7a
376  INTEGER :: IX0, IXN, IY0, IYN, NNX, &
377  KX, KY, JX, IIX, IX2, IY2, IS1
378  REAL :: RD1, RD2, RDTOT, ZBOX(4), DEPTH
379  CHARACTER(LEN=1) :: SEA(5), LND(5), OUT(5)
380  CHARACTER(LEN=9) :: PARTS
381  CHARACTER(LEN=1), ALLOCATABLE :: STRING(:), LINE1(:), LINE2(:)
382  !
383  DATA sea / ' ', 's', 'e', 'a', ' ' /
384  DATA lnd / ' ', 'l', 'n', 'd', ' ' /
385  DATA out / ' ', 'x', 'x', 'x', ' ' /
386 #endif
387  !/
388 #ifdef W3_RTD
389  !! Declare a few temporary variables for rotated grid. JGLi12Jun2012
390  REAL, ALLOCATABLE :: EquLon(:),EquLat(:),StdLon(:),StdLat(:),AnglPT(:)
391 #endif
392  !/
393  !/ ------------------------------------------------------------------- /
394  !/
395 #ifdef W3_S
396  CALL strace (ient, 'W3IOPP')
397 #endif
398  !
399  IF ( flagll ) THEN
400  factor = 1.
401  ELSE
402  factor = 1.e-3
403  END IF
404  !
405  CALL w3dmo2 ( imod, ndse, ndst, npt )
406  grdid = filext
407  !
408  nopts = 0
409  !
410 #ifdef W3_RTD
411  !! Convert standard lon/lat to rotated lon/lat JGLi12Jun2012
412  ALLOCATE( equlon(npt), equlat(npt), &
413  & stdlon(npt), stdlat(npt), anglpt(npt) )
414 
415  stdlon = xpt
416  stdlat = ypt
417 
418  CALL w3lltoeq ( stdlat, stdlon, equlat, equlon, &
419  & anglpt, polat, polon, npt )
420 
421  xpt = equlon
422  ypt = equlat
423 
424 #endif
425  !
426  ! Removed by F.A. 2011/04/04 /T CALL W3GSUP( GSU, NDST )
427  !
428  ! Loop over output points
429  !
430  DO ipt=1, npt
431  !
432 #ifdef W3_T
433  WRITE (ndst,9010) ipt, xpt(ipt), ypt(ipt), pnames(ipt)
434 #endif
435  !
436 #ifdef W3_RTD
437  !! Need to wrap rotated Elon values greater than X0. JGLi12Jun2012
438  xpt(ipt) = mod( equlon(ipt)+360.0, 360.0 )
439  IF( xpt(ipt) .LT. x0 ) xpt(ipt) = xpt(ipt) + 360.0
440 #endif
441  !
442  ! Check if point within grid and compute interpolation weights
443  !
444  IF (gtype .NE. ungtype) THEN
445  ingrid = w3grmp( gsu, xpt(ipt), ypt(ipt), ix, iy, rd )
446  ELSE
447  CALL is_in_ungrid(imod, dble(xpt(ipt)), dble(ypt(ipt)), itout, ix, iy, rd)
448  ingrid = (itout.GT.0)
449  END IF
450  !
451  IF ( .NOT.ingrid ) THEN
452  IF ( iaproc .EQ. naperr ) THEN
453  IF ( flagll ) THEN
454  WRITE (ndse,1000) xpt(ipt), ypt(ipt), pnames(ipt)
455  ELSE
456  WRITE (ndse,1001) xpt(ipt), ypt(ipt), pnames(ipt)
457  END IF
458  END IF
459  cycle
460  END IF
461  !
462 #ifdef W3_T
463  DO k = 1,4
464  WRITE (ndst,9012) ix(k), iy(k), rd(k)
465  END DO
466 #endif
467  !
468  ! Check if point not on land
469  !
470  IF ( mapsta(iy(1),ix(1)) .EQ. 0 .AND. &
471  mapsta(iy(2),ix(2)) .EQ. 0 .AND. &
472  mapsta(iy(3),ix(3)) .EQ. 0 .AND. &
473  mapsta(iy(4),ix(4)) .EQ. 0 ) THEN
474  IF ( iaproc .EQ. naperr ) THEN
475  IF ( flagll ) THEN
476  WRITE (ndse,1002) xpt(ipt), ypt(ipt), pnames(ipt)
477  ELSE
478  WRITE (ndse,1003) xpt(ipt), ypt(ipt), pnames(ipt)
479  END IF
480  END IF
481  cycle
482  END IF
483  !
484  ! Store interpolation data
485  !
486  nopts = nopts + 1
487  !
488  ptloc(1,nopts) = xpt(ipt)
489  ptloc(2,nopts) = ypt(ipt)
490 #ifdef W3_RTD
491  !! Store the standard lon/lat in PTLOC for output purpose, assuming
492  !! they are not used for any inside calculation. JGLi12Jun2012
493  ptloc(1,nopts) = stdlon(ipt)
494  ptloc(2,nopts) = stdlat(ipt)
495 #endif
496  !
497  DO k = 1,4
498  iptint(1,k,nopts) = ix(k)
499  iptint(2,k,nopts) = iy(k)
500  ptifac(k,nopts) = rd(k)
501  END DO
502 
503  ptnme(nopts) = pnames(ipt)
504  !
505  END DO ! End loop over output points (IPT).
506  !
507 #ifdef W3_RTD
508  DEALLOCATE( equlon, equlat, stdlon, stdlat, anglpt )
509 #endif
510  !
511  ! Diagnostic output
512  !
513 #ifdef W3_O7a
514  IF ( iaproc .EQ. napout ) THEN
515  WRITE (screen,940) nopts
516  DO j=1, nopts
517  !
518  WRITE (screen,941) ptnme(j), ptloc(:,j)*factor
519  ix(:) = iptint(1,:,j)
520  iy(:) = iptint(2,:,j)
521  rd(:) = ptifac(:,j)
522  WRITE (screen,942) (ix(k),iy(k),rd(k),k=1,4)
523  !
524  zbox = 0.
525  rdtot = 0.
526  DO k = 1,4
527  IF ( mapfs(iy(k),ix(k)) .GT. 0 ) THEN
528  zbox(k) = zb(ix(k))
529  rdtot = rdtot + rd(k)
530  END IF
531  END DO
532  rdtot = max( 1.e-7 , rdtot )
533  !
534  depth = - ( rd(1)*zbox(1) + &
535  rd(2)*zbox(2) + &
536  rd(3)*zbox(3) + &
537  rd(4)*zbox(4) ) / rdtot
538  WRITE (screen,943) depth
539  !
540  ! *** implementation of O7a option with curvilinear grids is incomplete ***
541  !
542  IF ( rd1 .LT. 0.05 ) ix2 = ix1
543  IF ( rd1 .GT. 0.95 ) ix1 = ix2
544  IF ( rd2 .LT. 0.05 ) iy2 = iy1
545  IF ( rd2 .GT. 0.95 ) iy1 = iy2
546  ix0 = ix1 - 1
547  ixn = ix2 + 1
548  iy0 = max( 1 , iy1 - 1 )
549  iyn = min( iy2 + 1 , ny )
550  nnx = 13 * ( ixn - ix0 + 1 )
551  !
552  ALLOCATE ( string(nnx), line1(nnx), line2(nnx) )
553  DO kx=1, nnx
554  line1(kx) = ' '
555  line2(kx) = '-'
556  END DO
557  DO kx=7, nnx, 13
558  line1(kx) = '|'
559  line2(kx) = '+'
560  END DO
561  !
562  IF ( iclose.NE.iclose_none ) THEN
563  WRITE (screen,945) (1+mod(kx+nx-1,nx),kx=ix0,ixn)
564  ELSE
565  WRITE (screen,945) (kx,kx=ix0,ixn)
566  END IF
567  WRITE (screen,946) line1
568  !
569  DO ky=iyn, iy0, -1
570  !
571  string = line1
572  DO kx=ix0, ixn
573  IF ( iclose.NE.iclose_none .OR. (kx.GE.1 .AND. kx.LE.nx) ) THEN
574  iix = 1 + mod(kx-1+nx,nx)
575  is1 = mapfs(ky,iix)
576  IF ( mapsta(ky,iix) .NE. 0 ) THEN
577  WRITE (parts,'(F8.1,1X)') -zb(is1)
578  nnx = 2 + (kx-ix0)*13
579  DO jx=1, 9
580  string(nnx+jx:nnx+jx) = parts(jx:jx)
581  END DO
582  ENDIF
583  END IF
584  END DO
585  WRITE (screen,946) string
586  !
587  string = line2
588  DO kx=ix0, ixn
589  nnx = 5 + (kx-ix0)*13
590  IF ( iclose.EQ.iclose_none .AND. (kx.LT.1.OR.kx.GT.nx) ) THEN
591  string(nnx:nnx+4) = out
592  ELSE
593  iix = 1 + mod(kx-1+nx,nx)
594  IF ( mapsta(ky,iix) .EQ. 0 ) THEN
595  string(nnx:nnx+4) = lnd
596  ELSE
597  string(nnx:nnx+4) = sea
598  END IF
599  END IF
600  END DO
601  WRITE (screen,947) ky, string
602  !
603  string = line1
604  DO kx=ix0, ixn
605  IF ( iclose.NE.iclose_none .OR. (kx.GE.1 .AND. kx.LE.nx) ) THEN
606  is1 = mapfs(ky,kx)
607  iix = 1 + mod(kx-1+nx,nx)
608  IF ( mapsta(ky,iix) .NE. 0 ) THEN
609  WRITE (parts,'(I4,1A,I4)') &
610  nint(1000.*trnx(ky,iix)), &
611  '|', nint(1000.*trny(ky,iix))
612  nnx = 2 + (kx-ix0)*13
613  DO jx=1, 9
614  string(nnx+jx:nnx+jx) = parts(jx:jx)
615  END DO
616  ENDIF
617  END IF
618  END DO
619  WRITE (screen,946) string
620  WRITE (screen,946) line1
621  !
622  END DO
623  !
624  IF ( iclose.NE.iclose_none ) THEN
625  WRITE (screen,945) (1+mod(kx+nx-1,nx),kx=ix0,ixn)
626  ELSE
627  WRITE (screen,945) (kx,kx=ix0,ixn)
628  END IF
629  DEALLOCATE ( string, line1, line2 )
630 
631  END DO
632  WRITE (screen,*)
633  WRITE (screen,*)
634  END IF
635 #endif
636  !
637  RETURN
638  !
639  ! Formats
640  !
641 #ifdef W3_O7a
642 940 FORMAT (/' Diagnostic output for output points [',i3,'] :'/&
643  '--------------------------------------------'/ &
644  ' Bottom level in m above grid point'/ &
645  ' X/Y transparency in thousands below')
646 941 FORMAT (/' Point ',a,' at ',2f8.2,' (degr or km)'/ &
647  ' -------------------------------------------------')
648 942 FORMAT ( ' Interp. cell :',4(' (',2i5,f4.2,')'))
649 943 FORMAT ( ' Depth (water level = 0) :',f10.1,' m'/)
650 945 FORMAT ( ' IX = ',4i13)
651 946 FORMAT ( ' ',52a1)
652 947 FORMAT ( ' IY =',i5,2x,52a1)
653 #endif
654  !
655 1000 FORMAT (/' *** WAVEWATCH-III WARNING :'/ &
656  ' OUTPUT POINT OUT OF GRID : ',2f10.3,2x,a/ &
657  ' POINT SKIPPPED '/)
658 1001 FORMAT (/' *** WAVEWATCH-III WARNING :'/ &
659  ' OUTPUT POINT OUT OF GRID : ',2e10.3,2x,a/ &
660  ' POINT SKIPPPED '/)
661  !
662 1002 FORMAT (/' *** WAVEWATCH-III WARNING :'/ &
663  ' OUTPUT POINT ON LAND : ',2f10.3,2x,a/ &
664  ' POINT SKIPPPED '/)
665 1003 FORMAT (/' *** WAVEWATCH-III WARNING :'/ &
666  ' OUTPUT POINT ON LAND : ',2e10.3,2x,a/ &
667  ' POINT SKIPPPED '/)
668  !
669 #ifdef W3_T
670 9010 FORMAT (' TEST W3IOPP : INPUT : ',i4,2f12.2,2x,a)
671 9011 FORMAT (' CORR. : ',2f12.2)
672 9012 FORMAT (' TEST W3IOPP : INT. DATA: ',2i6,1f8.2)
673 9013 FORMAT (' TEST W3IOPP : INT. DATA B): ',4i4,2f8.2)
674 9020 FORMAT (' TEST W3IOPP : PREPROCESSED DATA',i4,2x,a,2x,2f12.2, &
675  4(/' ',2i5,2f6.3))
676 9021 FORMAT (' TEST W3IOPP : PREPROCESSED DATA',i4,2x,a,2x,2f12.2, &
677  4(/' ',2i5,f6.3))
678 #endif
679  !/
680  !/ End of W3IOPP ----------------------------------------------------- /
681  !/

References w3gdatmd::clgtype, w3gdatmd::dxymax, w3gdatmd::filext, w3gdatmd::flagll, w3gdatmd::flagunr, w3odatmd::grdid, w3gdatmd::gsu, w3gdatmd::gtype, w3odatmd::iaproc, w3gdatmd::iclose, w3gdatmd::iclose_none, w3gdatmd::iclose_smpl, w3gdatmd::iclose_trpl, w3odatmd::iptint, w3triamd::is_in_ungrid(), w3gdatmd::mapfs, w3gdatmd::mapsta, w3gdatmd::maxx, w3gdatmd::maxy, w3odatmd::naperr, w3odatmd::napout, w3odatmd::ndse, w3odatmd::ndst, w3gdatmd::nk, w3odatmd::nopts, w3gdatmd::nspec, w3gdatmd::nth, w3gdatmd::nx, w3gdatmd::ny, w3gdatmd::polat, w3gdatmd::polon, w3odatmd::ptifac, w3odatmd::ptloc, w3odatmd::ptnme, w3gdatmd::rlgtype, w3odatmd::screen, w3servmd::strace(), w3gdatmd::sx, w3gdatmd::trigp, w3gdatmd::trnx, w3gdatmd::trny, w3gdatmd::ungtype, w3odatmd::w3dmo2(), w3servmd::w3lltoeq(), w3gdatmd::x0, w3gdatmd::y0, and w3gdatmd::zb.

Referenced by w3initmd::w3init(), and wmiopomd::wmiopp().

w3gdatmd::nk
integer, pointer nk
Definition: w3gdatmd.F90:1230
w3gdatmd::trigp
integer, dimension(:,:), pointer trigp
Definition: w3gdatmd.F90:1111
w3gdatmd::nseal
integer, pointer nseal
Definition: w3gdatmd.F90:1097
include
cmake src_list cmake include(${CMAKE_CURRENT_SOURCE_DIR}/cmake/check_switches.cmake) check_switches("$
Definition: CMakeLists.txt:15
w3wdatmd::iceh
real, dimension(:), pointer iceh
Definition: w3wdatmd.F90:183
w3odatmd::iptint
integer, dimension(:,:,:), pointer iptint
Definition: w3odatmd.F90:488
w3triamd
Reads triangle and unstructured grid information.
Definition: w3triamd.F90:21
w3adatmd::as
real, dimension(:), pointer as
Definition: w3adatmd.F90:584
w3gdatmd::gsu
type(t_gsu), pointer gsu
Definition: w3gdatmd.F90:1226
w3odatmd::iw
integer, dimension(:), pointer iw
Definition: w3odatmd.F90:488
w3adatmd
Define data structures to set up wave model auxiliary data for several models simultaneously.
Definition: w3adatmd.F90:26
w3gdatmd::nspec
integer, pointer nspec
Definition: w3gdatmd.F90:1230
w3timemd::t2d
subroutine t2d(TIME, DAT, IERR)
Definition: w3timemd.F90:1072
w3triamd::is_in_ungrid
subroutine is_in_ungrid(IMOD, XTIN, YTIN, ITOUT, IS, JS, RW)
Determine whether a point is inside or outside an unstructured grid, and returns index of triangle an...
Definition: w3triamd.F90:1605
w3gdatmd::flagunr
logical, pointer flagunr
Definition: w3gdatmd.F90:1193
w3gdatmd::trnx
real, dimension(:,:), pointer trnx
Definition: w3gdatmd.F90:1200
w3gdatmd::zb
real, dimension(:), pointer zb
Definition: w3gdatmd.F90:1195
constants::dera
real, parameter dera
DERA Conversion factor from degrees to radians.
Definition: constants.F90:77
w3gdatmd::ungtype
integer, parameter ungtype
Definition: w3gdatmd.F90:626
w3wdatmd
Define data structures to set up wave model dynamic data for several models simultaneously.
Definition: w3wdatmd.F90:18
w3gdatmd::maxx
real, pointer maxx
Definition: w3gdatmd.F90:1133
w3adatmd::cg
real, dimension(:,:), pointer cg
Definition: w3adatmd.F90:575
w3odatmd::nopts
integer, pointer nopts
Definition: w3odatmd.F90:484
w3odatmd::irqpo2
integer, dimension(:), pointer irqpo2
Definition: w3odatmd.F90:490
w3gdatmd::rlgtype
integer, parameter rlgtype
Definition: w3gdatmd.F90:624
w3adatmd::dw
real, dimension(:), pointer dw
Definition: w3adatmd.F90:584
w3gsrumd
Definition: w3gsrumd.F90:17
w3gdatmd::sig
real, dimension(:), pointer sig
Definition: w3gdatmd.F90:1234
w3wdatmd::icef
real, dimension(:), pointer icef
Definition: w3wdatmd.F90:183
w3odatmd::iaproc
integer, pointer iaproc
Definition: w3odatmd.F90:457
w3odatmd::ii
integer, dimension(:), pointer ii
Definition: w3odatmd.F90:488
w3odatmd::w3dmo2
subroutine w3dmo2(IMOD, NDSE, NDST, NPT)
Definition: w3odatmd.F90:952
w3odatmd::grdid
character(len=13), dimension(:), pointer grdid
Definition: w3odatmd.F90:502
w3wdatmd::time
integer, dimension(:), pointer time
Definition: w3wdatmd.F90:172
constants::rade
real, parameter rade
RADE Conversion factor from radians to degrees.
Definition: constants.F90:76
w3gdatmd::ny
integer, pointer ny
Definition: w3gdatmd.F90:1097
w3odatmd::fnmpre
character(len=80) fnmpre
Definition: w3odatmd.F90:330
w3odatmd::ofiles
integer, dimension(:), pointer ofiles
Definition: w3odatmd.F90:466
w3odatmd::dpo
real, dimension(:), pointer dpo
Definition: w3odatmd.F90:492
w3odatmd::zet_seto
real, dimension(:), pointer zet_seto
Definition: w3odatmd.F90:499
w3odatmd::wdo
real, dimension(:), pointer wdo
Definition: w3odatmd.F90:492
w3odatmd::o2init
logical, pointer o2init
Definition: w3odatmd.F90:503
w3gdatmd::iclose_none
integer, parameter iclose_none
Definition: w3gdatmd.F90:629
w3gdatmd::w3setg
subroutine w3setg(IMOD, NDSE, NDST)
Definition: w3gdatmd.F90:2152
w3odatmd::ipass2
integer, pointer ipass2
Definition: w3odatmd.F90:484
w3servmd::w3acturn
subroutine w3acturn(NDirc, NFreq, Alpha, Spectr)
Definition: w3servmd.F90:977
scrip_timers::status
character(len=8), dimension(max_timers), save status
Definition: scrip_timers.f:63
w3odatmd::ndse
integer, pointer ndse
Definition: w3odatmd.F90:456
w3odatmd::ptloc
real, dimension(:,:), pointer ptloc
Definition: w3odatmd.F90:492
w3gdatmd::mapfs
integer, dimension(:,:), pointer mapfs
Definition: w3gdatmd.F90:1163
w3odatmd::naperr
integer, pointer naperr
Definition: w3odatmd.F90:457
constants::lpdlib
logical lpdlib
LPDLIB Logical for using the PDLIB library.
Definition: constants.F90:101
w3gdatmd::polat
real, pointer polat
Definition: w3gdatmd.F90:1191
w3gdatmd::x0
real, pointer x0
Definition: w3gdatmd.F90:1183
w3gdatmd::nsea
integer, pointer nsea
Definition: w3gdatmd.F90:1097
w3gdatmd::clgtype
integer, parameter clgtype
Definition: w3gdatmd.F90:625
w3servmd
Definition: w3servmd.F90:3
w3servmd::w3lltoeq
subroutine w3lltoeq(PHI, LAMBDA, PHI_EQ, LAMBDA_EQ, ANGLED, PHI_POLE, LAMBDA_POLE, POINTS)
Definition: w3servmd.F90:1084
w3timemd::caltype
character, public caltype
Definition: w3timemd.F90:79
w3adatmd::ud
real, dimension(:), pointer ud
Definition: w3adatmd.F90:584
w3wdatmd::w3setw
subroutine w3setw(IMOD, NDSE, NDST)
Select one of the WAVEWATCH III grids / models.
Definition: w3wdatmd.F90:660
w3odatmd::wao
real, dimension(:), pointer wao
Definition: w3odatmd.F90:492
w3odatmd::w3seto
subroutine w3seto(IMOD, NDSERR, NDSTST)
Definition: w3odatmd.F90:1523
w3gdatmd::nth
integer, pointer nth
Definition: w3gdatmd.F90:1230
w3odatmd
Definition: w3odatmd.F90:3
w3adatmd::cy
real, dimension(:), pointer cy
Definition: w3adatmd.F90:584
w3timemd::tsub
double precision function tsub(T1, T2)
Definition: w3timemd.F90:1527
w3odatmd::screen
integer, pointer screen
Definition: w3odatmd.F90:456
w3adatmd::taua
real, dimension(:), pointer taua
Definition: w3adatmd.F90:584
w3odatmd::naproc
integer, pointer naproc
Definition: w3odatmd.F90:457
file
file(STRINGS ${CMAKE_BINARY_DIR}/switch switch_strings) separate_arguments(switches UNIX_COMMAND $
Definition: CMakeLists.txt:3
w3odatmd::ptnme
character(len=40), dimension(:), pointer ptnme
Definition: w3odatmd.F90:501
w3gdatmd::iclose
integer, pointer iclose
Definition: w3gdatmd.F90:1096
constants::tpi
real, parameter tpi
TPI 2*Pi.
Definition: constants.F90:72
w3gdatmd::maxy
real, pointer maxy
Definition: w3gdatmd.F90:1133
w3servmd::strace
subroutine strace(IENT, SNAME)
Definition: w3servmd.F90:148
w3gdatmd::gtype
integer, pointer gtype
Definition: w3gdatmd.F90:1094
w3wdatmd::zeta_setup
real, dimension(:), pointer zeta_setup
Definition: w3wdatmd.F90:187
w3wdatmd::ice
real, dimension(:), pointer ice
Definition: w3wdatmd.F90:183
w3arrymd
Definition: w3arrymd.F90:3
w3odatmd::napout
integer, pointer napout
Definition: w3odatmd.F90:457
w3gdatmd::y0
real, pointer y0
Definition: w3gdatmd.F90:1183
w3timemd::u2d
subroutine u2d(UNITS, DAT, IERR)
Definition: w3timemd.F90:1728
w3adatmd::sppnt
real, dimension(:,:,:), pointer sppnt
Definition: w3adatmd.F90:684
w3gdatmd::dxymax
real, pointer dxymax
Definition: w3gdatmd.F90:1133
w3gdatmd::sx
real, pointer sx
Definition: w3gdatmd.F90:1183
w3odatmd::ndst
integer, pointer ndst
Definition: w3odatmd.F90:456
constants
Define some much-used constants for global use (all defined as PARAMETER).
Definition: constants.F90:20
w3adatmd::ua
real, dimension(:), pointer ua
Definition: w3adatmd.F90:584
w3gdatmd
Definition: w3gdatmd.F90:16
w3gdatmd::iclose_trpl
integer, parameter iclose_trpl
Definition: w3gdatmd.F90:631
constants::file_endian
character(*), parameter file_endian
FILE_ENDIAN Filled by preprocessor with 'big_endian', 'little_endian', or 'native'.
Definition: constants.F90:86
w3adatmd::tauadir
real, dimension(:), pointer tauadir
Definition: w3adatmd.F90:584
w3odatmd::il
integer, dimension(:), pointer il
Definition: w3odatmd.F90:488
w3arrymd::prt2ds
subroutine prt2ds(NDS, NFR0, NFR, NTH, E, FR, UFR, FACSP, FSC, RRCUT, PRVAR, PRUNIT, PNTNME)
Definition: w3arrymd.F90:1943
w3wdatmd::rhoair
real, dimension(:), pointer rhoair
Definition: w3wdatmd.F90:183
w3gdatmd::angld
real, dimension(:), pointer angld
Definition: w3gdatmd.F90:1192
w3odatmd::ptifac
real, dimension(:,:), pointer ptifac
Definition: w3odatmd.F90:492
w3adatmd::cx
real, dimension(:), pointer cx
Definition: w3adatmd.F90:584
w3gdatmd::nx
integer, pointer nx
Definition: w3gdatmd.F90:1097
w3timemd
Definition: w3timemd.F90:3
w3odatmd::aso
real, dimension(:), pointer aso
Definition: w3odatmd.F90:492
w3gdatmd::iclose_smpl
integer, parameter iclose_smpl
Definition: w3gdatmd.F90:630
w3gdatmd::mapsta
integer, dimension(:,:), pointer mapsta
Definition: w3gdatmd.F90:1163
w3gdatmd::polon
real, pointer polon
Definition: w3gdatmd.F90:1191
w3gdatmd::trny
real, dimension(:,:), pointer trny
Definition: w3gdatmd.F90:1200
w3gdatmd::flagll
logical, pointer flagll
Definition: w3gdatmd.F90:1219
w3gdatmd::filext
character(len=13), pointer filext
Definition: w3gdatmd.F90:1224