WAVEWATCH III  beta 0.0.1
Data Types | Functions/Subroutines | Variables
w3gsrumd Module Reference

Data Types

type  t_gsu
 
type  t_nns
 

Functions/Subroutines

subroutine, public w3gsud (GSU)
 
subroutine, public w3gsup (GSU, IUNIT, LFULL)
 
type(t_nns) function, pointer, public w3nnsc (NLVL)
 
subroutine, public w3nnsd (NNS)
 
subroutine, public w3nnsp (NNS, IUNIT)
 

Variables

integer, parameter, public mskc_none = 0
 
integer, parameter, public mskc_part = 1
 
integer, parameter, public mskc_full = 2
 
integer, parameter, public iclo_none = -1
 
integer, parameter, public iclo_smpl = 2
 
integer, parameter, public iclo_grdi = ICLO_SMPL
 
integer, parameter, public iclo_grdj = 3
 
integer, parameter, public iclo_trdl = 6
 
integer, parameter, public iclo_trpl = 8
 
real(8), parameter pi = 3.14159265358979323846D0
 

Function/Subroutine Documentation

◆ w3gsud()

subroutine, public w3gsrumd::w3gsud ( type(t_gsu), intent(inout)  GSU)

Definition at line 790 of file w3gsrumd.F90.

790  TYPE(T_GSU), INTENT(INOUT) :: GSU
791 
792  ! Local parameters
793  INTEGER :: IB, JB
794 #ifdef W3_S
795  INTEGER, SAVE :: IENT = 0
796  CALL strace (ient, 'W3GSUD')
797 #endif
798  !
799  IF ( ASSOCIATED(gsu%PTR) ) THEN
800  !
801  CALL w3nnsd(gsu%PTR%NNP)
802  !
803  IF ( ASSOCIATED(gsu%PTR%B) ) THEN
804  DO ib=1,gsu%PTR%NBX
805  DO jb=1,gsu%PTR%NBY
806  IF ( gsu%PTR%B(jb,ib)%N .GT. 0 ) THEN
807  DEALLOCATE(gsu%PTR%B(jb,ib)%I)
808  NULLIFY(gsu%PTR%B(jb,ib)%I)
809  DEALLOCATE(gsu%PTR%B(jb,ib)%J)
810  NULLIFY(gsu%PTR%B(jb,ib)%J)
811  END IF
812  END DO
813  END DO
814  DEALLOCATE(gsu%PTR%B)
815  NULLIFY(gsu%PTR%B)
816  END IF
817  !
818  CALL w3nnsd(gsu%PTR%NNB)
819  !
820  DEALLOCATE(gsu%PTR)
821  NULLIFY(gsu%PTR)
822  !
823  END IF
824 

References w3servmd::strace(), and w3nnsd().

Referenced by w3fldsmd::w3fldp(), and w3gsup().

◆ w3gsup()

subroutine, public w3gsrumd::w3gsup ( type(t_gsu), intent(in)  GSU,
integer, intent(in), optional  IUNIT,
logical, intent(in), optional  LFULL 
)

Definition at line 885 of file w3gsrumd.F90.

885  TYPE(T_GSU), INTENT(IN) :: GSU
886  INTEGER, OPTIONAL, INTENT(IN) :: IUNIT
887  LOGICAL, OPTIONAL, INTENT(IN) :: LFULL
888 
889  ! Local parameters
890  INTEGER, PARAMETER :: NBYTE_PTR=4
891  INTEGER, PARAMETER :: NBYTE_INT=4
892  TYPE(CLASS_GSU), POINTER :: PTR
893  INTEGER :: NDST, K, IB, JB, NBYTE
894 #ifdef W3_S
895  INTEGER, SAVE :: IENT = 0
896  CALL strace (ient, 'W3GSUP')
897 #endif
898  !
899  ! -------------------------------------------------------------------- /
900  ! 1. Test input
901  !
902  IF ( .NOT.ASSOCIATED(gsu%PTR) ) THEN
903  WRITE(0,'(/1A,1A/)') 'W3GSUP ERROR -- ', &
904  'grid search utility object not created'
905  CALL extcde (1)
906  END IF
907 
908  IF ( PRESENT(iunit) ) THEN
909  ndst = iunit
910  ELSE
911  ndst = 6
912  END IF
913 
914  ptr => gsu%PTR
915  !
916  ! -------------------------------------------------------------------- /
917  ! 2. Compute approximate memory usage
918  !
919  nbyte = (nbyte_int+nbyte_ptr*2)*SIZE(ptr%B)
920  DO ib=1,ptr%NBX
921  DO jb=1,ptr%NBY
922  nbyte = nbyte + nbyte_int*2*ptr%B(jb,ib)%N
923  END DO
924  END DO
925  !
926  ! -------------------------------------------------------------------- /
927  ! 3. Output
928  !
929  WRITE(ndst,'(//80A)') ('-',k=1,80)
930  WRITE(ndst,'(A)') 'Report on grid search utility object'
931  WRITE(ndst,'( 80A)') ('-',k=1,80)
932  WRITE(ndst,'(A,1L2)') 'Grid ijg:',ptr%IJG
933  WRITE(ndst,'(A,1L2)') 'Grid llg:',ptr%LLG
934  WRITE(ndst,'(A,1I2)') 'Grid iclo:',ptr%ICLO
935  WRITE(ndst,'(A,1L2)') 'Grid lclo:',ptr%LCLO
936  WRITE(ndst,'(A,1I2)') 'Grid precision:',ptr%GKIND
937  WRITE(ndst,'(A,2I6)') 'Grid lbx,lby:',ptr%LBX,ptr%LBY
938  WRITE(ndst,'(A,2I6)') 'Grid ubx,uby:',ptr%UBX,ptr%UBY
939  WRITE(ndst,'(A,2I6)') 'Grid nx, ny:',ptr%NX,ptr%NY
940  IF ( PRESENT(lfull) ) THEN
941  IF ( lfull ) THEN
942  WRITE(ndst,'( 80A)') ('-',k=1,80)
943  WRITE(ndst,'(A)') 'Nearest-neighbor point search indices'
944  WRITE(ndst,'( 80A)') ('-',k=1,80)
945  CALL w3nnsp(ptr%NNP,ndst)
946  END IF
947  END IF
948  WRITE(ndst,'( 80A)') ('-',k=1,80)
949  WRITE(ndst,'(A)') 'Bucket-search object'
950  WRITE(ndst,'( 80A)') ('-',k=1,80)
951  WRITE(ndst,'(A,4E24.16)') 'Spatial grid search domain: ', &
952  ptr%XMIN,ptr%YMIN,ptr%XMAX,ptr%YMAX
953  WRITE(ndst,'(A,2I6)') 'nbx,nby:',ptr%NBX,ptr%NBY
954  WRITE(ndst,'(A,2E24.16)') 'dxb,dyb:',ptr%DXB,ptr%DYB
955  WRITE(ndst,'(A,1F10.1)') 'Approximate memory usage (MB):', &
956  REAL(NBYTE)/2**20
957  IF ( PRESENT(lfull) ) THEN
958  IF ( lfull ) THEN
959  WRITE(ndst,'( 80A)') ('-',k=1,80)
960  WRITE(ndst,'(A)') 'Search bucket bounds:'
961  WRITE(ndst,'( 80A)') ('-',k=1,80)
962  WRITE(ndst,'(2A4,4A24)') 'IB','JB','X1','Y1','X2','Y2'
963  DO ib=1,ptr%NBX
964  DO jb=1,ptr%NBY
965  WRITE(ndst,'(2I4,4E24.16)') ib,jb, &
966  ptr%XMIN+(ib-1)*ptr%DXB,ptr%YMIN+(jb-1)*ptr%DYB, &
967  ptr%XMIN+(ib )*ptr%DXB,ptr%YMIN+(jb )*ptr%DYB
968  END DO
969  END DO
970  WRITE(ndst,'( 80A)') ('-',k=1,80)
971  WRITE(ndst,'(A)') 'Number of cells in each search bucket:'
972  WRITE(ndst,'( 80A)') ('-',k=1,80)
973  DO jb=ptr%NBY,1,-1
974  WRITE(ndst,'(500I4)') (ptr%B(jb,ib)%N,ib=1,ptr%NBX)
975  END DO
976  WRITE(ndst,'( 80A)') ('-',k=1,80)
977  WRITE(ndst,'(A)') 'Search bucket cell lists:'
978  WRITE(ndst,'( 80A)') ('-',k=1,80)
979  WRITE(ndst,'(3A4,A)') 'IB','JB','NC',': ( IC, JC), ...'
980  DO jb=1,ptr%NBY
981  DO ib=1,ptr%NBX
982  WRITE(ndst,'(3I4,A,500(A,I3,A,I3,A))') ib,jb, &
983  ptr%B(jb,ib)%N, ': ', &
984  ( '(',ptr%B(jb,ib)%I(k),',',ptr%B(jb,ib)%J(k),') ', &
985  k=1,ptr%B(jb,ib)%N )
986  END DO
987  END DO
988  WRITE(ndst,'( 80A)') ('-',k=1,80)
989  WRITE(ndst,'(A)') 'Nearest-neighbor bucket search indices'
990  WRITE(ndst,'( 80A)') ('-',k=1,80)
991  CALL w3nnsp(ptr%NNB,ndst)
992  END IF !LFULL
993  END IF !PRESENT(LFULL)
994  WRITE(ndst,'( 80A)') ('-',k=1,80)
995  WRITE(ndst,'( 80A)') ('-',k=1,80)
996 

References check(), iclo_grdi, iclo_grdj, iclo_none, iclo_trdl, iclo_trpl, mskc_full, mskc_none, mskc_part, w3servmd::strace(), w3gsud(), w3nnsc(), and w3nnsp().

Referenced by w3fldsmd::w3fldp(), w3gdatmd::w3gntx(), and w3iotrmd::w3iotr().

◆ w3nnsc()

type(t_nns) function, pointer, public w3gsrumd::w3nnsc ( integer, intent(in)  NLVL)

Definition at line 6820 of file w3gsrumd.F90.

6820  TYPE(T_NNS), POINTER :: NNS
6821  INTEGER, INTENT(IN) :: NLVL
6822 
6823  ! Local parameters
6824  INTEGER :: I, J, L, N
6825 #ifdef W3_S
6826  INTEGER, SAVE :: IENT = 0
6827  CALL strace (ient, 'W3NNSC')
6828 #endif
6829  !
6830  !-----allocate object
6831  ALLOCATE(nns)
6832 
6833  !-----initialize sizes
6834  nns%NLVL = nlvl
6835  nns%NNBR = (2*nlvl+1)**2
6836 
6837  !-----allocate arrays
6838  ALLOCATE(nns%N1(0:nns%NLVL))
6839  ALLOCATE(nns%N2(0:nns%NLVL))
6840  ALLOCATE(nns%DI(0:nns%NNBR-1))
6841  ALLOCATE(nns%DJ(0:nns%NNBR-1))
6842 
6843  !-----compute index deltas for nearest-neighbor searches
6844  n = 0
6845  !-----central point
6846  l = 0
6847  nns%N1(l) = 0; nns%N2(l) = (2*l+1)**2-1;
6848  nns%DI(n) = 0; nns%DJ(n) = 0;
6849  !-----loop over levels
6850  DO l=1,nns%NLVL
6851  !---------nnbr loop bounds
6852  nns%N1(l) = (2*l-1)**2; nns%N2(l) = (2*l+1)**2-1;
6853  !---------bottom-layer
6854  j = -l
6855  DO i=-l,l-1
6856  n = n + 1
6857  nns%DI(n) = i; nns%DJ(n) = j;
6858  END DO
6859  !---------right-layer
6860  i = l
6861  DO j=-l,l-1
6862  n = n + 1
6863  nns%DI(n) = i; nns%DJ(n) = j;
6864  END DO
6865  !---------top-layer
6866  j = l
6867  DO i=l,-l+1,-1
6868  n = n + 1
6869  nns%DI(n) = i; nns%DJ(n) = j;
6870  END DO
6871  !---------left-layer
6872  i = -l
6873  DO j=l,-l+1,-1
6874  n = n + 1
6875  nns%DI(n) = i; nns%DJ(n) = j;
6876  END DO
6877  END DO !loop over levels
6878 

References w3servmd::strace().

Referenced by w3gsup(), and w3nnsp().

◆ w3nnsd()

subroutine, public w3gsrumd::w3nnsd ( type(t_nns), pointer  NNS)

Definition at line 6931 of file w3gsrumd.F90.

6931  TYPE(T_NNS), POINTER :: NNS
6932 
6933  ! Local parameters
6934 #ifdef W3_S
6935  INTEGER, SAVE :: IENT = 0
6936  CALL strace (ient, 'W3NNSD')
6937 #endif
6938  !
6939  IF ( ASSOCIATED(nns) ) THEN
6940  nns%NLVL = 0
6941  nns%NNBR = 0
6942  IF ( ASSOCIATED(nns%N1) ) THEN
6943  DEALLOCATE(nns%N1); NULLIFY(nns%N1);
6944  END IF
6945  IF ( ASSOCIATED(nns%N2) ) THEN
6946  DEALLOCATE(nns%N2); NULLIFY(nns%N2);
6947  END IF
6948  IF ( ASSOCIATED(nns%DI) ) THEN
6949  DEALLOCATE(nns%DI); NULLIFY(nns%DI);
6950  END IF
6951  IF ( ASSOCIATED(nns%DJ) ) THEN
6952  DEALLOCATE(nns%DJ); NULLIFY(nns%DJ);
6953  END IF
6954  DEALLOCATE(nns)
6955  NULLIFY(nns)
6956  END IF
6957 

References w3servmd::strace().

Referenced by w3gsud().

◆ w3nnsp()

subroutine, public w3gsrumd::w3nnsp ( type(t_nns), intent(in)  NNS,
integer, intent(in), optional  IUNIT 
)

Definition at line 7012 of file w3gsrumd.F90.

7012  TYPE(T_NNS), INTENT(IN) :: NNS
7013  INTEGER, OPTIONAL, INTENT(IN) :: IUNIT
7014 
7015  ! Local parameters
7016  INTEGER :: NDST, L, N
7017 #ifdef W3_S
7018  INTEGER, SAVE :: IENT = 0
7019  CALL strace (ient, 'W3NNSP')
7020 #endif
7021  !
7022  IF ( PRESENT(iunit) ) THEN
7023  ndst = iunit
7024  ELSE
7025  ndst = 6
7026  END IF
7027  !
7028  WRITE(ndst,'(A,2I6)') 'nlvl,nnbr:',nns%NLVL,nns%NNBR
7029  DO l=0,nns%NLVL
7030  DO n=nns%N1(l),nns%N2(l)
7031  WRITE(ndst,'(A,4I6)') 'l,n,di,dj:',l,n,nns%DI(n),nns%DJ(n)
7032  END DO
7033  END DO
7034 

References iclo_grdi, iclo_grdj, iclo_none, iclo_trdl, iclo_trpl, include(), w3servmd::strace(), and w3nnsc().

Referenced by w3gsup().

Variable Documentation

◆ iclo_grdi

integer, parameter, public w3gsrumd::iclo_grdi = ICLO_SMPL

Definition at line 316 of file w3gsrumd.F90.

316  INTEGER, PARAMETER, PUBLIC :: ICLO_GRDI = iclo_smpl

Referenced by w3gsup(), and w3nnsp().

◆ iclo_grdj

integer, parameter, public w3gsrumd::iclo_grdj = 3

Definition at line 317 of file w3gsrumd.F90.

317  INTEGER, PARAMETER, PUBLIC :: ICLO_GRDJ = 3

Referenced by w3gsup(), and w3nnsp().

◆ iclo_none

integer, parameter, public w3gsrumd::iclo_none = -1

Definition at line 314 of file w3gsrumd.F90.

314  INTEGER, PARAMETER, PUBLIC :: ICLO_NONE = -1

Referenced by w3fldsmd::w3fldp(), w3gsup(), and w3nnsp().

◆ iclo_smpl

integer, parameter, public w3gsrumd::iclo_smpl = 2

Definition at line 315 of file w3gsrumd.F90.

315  INTEGER, PARAMETER, PUBLIC :: ICLO_SMPL = 2

Referenced by w3fldsmd::w3fldp().

◆ iclo_trdl

integer, parameter, public w3gsrumd::iclo_trdl = 6

Definition at line 318 of file w3gsrumd.F90.

318  INTEGER, PARAMETER, PUBLIC :: ICLO_TRDL = 6

Referenced by w3gsup(), and w3nnsp().

◆ iclo_trpl

integer, parameter, public w3gsrumd::iclo_trpl = 8

Definition at line 319 of file w3gsrumd.F90.

319  INTEGER, PARAMETER, PUBLIC :: ICLO_TRPL = 8

Referenced by w3gsup(), and w3nnsp().

◆ mskc_full

integer, parameter, public w3gsrumd::mskc_full = 2

Definition at line 283 of file w3gsrumd.F90.

283  INTEGER, PARAMETER, PUBLIC :: MSKC_FULL = 2

Referenced by w3gsup().

◆ mskc_none

integer, parameter, public w3gsrumd::mskc_none = 0

Definition at line 281 of file w3gsrumd.F90.

281  INTEGER, PARAMETER, PUBLIC :: MSKC_NONE = 0

Referenced by w3fldsmd::w3fldp(), and w3gsup().

◆ mskc_part

integer, parameter, public w3gsrumd::mskc_part = 1

Definition at line 282 of file w3gsrumd.F90.

282  INTEGER, PARAMETER, PUBLIC :: MSKC_PART = 1

Referenced by w3fldsmd::w3fldp(), and w3gsup().

◆ pi

real(8), parameter w3gsrumd::pi = 3.14159265358979323846D0

Definition at line 377 of file w3gsrumd.F90.

377  REAL(8), PARAMETER :: PI = 3.14159265358979323846d0
w3gsrumd::iclo_smpl
integer, parameter, public iclo_smpl
Definition: w3gsrumd.F90:315
w3gsrumd::w3nnsd
subroutine, public w3nnsd(NNS)
Definition: w3gsrumd.F90:6931
w3gsrumd::w3nnsp
subroutine, public w3nnsp(NNS, IUNIT)
Definition: w3gsrumd.F90:7012
w3servmd::strace
subroutine strace(IENT, SNAME)
Definition: w3servmd.F90:148