Page 1 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 1 !/ ------------------------------------------------------------------- / 2 MODULE WMGRIDMD 3 !/ 4 !/ +-----------------------------------+ 5 !/ | WAVEWATCH III NOAA/NCEP | 6 !/ | H. L. Tolman | 7 !/ | W. E. Rogers | 8 !/ | FORTRAN 90 | 9 !/ | Last update : 05-Aug-2013 | 10 !/ +-----------------------------------+ 11 !/ 12 !/ 28-Dec-2005 : Origination WMGLOW, WMGHGH, WMRSPC. ( version 3.08 ) 13 !/ 09-Mar-2006 : Carry land mask in WMGHGH. ( version 3.09 ) 14 !/ 24-Apr-2006 : Origination WMGEQL. ( version 3.09 ) 15 !/ 25-Jul-2006 : Point output grid in WMRSPC. ( version 3.10 ) 16 !/ 23-Dec-2006 : Adding group test in WMGEQL. ( version 3.10 ) 17 !/ 28-Dec-2006 : Simplify NIT for partial comm. ( version 3.10 ) 18 !/ 22-Jan-2007 : Add saving of NAVMAX in WMGEQL. ( version 3.10 ) 19 !/ 02-Feb-2007 : Setting FLAGST in WMGEQL. ( version 3.10 ) 20 !/ 07-Feb-2007 : Setting FLAGST in WMGHGH. ( version 3.10 ) 21 !/ 15-Feb-2007 : Tweaking MAPODI algorithm in WMGEQL.( version 3.10 ) 22 !/ 11-Apr-2008 : Bug fix active edges WMGEQL. ( version 3.13 ) 23 !/ 14-Apr-2008 : Bug fix for global grids WMGEQL. ( version 3.13 ) 24 !/ 26-Mar-2009 : Adding test output !/T9 to WMGLOW. ( version 3.14 ) 25 !/ 20-May-2009 : Linking FLAGST and FLGHG1. ( version 3.14 ) 26 !/ 26-May-2009 : Fix erroneous cyclic upd in WMGHGH. ( version 3.14 ) 27 !/ 29-May-2009 : Preparing distribution version. ( version 3.14 ) 28 !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 ) 29 !/ (W. E. Rogers & T. J. Campbell, NRL) 30 !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to 31 !/ specify index closure for a grid. ( version 3.14 ) 32 !/ (T. J. Campbell, NRL) 33 !/ 23-Dec-2010 : Fix HPFAC and HQFAC by including the COS(YGRD) 34 !/ factor with DXDP and DXDQ terms. ( version 3.14 ) 35 !/ (T. J. Campbell, NRL) 36 !/ 12-Mar-2012 : Use MPI_COMM_NULL in checks. ( version 3.14 ) 37 !/ 06-Jun-2012 : Porting bugfixes from 3.14 to 4.07 ( version 4.07 ) 38 !/ 05-Sep-2012 : Implementation of UNGTYPE with SCRIP 39 !/ (Mathieu Dutour Sikiric, IRB; Aron Roland, Z&P) 40 !/ 21-Sep-2012 : Modify WMGHGH to support SCRIP remap( version 4.11 ) 41 !/ write/read capabilities (K. Lind, NRL) 42 !/ 05-Aug-2013 : Change PR2/3 to UQ/UNO in distances.( version 4.12 ) 43 !/ 44 !/ Copyright 2009-2013 National Weather Service (NWS), 45 !/ National Oceanic and Atmospheric Administration. All rights 46 !/ reserved. WAVEWATCH III is a trademark of the NWS. 47 !/ No unauthorized use without permission. 48 !/ 49 ! 1. Purpose : 50 ! 51 ! Routines to determine and process grid dependencies in the 52 ! multi-grid wave model. 53 ! 54 ! 2. Variables and types : 55 ! 56 ! 3. Subroutines and functions : 57 ! Page 2 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 58 ! Name Type Scope Description 59 ! ---------------------------------------------------------------- 60 ! WMGLOW Subr. Public Dependencies to lower ranked grids. 61 ! WMGHGH Subr. Public Dependencies to higher ranked grids. 62 ! WMGEQL Subr. Public Dependencies to same ranked grids. 63 ! WMRSPC Subr. Public Make map of flags for spectral 64 ! conversion between grids. 65 ! ---------------------------------------------------------------- 66 ! 67 ! 4. Subroutines and functions used : 68 ! 69 ! Name Type Module Description 70 ! ---------------------------------------------------------------- 71 ! W3SETO, W3SETG, W3DMO5, WMSETM 72 ! Subr. W3xDATMD Manage data structures. 73 ! 74 ! STRACE Sur. W3SERVMD Subroutine tracing. 75 ! EXTCDE Subr. Id. Program abort. 76 ! 77 ! MPI_BCAST, MPI_BARRIER 78 ! Subr. mpif.h Comunication routines. 79 ! ---------------------------------------------------------------- 80 ! 81 ! 5. Remarks : 82 ! 83 ! - WMGLOW and WMGHGH need to be run in this order to 84 ! assure proper resolving of cross-dependencies. 85 ! - WMGLOW and WMGEQL, idem. 86 ! 87 ! 6. Switches : 88 ! 89 ! !/PRn propagation scheme. 90 ! !/UQ propagation scheme. 91 ! !/UNO propagation scheme. 92 ! 93 ! !/SHRD Distributed memory approach 94 ! !/DIST 95 ! !/MPI 96 ! 97 ! !/O12 Removed boundary points output WMGEQL (central). 98 ! !/O13 Removed boundary points output WMGEQL (edge). 99 ! 100 ! !/S Enable subroutine tracing. 101 ! !/Tn Enable test output. 102 ! 103 ! 7. Source code : 104 ! 105 !/ ------------------------------------------------------------------- / 106 PUBLIC 107 !/ 108 CONTAINS 109 !/ ------------------------------------------------------------------- / 110 SUBROUTINE WMGLOW ( FLRBPI ) 111 !/ 112 !/ +-----------------------------------+ 113 !/ | WAVEWATCH III NOAA/NCEP | 114 !/ | H. L. Tolman | Page 3 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 115 !/ | W. E. Rogers | 116 !/ | FORTRAN 90 | 117 !/ | Last update : 06-Jun-2012 | 118 !/ +-----------------------------------+ 119 !/ 120 !/ 06-Oct-2005 : Origination. ( version 3.08 ) 121 !/ 10-Feb-2006 : Add test on grid resolution. ( version 3.09 ) 122 !/ 26-Mar-2009 : Adding test output !/T9. ( version 3.14 ) 123 !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 ) 124 !/ (W. E. Rogers & T. J. Campbell, NRL) 125 !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to 126 !/ specify index closure for a grid. ( version 3.14 ) 127 !/ (T. J. Campbell, NRL) 128 !/ 22-Dec-2010 : Adapt for use with irregular grids ( version 3.14 ) 129 !/ (W. E. Rogers, NRL) 130 !/ 12-Mar-2012 : Use MPI_COMM_NULL in checks. ( version 4.07 ) 131 !/ 06-Jun-2012 : Porting bugfixes from 3.14 to 4.07 ( version 4.07 ) 132 !/ 133 ! 1. Purpose : 134 ! 135 ! Determine relations to lower ranked grids for each grid. 136 ! On the fly, the oposite relations are also saved. 137 ! 138 ! 2. Method : 139 ! 140 ! Map active boundary points to lower ranked grids. 141 ! 142 ! 3. Parameters : 143 ! 144 ! Parameter list 145 ! ---------------------------------------------------------------- 146 ! FLRBPI L.A. O Array with flags for external file use. 147 ! ---------------------------------------------------------------- 148 ! 149 ! 4. Subroutines used : 150 ! 151 ! Name Type Module Description 152 ! ---------------------------------------------------------------- 153 ! W3SETO, W3SETG, W3DMO5 154 ! Subr. W3xDATMD Manage data structures. 155 ! 156 ! STRACE Subr. W3SERVMD Subroutine tracing. 157 ! EXTCDE Subr. Id. Program abort. 158 ! 159 ! MPI_BCAST, MPI_BARRIER 160 ! Subr. mpif.h Comunication routines. 161 ! ---------------------------------------------------------------- 162 ! 163 ! 5. Called by : 164 ! 165 ! Name Type Module Description 166 ! ---------------------------------------------------------------- 167 ! WMINIT Subr WMINITMD Multi-grid model initialization. 168 ! ---------------------------------------------------------------- 169 ! 170 ! 6. Error messages : 171 ! Page 4 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 172 ! 7. Remarks : 173 ! 174 ! - For MPI version it is assumed that NX, NY, NSEA, and NSEAL are 175 ! properly initialized even if the grid is not run on the local 176 ! process. 177 ! 178 ! 8. Structure : 179 ! 180 ! See source code. 181 ! 182 ! 9. Switches : 183 ! 184 ! !/MPI Distribbuted memory management. 185 ! 186 ! !/S Enable subroutine tracing. 187 ! !/T Enable test output. 188 ! !/T1 Test output for individual boundary points 189 ! !/T2 Test output cross-reference table 190 ! !/T9 Test output of map of boundary origine. 191 ! 192 ! 10. Source code : 193 ! 194 !/ ------------------------------------------------------------------- / 195 ! 196 USE W3SERVMD, ONLY: EXTCDE 197 ! 198 USE W3GDATMD 199 USE W3ODATMD 200 USE W3TRIAMD 201 USE WMMDATMD 202 ! 203 IMPLICIT NONE 204 ! 205 INCLUDE "mpif.h" 206 !/ 207 !/ ------------------------------------------------------------------- / 208 !/ Parameter list 209 !/ 748 LOGICAL, INTENT(OUT), OPTIONAL :: FLRBPI(NRGRD) 749 !/ 750 !/ ------------------------------------------------------------------- / 751 !/ Local parameters 752 !/ 753 INTEGER :: I, IBI, IX, IY, JS, J, & 754 JTOT, I1, J1, I2, J2 755 INTEGER :: NXYG, IERR_MPI 756 INTEGER, ALLOCATABLE :: TSTORE(:,:) 757 LOGICAL :: FLBARR 758 REAL :: XA, YA 759 REAL :: FACTOR 760 LOGICAL :: GRIDD(NRGRD,NRGRD) ! indicates grid-to-grid 761 ! dependency 762 LOGICAL :: RFILE(NRGRD), FLAGOK 763 LOGICAL :: INGRID ! indicates whether boundary point 764 ! is in lower rank grid 765 INTEGER :: IVER(4),JVER(4) ! (I,J) indices of vertices 766 ! of cell (in lower rank grid J) enclosing Page 5 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 767 ! boundary point (in higher rank grid I) 768 REAL :: RW(4) ! Array of interpolation weights. 769 INTEGER :: KVER ! counter for 4 vertices 770 771 REAL :: DX_MIN_GRIDI,DY_MIN_GRIDI,DX_MAX_GRIDI, & 772 DY_MAX_GRIDI 773 REAL :: DX_MIN_GRIDJ,DY_MIN_GRIDJ,DX_MAX_GRIDJ, & 774 DY_MAX_GRIDJ 775 INTEGER :: ITRI, IM1, IM2, IT, JT, ISFIRST, ITOUT, NBRELEVANT 776 REAL :: DIST_MIN, DIST_MAX, EDIST 777 LOGICAL RESOL_CHECK 778 ! 779 !/ 780 ! 781 ! -------------------------------------------------------------------- / 782 ! 1. Test grid, Initialize and synchronize grids as needed ( !/MPI ) 783 ! 784 FLBARR = .FALSE. 785 ! 786 DO I=1, NRGRD 787 ! 788 IF ( .NOT. GRIDS(I)%GINIT ) THEN 789 IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1000) I 790 CALL EXTCDE ( 1000 ) 791 END IF 792 793 CALL W3SETO ( I, MDSE, MDST ) 794 CALL W3SETG ( I, MDSE, MDST ) 795 ! 796 FLBARR = FLBARR .OR. MDATAS(I)%FBCAST 797 IF ( MDATAS(I)%FBCAST .AND. & 798 MDATAS(I)%MPI_COMM_BCT.NE.MPI_COMM_NULL ) THEN 799 NXYG = GRIDS(I)%NX * GRIDS(I)%NY 800 CALL MPI_BCAST ( GRIDS(I)%MAPSTA(1,1), NXYG, & 801 MPI_INTEGER, 0, & 802 MDATAS(I)%MPI_COMM_BCT, IERR_MPI ) 803 CALL MPI_BCAST ( GRIDS(I)%MAPST2(1,1), NXYG, & 804 MPI_INTEGER, 0, & 805 MDATAS(I)%MPI_COMM_BCT, IERR_MPI ) 806 CALL MPI_BCAST ( GRIDS(I)%MAPFS (1,1), NXYG, & 807 MPI_INTEGER, 0, & 808 MDATAS(I)%MPI_COMM_BCT, IERR_MPI ) 809 NXYG = 3*GRIDS(I)%NSEA 810 CALL MPI_BCAST ( GRIDS(I)%MAPSF (1,1), NXYG, & 811 MPI_INTEGER, 0, & 812 MDATAS(I)%MPI_COMM_BCT, IERR_MPI ) 813 CALL MPI_BCAST ( GRIDS(I)%CLATIS(1), NSEA, MPI_REAL, 0,& 814 MDATAS(I)%MPI_COMM_BCT, IERR_MPI ) 815 CALL MPI_BCAST ( SGRDS(I)%SIG(0), NK+2, MPI_REAL, 0,& 816 MDATAS(I)%MPI_COMM_BCT, IERR_MPI ) 817 END IF 818 ! 819 END DO 820 ! 821 IF (FLBARR) CALL MPI_BARRIER (MPI_COMM_MWAVE,IERR_MPI) 822 ! 823 ! -------------------------------------------------------------------- / Page 6 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 824 ! 2. Process grids 825 ! 826 IF ( FLAGLL ) THEN 827 FACTOR = 1. 828 ELSE 829 FACTOR = 1.E-3 830 END IF 831 ! 832 GRIDD = .FALSE. 833 RFILE = .FALSE. 834 ! 835 IF ( .NOT. ALLOCATED(NBI2G) ) ALLOCATE ( NBI2G(NRGRD,NRGRD) ) 836 NBI2G = 0 837 ! 838 DO I=1, NRGRD 839 ! 840 ! 2.a Test for input boundary points 841 ! 842 IF ( OUTPTS(I)%OUT5%NBI .EQ. 0 ) THEN 843 CYCLE 844 END IF 845 ! 846 ! 2.b Test for lowest rank 847 ! 848 IF ( GRANK(I) .EQ. 1 ) THEN 849 RFILE(I) = .TRUE. 850 CYCLE 851 END IF 852 ! 853 ! 2.c Search for input boundary points 854 ! 855 856 IBI = 0 857 ! 858 ! ... Set up data structure for grid 859 ! 860 CALL W3SETO ( I, MDSE, MDST ) 861 CALL W3SETG ( I, MDSE, MDST ) 862 CALL W3DMO5 ( I, MDSE, MDST, 1 ) 863 ALLOCATE ( TSTORE(NBI,0:4) ) 864 ! 865 ! ... Set up loop structure for grid 866 ! 867 DO IY=1, NY 868 DO IX=1, NX 869 870 !notes : MAPSTA refers to GRIDS(I)%MAPSTA ...this is set in W3SETG 871 IF ( ABS(MAPSTA(IY,IX)) .EQ. 2 ) THEN 872 XA = XGRD(IY,IX) !old code: X0 + REAL(IX-1)*SX 873 YA = YGRD(IY,IX) !old code: Y0 + REAL(IY-1)*SY 874 ! 875 ! ... Loop over previous (lower ranked) grids, going in order from highest 876 ! of lower ranked grids (I-1) to lowest of lower ranked grids (1) 877 ! 878 JS = 0 879 ! 880 DO J=I-1, 1, -1 Page 7 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 881 ! 882 IF ( GRANK(J) .GE. GRANK(I) ) CYCLE 883 ! 884 ! ... Check if in grid 885 886 ! notes: 887 ! old version (v4.00): 888 ! if in grid, return location in grid: a) JX, JY 889 ! (lower left indices of cell), 890 ! b) RX, RY 891 ! (normalized location in cell) 892 ! in not in grid, cycle (search next grid) 893 ! new version (v4.01): 894 ! Check if point within grid and compute interpolation weights using GSU 895 ! in not in grid, cycle (search next grid) 896 ! 897 IF (GRIDS(J)%GTYPE .EQ. UNGTYPE) THEN 898 CALL IS_IN_UNGRID_PLUS_COEFFICIENT(J, XA, YA, itout, IVER, JVER, RW) 899 IF (itout.eq.0) THEN 900 INGRID=.FALSE. 901 ELSE 902 INGRID=.TRUE. 903 FLAGOK =( ABS(GRIDS(J)%MAPSTA(JVER(1),IVER(1))).GE.1 .OR. & 904 RW(1).LT.0.05 ) .AND. & 905 ( ABS(GRIDS(J)%MAPSTA(JVER(2),IVER(2))).GE.1 .OR. & 906 RW(2).LT.0.05 ) .AND. & 907 ( ABS(GRIDS(J)%MAPSTA(JVER(3),IVER(3))).GE.1 .OR. & 908 RW(3) .LT.0.05 ) 909 END IF 910 NbRelevant=3 911 ELSE 912 INGRID = W3GRMP( GRIDS(J)%GSU, XA, YA, IVER , JVER, RW ) 913 ! Print *, 'J=', J, 'IX=', IX, 'IY=', IY 914 ! Print *, 'IN=', INGRID, 'XA=', XA, 'YA=', YA 915 ! Print *, ' 1: IVER=', IVER(1), 'JVER=', JVER(1), 'RW=', RW(1) 916 ! Print *, ' 2: IVER=', IVER(2), 'JVER=', JVER(2), 'RW=', RW(2) 917 ! Print *, ' 3: IVER=', IVER(3), 'JVER=', JVER(3), 'RW=', RW(3) 918 ! Print *, ' 4: IVER=', IVER(4), 'JVER=', JVER(4), 'RW=', RW(4) 919 IF (INGRID) THEN 920 FLAGOK =( ABS(GRIDS(J)%MAPSTA(JVER(1),IVER(1))).GE.1 .OR. & 921 RW(1).LT.0.05 ) .AND. & 922 ( ABS(GRIDS(J)%MAPSTA(JVER(2),IVER(2))).GE.1 .OR. & 923 RW(2).LT.0.05 ) .AND. & 924 ( ABS(GRIDS(J)%MAPSTA(JVER(4),IVER(4))).GE.1 .OR. & 925 RW(4) .LT.0.05 ) .AND. & 926 ( ABS(GRIDS(J)%MAPSTA(JVER(3),IVER(3))).GE.1 .OR. & 927 RW(3) .LT.0.05 ) 928 END IF 929 NbRelevant=4 930 END IF 931 ! internal name= GSU XTIN YTIN IS JS RW (notes) 932 ! role=out in in in out out out 933 ! size= --- 1 1 4 4 4 934 ! 935 ! notes: 936 ! - organization of IVER(4),JVER(4),RW(4) as returned by W3GRMP are 937 ! as follows: Page 8 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 938 ! Point 1 : lower i , lower j (JY1,JX1) 939 ! Point 2 : upper i , lower j (JY1,JX2) 940 ! Point 3 : upper i , upper j (JY2,JX2) 941 ! Point 4 : lower i , upper j (JY2,JX1) 942 ! (counter-clockwise starting from lower i, lower j) 943 ! 944 ! ... if not in grid, warning message and cycle (search next grid) 945 IF ( .NOT.INGRID ) THEN 946 CYCLE 947 END IF 948 949 ! 950 ! ... Check against MAPSTA 951 ! 952 953 ! Notes: 954 ! Old code | becomes | New code 955 !-----------------| --------| ------- 956 ! (1.-RX)*(1.-RY) | becomes | RW(1) 957 ! RX*(1.-RY) | becomes | RW(2) 958 ! (1.-RX)*RY | becomes | RW(4) 959 ! RX*RY | becomes | RW(3) 960 ! JX1 | becomes | IVER(1) 961 ! JY1 | becomes | JVER(1) 962 ! JX2 | becomes | IVER(3) 963 ! JY2 | becomes | JVER(3) 964 965 ! Notes: 966 ! IVER(1)=IVER(4), IVER(2)=IVER(3) 967 ! JVER(1)=JVER(2), JVER(3)=JVER(4) 968 969 ! point 1: 970 FLAGOK = ( ABS(GRIDS(J)%MAPSTA(JVER(1),IVER(1))).GE.1 .OR. & 971 RW(1).LT.0.05 ) .AND. & 972 ! point 2: 973 ( ABS(GRIDS(J)%MAPSTA(JVER(2),IVER(2))).GE.1 .OR. & 974 RW(2).LT.0.05 ) .AND. & 975 ! point 4: 976 ( ABS(GRIDS(J)%MAPSTA(JVER(4),IVER(4))).GE.1 .OR. & 977 RW(4) .LT.0.05 ) .AND. & 978 ! point 3: 979 ( ABS(GRIDS(J)%MAPSTA(JVER(3),IVER(3))).GE.1 .OR. & 980 RW(3) .LT.0.05 ) 981 ! 982 IF ( .NOT.FLAGOK ) CYCLE 983 ! 984 ! ... We found interpolation data ! 985 ! 986 JS = J 987 IBI = IBI + 1 988 GRIDD(I,JS) = .TRUE. 989 ! 990 XBPI(IBI) = XA 991 YBPI(IBI) = YA 992 ISBPI(IBI) = MAPFS(IY,IX) 993 ! 994 TSTORE(IBI, 0) = JS Page 9 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 995 ! 996 ! notes: 997 ! To maintain perfect consistency with old code, we would make code such that: 998 ! - point 1 in GSU goes to point 1 in RDBPI, TSTORE 999 ! - point 2 in GSU goes to point 2 in RDBPI, TSTORE 1000 ! - point 4 in GSU goes to point 3 in RDBPI, TSTORE 1001 ! - point 3 in GSU goes to point 4 in RDBPI, TSTORE 1002 ! Instead, here, we map point 4 in GSU goes to point 4 in RDBPI, TSTORE, etc. 1003 ! Thus the ordering of RDBPI, TSTORE has changed. 1004 ! I have no reason to believe that the ordering in RDBPI, TSTORE is important. 1005 ! I have gone through test case mww3_test_02 for gridsets a,b,c,d and found 1006 ! no change in result vs v4.00. 1007 1008 DO KVER=1,4 1009 IF (KVER .LE. NbRelevant) THEN 1010 IF ( ABS(GRIDS(J)%MAPSTA(JVER(KVER),IVER(KVER))).GE.1 & 1011 .AND. RW(KVER) .GT.0.05 ) THEN 1012 RDBPI (IBI,KVER) = RW(KVER) 1013 TSTORE(IBI,KVER) = GRIDS(J)%MAPFS(JVER(KVER),IVER(KVER)) 1014 ELSE 1015 RDBPI (IBI,KVER) = 0. 1016 TSTORE(IBI,KVER) = 0 1017 END IF 1018 ELSE 1019 RDBPI (IBI,KVER) = 0. 1020 TSTORE(IBI,KVER) = 0 1021 END IF 1022 1023 END DO 1024 1025 ! 1026 ! .....normalize weights to give sum(R)=1 1027 RDBPI(IBI,:) = RDBPI(IBI,:) / SUM(RDBPI(IBI,:)) 1028 ! 1029 ! Search was successful, so no need to search through other grids, so exit loop 1030 EXIT 1031 END DO ! "DO J=..." 1032 ! 1033 IF ( JS.EQ.0 .AND. IMPROC.EQ.NMPERR ) & 1034 WRITE (MDSE,1020) I, IX, IY, XA, YA 1035 ! 1036 END IF ! If a boundary point... 1037 1038 END DO ! "DO IX=..." 1039 END DO ! "DO IY=..." 1040 1041 ! 1042 ! 2.d Error checks 1043 ! 1044 IF ( IBI .EQ. 0 ) THEN 1045 RFILE(I) = .TRUE. 1046 IF ( IMPROC .EQ. NMPERR ) WRITE (MDSE,1021) 1047 DEALLOCATE ( OUTPTS(I)%OUT5%IPBPI, OUTPTS(I)%OUT5%ISBPI, & 1048 OUTPTS(I)%OUT5%XBPI, OUTPTS(I)%OUT5%YBPI, & 1049 OUTPTS(I)%OUT5%RDBPI ) 1050 CYCLE 1051 ELSE IF ( IBI .NE. OUTPTS(I)%OUT5%NBI ) THEN Page 10 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 1052 CALL EXTCDE ( 1020 ) 1053 ENDIF 1054 ! 1055 ! 2.e Sort spectra by grid, fill IPBPI, and get NBI2 and .... 1056 ! 1057 1058 IPBPI = 0 1059 NBI2 = 0 1060 ! 1061 DO J=1, NRGRD 1062 DO I1=1, NBI 1063 IF ( TSTORE(I1,0) .NE. J ) CYCLE 1064 DO J1=1, 4 1065 IF ( TSTORE(I1,J1).NE.0 .AND. IPBPI(I1,J1).EQ.0 ) THEN 1066 NBI2 = NBI2 + 1 1067 IPBPI(I1,J1) = NBI2 1068 DO I2=I1, NBI 1069 IF ( TSTORE(I2,0) .NE. J ) CYCLE 1070 DO J2=1, 4 1071 IF ( TSTORE(I2,J2) .EQ. TSTORE(I1,J1) ) & 1072 IPBPI(I2,J2) = NBI2 1073 END DO 1074 END DO 1075 END IF 1076 END DO 1077 END DO 1078 END DO 1079 ! 1080 ! 2.f Set up spectral storage and cross-grid mapping 1081 ! 1082 CALL W3DMO5 ( I, MDSE, MDST, 3 ) 1083 ! 1084 ALLOCATE ( MDATAS(I)%NBI2S(NBI2,2) ) 1085 NBI2S => MDATAS(I)%NBI2S 1086 ! 1087 DO I1=1, NBI 1088 DO J1=1, 4 1089 IF ( IPBPI(I1,J1) .NE. 0 ) THEN 1090 NBI2S(IPBPI(I1,J1),1) = TSTORE(I1,0) 1091 NBI2S(IPBPI(I1,J1),2) = TSTORE(I1,J1) 1092 END IF 1093 END DO 1094 END DO 1095 ! 1096 DO I1=1, NBI2 1097 NBI2G(I,NBI2S(I1,1)) = NBI2G(I,NBI2S(I1,1)) + 1 1098 END DO 1099 ! 1100 ! 2.g Test output 1101 ! 1102 DEALLOCATE ( TSTORE ) 1103 ! 1104 END DO 1105 ! 1106 ! -------------------------------------------------------------------- / 1107 ! 3. Finalyze grid dependencies in GRDLOW 1108 ! 3.a Get size of array and dimension Page 11 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 1109 ! 1110 1111 ! notes: 1112 ! GRIDD(I,J) indicates whether grid I is dependent on lower ranked grid J 1113 ! JS counts the number of grids J that grid I is dependent on 1114 ! GRDLOW is sized to accomodate the grid with the largest JS 1115 1116 JTOT = 0 1117 DO I=1, NRGRD 1118 JS = 0 1119 DO J=1, NRGRD 1120 IF ( GRIDD(I,J) ) JS = JS + 1 1121 END DO 1122 JTOT = MAX ( JTOT , JS ) 1123 END DO 1124 ! 1125 IF ( ALLOCATED(GRDLOW) ) DEALLOCATE ( GRDLOW ) 1126 ALLOCATE ( GRDLOW(NRGRD,0:JTOT) ) 1127 GRDLOW = 0 1128 ! 1129 ! 3.b Fill array 1130 ! 1131 FLAGOK = .TRUE. 1132 ! 1133 DO I=1, NRGRD 1134 JTOT = 0 1135 DO J=1, NRGRD 1136 IF ( GRIDD(I,J) ) THEN 1137 JTOT = JTOT + 1 1138 GRDLOW(I,JTOT) = J 1139 ! ... error checking: catch situation where ranks are inconsistent with 1140 ! resolution 1141 1142 ! notes: 1143 ! old code: SXJ=GRIDS(J)%SX 1144 ! SXI=GRIDS(I)%SX 1145 ! SYJ=GRIDS(J)%SY 1146 ! SYI=GRIDS(I)%SY 1147 ! also, old code did not need to check both min and max, 1148 ! since they were the same 1149 ! new code: 1150 ! SXI(:,:) ==> GRIDS(I)%HPFAC ! resolution in higher rank grid I 1151 ! (approximate in case of irregular grids) 1152 ! SYI(:,:) ==> GRIDS(I)%HQFAC ! viz. 1153 ! SXJ(:,:) ==> GRIDS(J)%HPFAC ! resolution in lower rank grid J 1154 ! (approximate in case of irregular grids) 1155 ! SYJ(:,:) ==> GRIDS(J)%HQFAC ! viz. 1156 1157 ! notes: 1158 ! for irregular grids, we require 1159 ! 1) smallest cell in low rank grid is larger than smallest cell 1160 ! in high rank grid 1161 ! 2) largest cell in low rank grid is larger than largest cell 1162 ! in high rank grid 1163 ! Each dimension (along i/p and j/q axes) is checked separately, 1164 ! making 4 checks total. 1165 ! This is strict, and may generate "false positives" in error checking Page 12 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 1166 ! here. In this case, the user may wish to disable this error checking. 1167 ! For case of regular grids, we cannot use HPFAC, since it goes to zero 1168 ! at pole. We instead use good ol' SX and SY 1169 1170 IF ( GRIDS(I)%GTYPE .EQ. CLGTYPE ) THEN 1171 DX_MIN_GRIDI=MINVAL(GRIDS(I)%HPFAC) 1172 DY_MIN_GRIDI=MINVAL(GRIDS(I)%HQFAC) 1173 DX_MAX_GRIDI=MAXVAL(GRIDS(I)%HPFAC) 1174 DY_MAX_GRIDI=MAXVAL(GRIDS(I)%HQFAC) 1175 ELSEIF ( GRIDS(I)%GTYPE .EQ. RLGTYPE ) THEN 1176 DX_MIN_GRIDI=GRIDS(I)%SX 1177 DY_MIN_GRIDI=GRIDS(I)%SY 1178 DX_MAX_GRIDI=GRIDS(I)%SX 1179 DY_MAX_GRIDI=GRIDS(I)%SY 1180 ELSEIF ( GRIDS(I)%GTYPE .EQ. UNGTYPE ) THEN 1181 ISFIRST=1 1182 DIST_MAX=0 1183 DIST_MIN=0 1184 DO ITRI=1,GRIDS(I)%NTRI 1185 DO IT=1,3 1186 IF (IT.EQ.3) THEN 1187 JT=1 1188 ELSE 1189 JT=IT+1 1190 END IF 1191 IM1=GRIDS(I)%TRIGP(ITRI,IT) 1192 IM2=GRIDS(I)%TRIGP(ITRI,JT) 1193 EDIST=W3DIST(FLAGLL, GRIDS(I)%XYB(IM1,1), & 1194 GRIDS(I)%XYB(IM1,2), GRIDS(I)%XYB(IM2,1), & 1195 GRIDS(I)%XYB(IM2,2)) 1196 IF (ISFIRST.EQ.1) THEN 1197 DIST_MAX=EDIST 1198 DIST_MIN=EDIST 1199 ISFIRST=0 1200 ELSE 1201 IF (EDIST.GT.DIST_MAX) THEN 1202 DIST_MAX=EDIST 1203 END IF 1204 IF (EDIST.LT.DIST_MIN) THEN 1205 DIST_MIN=EDIST 1206 END IF 1207 END IF 1208 END DO 1209 END DO 1210 DX_MIN_GRIDI=DIST_MIN 1211 DY_MIN_GRIDI=DIST_MIN 1212 DX_MAX_GRIDI=DIST_MAX 1213 DY_MAX_GRIDI=DIST_MAX 1214 ELSE 1215 print *, 'unknown grid type. stopping.' 1216 stop 1217 END IF 1218 1219 IF ( GRIDS(J)%GTYPE .EQ. CLGTYPE ) THEN 1220 DX_MIN_GRIDJ=MINVAL(GRIDS(J)%HPFAC) 1221 DY_MIN_GRIDJ=MINVAL(GRIDS(J)%HQFAC) 1222 DX_MAX_GRIDJ=MAXVAL(GRIDS(J)%HPFAC) Page 13 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 1223 DY_MAX_GRIDJ=MAXVAL(GRIDS(J)%HQFAC) 1224 ELSEIF ( GRIDS(J)%GTYPE .EQ. RLGTYPE ) THEN 1225 DX_MIN_GRIDJ=GRIDS(J)%SX 1226 DY_MIN_GRIDJ=GRIDS(J)%SY 1227 DX_MAX_GRIDJ=GRIDS(J)%SX 1228 DY_MAX_GRIDJ=GRIDS(J)%SY 1229 ELSEIF ( GRIDS(J)%GTYPE .EQ. UNGTYPE ) THEN 1230 ISFIRST=1 1231 DIST_MAX=0 1232 DIST_MIN=0 1233 DO ITRI=1,GRIDS(J)%NTRI 1234 DO IT=1,3 1235 IF (IT.EQ.3) THEN 1236 JT=1 1237 ELSE 1238 JT=IT+1 1239 END IF 1240 IM1=GRIDS(J)%TRIGP(ITRI,IT) 1241 IM2=GRIDS(J)%TRIGP(ITRI,JT) 1242 EDIST=W3DIST(FLAGLL, GRIDS(J)%XYB(IM1,1), & 1243 GRIDS(J)%XYB(IM1,2), GRIDS(J)%XYB(IM2,1), & 1244 GRIDS(J)%XYB(IM2,2)) 1245 IF (ISFIRST.EQ.1) THEN 1246 DIST_MAX=EDIST 1247 DIST_MIN=EDIST 1248 ISFIRST=0 1249 ELSE 1250 IF (EDIST.GT.DIST_MAX) THEN 1251 DIST_MAX=EDIST 1252 END IF 1253 IF (EDIST.LT.DIST_MIN) THEN 1254 DIST_MIN=EDIST 1255 END IF 1256 END IF 1257 END DO 1258 END DO 1259 DX_MIN_GRIDJ=DIST_MIN 1260 DY_MIN_GRIDJ=DIST_MIN 1261 DX_MAX_GRIDJ=DIST_MAX 1262 DY_MAX_GRIDJ=DIST_MAX 1263 ELSE 1264 PRINT *, 'UNKNOWN GRID TYPE. STOPPING.' 1265 STOP 1266 END IF 1267 1268 RESOL_CHECK=.FALSE. 1269 IF (RESOL_CHECK) THEN 1270 IF ( DX_MIN_GRIDJ .LT. 0.99*DX_MIN_GRIDI .OR. & 1271 DY_MIN_GRIDJ .LT. 0.99*DY_MIN_GRIDI .OR. & 1272 DX_MAX_GRIDJ .LT. 0.99*DX_MAX_GRIDI .OR. & 1273 DY_MAX_GRIDJ .LT. 0.99*DY_MAX_GRIDI ) THEN 1274 Print *, 'DX_MIN_GRID I=', DX_MIN_GRIDI, ' J=', DX_MIN_GRIDJ 1275 Print *, 'DX_MAX_GRID I=', DX_MAX_GRIDI, ' J=', DX_MAX_GRIDJ 1276 IF ( IMPROC.EQ.NMPERR ) WRITE (MDSE,1030) & 1277 J, GRANK(J), DX_MIN_GRIDJ, DY_MIN_GRIDJ, & 1278 DX_MAX_GRIDJ, DY_MAX_GRIDJ, & 1279 I, GRANK(I), DX_MIN_GRIDI, DY_MIN_GRIDI, & Page 14 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 1280 DX_MAX_GRIDI, DY_MAX_GRIDI 1281 FLAGOK = .FALSE. 1282 END IF 1283 END IF 1284 1285 END IF ! IF ( GRIDD(I,J) ) THEN 1286 1287 END DO ! DO J=... 1288 GRDLOW(I,0) = JTOT 1289 END DO ! DO I=... 1290 ! 1291 IF ( .NOT. FLAGOK ) CALL EXTCDE ( 1030 ) 1292 ! 1293 ! -------------------------------------------------------------------- / 1294 ! 4. Finalyze grid dependencies in GRDHGH 1295 ! 4.a Get size of array and dimension 1296 ! 1297 JTOT = 0 1298 DO I=1, NRGRD 1299 JS = 0 1300 DO J=1, NRGRD 1301 IF ( GRIDD(J,I) ) JS = JS + 1 1302 END DO 1303 JTOT = MAX ( JTOT , JS ) 1304 END DO 1305 ! 1306 IF ( ALLOCATED(GRDHGH) ) DEALLOCATE ( GRDHGH ) 1307 ALLOCATE ( GRDHGH(NRGRD,0:JTOT) ) 1308 GRDHGH = 0 1309 ! 1310 ! 4.b Fill array 1311 ! 1312 DO I=1, NRGRD ! low rank grid 1313 JTOT = 0 1314 DO J=1, NRGRD 1315 IF ( GRIDD(J,I) ) THEN ! grid j is of higher rank than grid i 1316 ! *and* there is dependency 1317 JTOT = JTOT + 1 ! count the number of grids of higher 1318 ! rank than grid i 1319 GRDHGH(I,JTOT) = J ! save the grid number of the higher rank grid 1320 END IF 1321 END DO 1322 GRDHGH(I,0) = JTOT ! save the count of higher ranked grids 1323 END DO 1324 ! 1325 ! -------------------------------------------------------------------- / 1326 ! 5. Export file flags 1327 ! 1328 IF ( PRESENT(FLRBPI) ) FLRBPI = RFILE 1329 ! 1330 RETURN 1331 ! 1332 ! Formats 1333 ! 1334 1000 FORMAT (/' *** WAVEWATCH III ERROR IN WMGLOW : *** '/ & 1335 ' GRID NOT INITIALIZED, GRID NR',I4 /) 1336 ! Page 15 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 1337 1020 FORMAT (/' *** WAVEWATCH III ERROR IN WMGLOW : *** '/ & 1338 ' CANNOT FIND SOURCE FOR BOUNDARY DATA '/ & 1339 ' GRID, IX, IY, X, Y:',3I6,2E12.4/) 1340 ! 1341 1021 FORMAT (/' *** WAVEWATCH III ERROR IN WMGLOW : *** '/ & 1342 ' NONE OF BOUNDARY POINTS CAN BE MAPPED'/ & 1343 ' READING FROM FILE INSTEAD'/) 1344 ! 1345 1030 FORMAT (/' *** WAVEWATCH III ERROR IN WMGLOW : *** '/ & 1346 ' RANKS AND RESOLUTIONS INCONSISTENT'/ & 1347 ' GRID',I4,' RANK',I4,' RESOLUTION :',4E10.3/ & 1348 ' GRID',I4,' RANK',I4,' RESOLUTION :',4E10.3/) 1349 ! 1350 2000 FORMAT (/' *** WAVEWATCH-III WARNING : BOUNDARY POINT'/ & 1351 ' NOT FOUND IN LOWER RANK GRID : ',2F10.3/ & 1352 ' POINT SKIPPED '/) 1353 ! 1354 2001 FORMAT (/' *** WAVEWATCH-III WARNING : BOUNDARY POINT'/ & 1355 ' NOT FOUND IN LOWER RANK GRID : ',2E10.3/ & 1356 ' POINT SKIPPED '/) 1357 ! 1358 !/ 1359 !/ End of WMGLOW ----------------------------------------------------- / 1360 !/ 1361 END SUBROUTINE WMGLOW ENTRY POINTS Name wmgridmd_mp_wmglow_ Page 16 Source Listing WMGLOW 2014-09-16 16:48 Symbol Table wmgridmd.f90 SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1000 Label 796 251 1020 Label 799 496 1021 Label 803 508 1030 Label 807 738 2000 Label 812 2001 Label 816 ABS Func 333 scalar 333,365,367,369,382,384,386,388,43 2,435,438,441,472 ALLOCATED Func 297 scalar 297,587,768 CLATIS Local 275 R(4) 4 1 1 PTR 275 CLGTYPE Param 632 I(4) 4 scalar 632,681 DIST_MAX Local 238 R(4) 4 scalar 644,659,663,664,674,675,693,708,71 2,713,723,724 DIST_MIN Local 238 R(4) 4 scalar 645,660,666,667,672,673,694,709,71 5,716,721,722 DX_MAX_GRIDI Local 233 R(4) 4 scalar 635,640,674,734,737,742 DX_MAX_GRIDJ Local 235 R(4) 4 scalar 684,689,723,734,737,740 DX_MIN_GRIDI Local 233 R(4) 4 scalar 633,638,672,732,736,741 DX_MIN_GRIDJ Local 235 R(4) 4 scalar 682,687,721,732,736,739 DY_MAX_GRIDI Local 234 R(4) 4 scalar 636,641,675,735,742 DY_MAX_GRIDJ Local 236 R(4) 4 scalar 685,690,724,735,740 DY_MIN_GRIDI Local 233 R(4) 4 scalar 634,639,673,733,741 DY_MIN_GRIDJ Local 235 R(4) 4 scalar 683,688,722,733,739 EDIST Local 238 R(4) 4 scalar 655,659,660,663,664,666,667,704,70 8,709,712,713,715,716 EXTCDE Subr 196 196,252,514,753 FACTOR Local 221 R(4) 4 scalar 289,291 FBCAST Local 258 L(4) 4 scalar 258,259 FLAGLL Local 288 L(4) 4 scalar 288,655,704 FLAGOK Local 224 L(4) 4 scalar 365,382,432,444,593,743,753 FLBARR Local 219 L(4) 4 scalar 246,258,283 FLRBPI Dummy 110 L(4) 4 1 0 ARG,OUT 790 GINIT Local 250 L(4) 4 scalar 250 GRANK Local 310 I(4) 4 1 1 ALC 310,344,739,741 GRDHGH Local 768 I(4) 4 2 1 ALC 768,769,770,781,784 GRDLOW Local 587 I(4) 4 2 1 ALC 587,588,589,600,750 GRIDD Local 222 L(4) 4 2 0 294,450,582,598,763,777 GRIDS Local 250 RECORD 4376 1 1 ALC,TGT 250,261,262,265,268,271,272,275,35 9,365,367,369,374,382,384,386,388, 432,435,438,441,472,475,632,633,63 4,635,636,637,638,639,640,641,642, 646,653,654,655,656,657,681,682,68 3,684,685,686,687,688,689,690,691, 695,702,703,704,705,706 GSU Local 374 T_GSU 8 scalar 374 GTYPE Local 359 I(4) 4 scalar 359,632,637,642,681,686,691 HPFAC Local 633 R(4) 4 2 1 PTR 633,635,682,684 HQFAC Local 634 R(4) 4 2 1 PTR 634,636,683,685 I Local 215 I(4) 4 scalar 248,250,251,255,256,258,259,260,26 1,262,264,265,267,268,270,271,272, 274,275,276,277,278,300,304,310,31 Page 17 Source Listing WMGLOW 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 1,322,323,324,342,344,450,496,507, 509,510,511,513,544,546,547,559,57 9,582,595,598,600,632,633,634,635, 636,637,638,639,640,641,642,646,65 3,654,655,656,657,741,750,760,763, 774,777,781,784 I1 Local 216 I(4) 4 scalar 524,525,527,529,530,533,549,551,55 2,553,558,559 I2 Local 216 I(4) 4 scalar 530,531,533,534 IBI Local 215 I(4) 4 scalar 318,449,452,453,454,456,474,475,47 7,478,481,482,489,506,513 IERR_MPI Local 217 I(4) 4 scalar 264,267,270,274,276,278,283 IM1 Local 237 I(4) 4 scalar 653,655,656,702,704,705 IM2 Local 237 I(4) 4 scalar 654,656,657,703,705,706 IMPROC Local 251 I(4) 4 scalar 251,495,508,738 INGRID Local 225 L(4) 4 scalar 362,364,374,381,407 IPBPI Local 509 I(4) 4 2 1 PTR 509 IPBPI Local 520 I(4) 4 2 1 PTR 520,527,529,534,551,552,553 ISBPI Local 454 I(4) 4 1 1 PTR 454 ISBPI Local 509 I(4) 4 1 1 PTR 509 ISFIRST Local 237 I(4) 4 scalar 643,658,661,692,707,710 IS_IN_UNGRID_PLUS_COEFFICI ENT Subr 360 360 IT Local 237 I(4) 4 scalar 647,648,651,653,696,697,700,702 ITOUT Local 237 I(4) 4 scalar 360,361 ITRI Local 237 I(4) 4 scalar 646,653,654,695,702,703 IVER Local 227 I(4) 4 1 4 360,365,367,369,374,382,384,386,38 8,432,435,438,441,472,475 IX Local 215 I(4) 4 scalar 330,333,334,335,454,496 IY Local 215 I(4) 4 scalar 329,333,334,335,454,496 J Local 215 I(4) 4 scalar 342,344,359,360,365,367,369,374,38 2,384,386,388,432,435,438,441,448, 472,475,523,525,531,581,582,597,59 8,600,681,682,683,684,685,686,687, 688,689,690,691,695,702,703,704,70 5,706,739,762,763,776,777,781 J1 Local 216 I(4) 4 scalar 526,527,529,533,550,551,552,553 J2 Local 216 I(4) 4 scalar 532,533,534 JS Local 215 I(4) 4 scalar 340,448,450,456,495,580,582,584,76 1,763,765 JT Local 237 I(4) 4 scalar 649,651,654,698,700,703 JTOT Local 216 I(4) 4 scalar 578,584,588,596,599,600,750,759,76 5,769,775,779,781,784 JVER Local 227 I(4) 4 1 4 360,365,367,369,374,382,384,386,38 8,432,435,438,441,472,475 KVER Local 231 I(4) 4 scalar 470,471,472,473,474,475,477,478,48 1,482 MAPFS Local 268 I(4) 4 2 1 PTR 268,475 MAPFS Local 454 I(4) 4 2 1 PTR 454 MAPSF Local 272 I(4) 4 2 1 PTR 272 MAPST2 Local 265 I(4) 4 2 1 PTR 265 MAPSTA Local 262 I(4) 4 2 1 PTR 262,365,367,369,382,384,386,388,43 2,435,438,441,472 MAPSTA Local 333 I(4) 4 2 1 PTR 333 MAX Func 584 scalar 584,765 Page 18 Source Listing WMGLOW 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References MAXVAL Func 635 scalar 635,636,684,685 MDATAS Local 258 RECORD 1360 1 1 ALC,TGT 258,259,260,264,267,270,274,276,27 8,546,547 MDSE Local 251 I(4) 4 scalar 251,255,256,322,323,324,496,508,54 4,738 MDST Local 255 I(4) 4 scalar 255,256,322,323,324,544 MINVAL Func 633 scalar 633,634,682,683 MPIPRIV1 Common 532 28 MPIPRIV2 Common 534 24 MPIPRIVC Common 537 2 MPI_2COMPLEX Param 332 I(4) 4 scalar MPI_2DOUBLE_COMPLEX Param 338 I(4) 4 scalar MPI_2DOUBLE_PRECISION Param 334 I(4) 4 scalar MPI_2INT Param 415 I(4) 4 scalar MPI_2INTEGER Param 330 I(4) 4 scalar MPI_2REAL Param 336 I(4) 4 scalar MPI_ADDRESS_KIND Param 372 I(4) 4 scalar MPI_ANY_SOURCE Param 300 I(4) 4 scalar MPI_ANY_TAG Param 302 I(4) 4 scalar MPI_APPNUM Param 269 I(4) 4 scalar MPI_ARGVS_NULL Scalar 83 CHAR 1 2 1 COM MPI_ARGV_NULL Scalar 84 CHAR 1 1 1 COM MPI_BAND Param 217 I(4) 4 scalar MPI_BARRIER Subr 283 283 MPI_BCAST Subr 262 262,265,268,272,275,277 MPI_BOR Param 221 I(4) 4 scalar MPI_BOTTOM Scalar 517 I(4) 4 scalar COM MPI_BSEND_OVERHEAD Param 296 I(4) 4 scalar MPI_BXOR Param 225 I(4) 4 scalar MPI_BYTE Param 342 I(4) 4 scalar MPI_CART Param 308 I(4) 4 scalar MPI_CHAR Param 375 I(4) 4 scalar MPI_CHARACTER Param 340 I(4) 4 scalar MPI_COMBINER_CONTIGUOUS Param 423 I(4) 4 scalar MPI_COMBINER_DARRAY Param 445 I(4) 4 scalar MPI_COMBINER_DUP Param 421 I(4) 4 scalar MPI_COMBINER_F90_COMPLEX Param 449 I(4) 4 scalar MPI_COMBINER_F90_INTEGER Param 451 I(4) 4 scalar MPI_COMBINER_F90_REAL Param 447 I(4) 4 scalar MPI_COMBINER_HINDEXED Param 435 I(4) 4 scalar MPI_COMBINER_HINDEXED_INTE GER Param 433 I(4) 4 scalar MPI_COMBINER_HVECTOR Param 429 I(4) 4 scalar MPI_COMBINER_HVECTOR_INTEG ER Param 427 I(4) 4 scalar MPI_COMBINER_INDEXED Param 431 I(4) 4 scalar MPI_COMBINER_INDEXED_BLOCK Param 437 I(4) 4 scalar MPI_COMBINER_NAMED Param 419 I(4) 4 scalar MPI_COMBINER_RESIZED Param 453 I(4) 4 scalar MPI_COMBINER_STRUCT Param 441 I(4) 4 scalar MPI_COMBINER_STRUCT_INTEGE R Param 439 I(4) 4 scalar MPI_COMBINER_SUBARRAY Param 443 I(4) 4 scalar MPI_COMBINER_VECTOR Param 425 I(4) 4 scalar MPI_COMM_BCT Local 260 I(4) 4 scalar 260,264,267,270,274,276,278 Page 19 Source Listing WMGLOW 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References MPI_COMM_DUP_FN Subr 521 scalar MPI_COMM_MWAVE Local 283 I(4) 4 scalar 283 MPI_COMM_NULL Param 239 I(4) 4 scalar 260 MPI_COMM_NULL_COPY_FN Subr 522 scalar MPI_COMM_NULL_DELETE_FN Subr 521 scalar MPI_COMM_SELF Param 235 I(4) 4 scalar MPI_COMM_WORLD Param 233 I(4) 4 scalar MPI_COMPLEX Param 318 I(4) 4 scalar MPI_COMPLEX16 Param 368 I(4) 4 scalar MPI_COMPLEX32 Param 370 I(4) 4 scalar MPI_COMPLEX8 Param 366 I(4) 4 scalar MPI_CONGRUENT Param 201 I(4) 4 scalar MPI_CONVERSION_FN_NULL Subr 527 scalar MPI_DATATYPE_NULL Param 249 I(4) 4 scalar 359 MPI_DISPLACEMENT_CURRENT Param 515 I(8) 8 scalar MPI_DISTRIBUTE_BLOCK Param 507 I(4) 4 scalar MPI_DISTRIBUTE_CYCLIC Param 509 I(4) 4 scalar MPI_DISTRIBUTE_DFLT_DARG Param 513 I(4) 4 scalar MPI_DISTRIBUTE_NONE Param 511 I(4) 4 scalar MPI_DOUBLE Param 397 I(4) 4 scalar MPI_DOUBLE_COMPLEX Param 320 I(4) 4 scalar MPI_DOUBLE_INT Param 409 I(4) 4 scalar MPI_DOUBLE_PRECISION Param 326 I(4) 4 scalar MPI_DUP_FN Subr 518 scalar MPI_ERRCODES_IGNORE Scalar 82 I(4) 4 1 1 COM MPI_ERRHANDLER_NULL Param 253 I(4) 4 scalar MPI_ERROR Param 76 I(4) 4 scalar MPI_ERRORS_ARE_FATAL Param 195 I(4) 4 scalar MPI_ERRORS_RETURN Param 197 I(4) 4 scalar MPI_ERR_ACCESS Param 189 I(4) 4 scalar MPI_ERR_AMODE Param 173 I(4) 4 scalar MPI_ERR_ARG Param 109 I(4) 4 scalar MPI_ERR_ASSERT Param 131 I(4) 4 scalar MPI_ERR_BAD_FILE Param 163 I(4) 4 scalar MPI_ERR_BASE Param 97 I(4) 4 scalar MPI_ERR_BUFFER Param 115 I(4) 4 scalar MPI_ERR_COMM Param 137 I(4) 4 scalar MPI_ERR_CONVERSION Param 193 I(4) 4 scalar MPI_ERR_COUNT Param 93 I(4) 4 scalar MPI_ERR_DIMS Param 179 I(4) 4 scalar MPI_ERR_DISP Param 125 I(4) 4 scalar MPI_ERR_DUP_DATAREP Param 117 I(4) 4 scalar MPI_ERR_FILE Param 91 I(4) 4 scalar MPI_ERR_FILE_EXISTS Param 133 I(4) 4 scalar MPI_ERR_FILE_IN_USE Param 165 I(4) 4 scalar MPI_ERR_GROUP Param 145 I(4) 4 scalar MPI_ERR_INFO Param 159 I(4) 4 scalar MPI_ERR_INFO_KEY Param 103 I(4) 4 scalar MPI_ERR_INFO_NOKEY Param 129 I(4) 4 scalar MPI_ERR_INFO_VALUE Param 153 I(4) 4 scalar MPI_ERR_INTERN Param 185 I(4) 4 scalar MPI_ERR_IN_STATUS Param 101 I(4) 4 scalar MPI_ERR_IO Param 187 I(4) 4 scalar MPI_ERR_KEYVAL Param 139 I(4) 4 scalar MPI_ERR_LASTCODE Param 121 I(4) 4 scalar Page 20 Source Listing WMGLOW 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References MPI_ERR_LOCKTYPE Param 105 I(4) 4 scalar MPI_ERR_NAME Param 141 I(4) 4 scalar MPI_ERR_NOT_SAME Param 155 I(4) 4 scalar MPI_ERR_NO_MEM Param 161 I(4) 4 scalar MPI_ERR_NO_SPACE Param 191 I(4) 4 scalar MPI_ERR_NO_SUCH_FILE Param 181 I(4) 4 scalar MPI_ERR_OP Param 107 I(4) 4 scalar MPI_ERR_OTHER Param 87 I(4) 4 scalar MPI_ERR_PENDING Param 135 I(4) 4 scalar MPI_ERR_PORT Param 127 I(4) 4 scalar MPI_ERR_QUOTA Param 171 I(4) 4 scalar MPI_ERR_RANK Param 177 I(4) 4 scalar MPI_ERR_READ_ONLY Param 111 I(4) 4 scalar MPI_ERR_REQUEST Param 143 I(4) 4 scalar MPI_ERR_RMA_CONFLICT Param 99 I(4) 4 scalar MPI_ERR_RMA_SYNC Param 157 I(4) 4 scalar MPI_ERR_ROOT Param 175 I(4) 4 scalar MPI_ERR_SERVICE Param 183 I(4) 4 scalar MPI_ERR_SIZE Param 113 I(4) 4 scalar MPI_ERR_SPAWN Param 95 I(4) 4 scalar MPI_ERR_TAG Param 151 I(4) 4 scalar MPI_ERR_TOPOLOGY Param 147 I(4) 4 scalar MPI_ERR_TRUNCATE Param 123 I(4) 4 scalar MPI_ERR_TYPE Param 149 I(4) 4 scalar MPI_ERR_UNKNOWN Param 167 I(4) 4 scalar MPI_ERR_UNSUPPORTED_DATARE P Param 119 I(4) 4 scalar MPI_ERR_UNSUPPORTED_OPERAT ION Param 169 I(4) 4 scalar MPI_ERR_WIN Param 89 I(4) 4 scalar MPI_FILE_NULL Param 243 I(4) 4 scalar MPI_FLOAT Param 395 I(4) 4 scalar MPI_FLOAT_INT Param 407 I(4) 4 scalar MPI_GRAPH Param 306 I(4) 4 scalar MPI_GROUP_EMPTY Param 237 I(4) 4 scalar MPI_GROUP_NULL Param 245 I(4) 4 scalar MPI_HOST Param 259 I(4) 4 scalar MPI_IDENT Param 199 I(4) 4 scalar MPI_INFO_NULL Param 255 I(4) 4 scalar MPI_INT Param 387 I(4) 4 scalar MPI_INTEGER Param 328 I(4) 4 scalar 263,266,269,273 MPI_INTEGER1 Param 350 I(4) 4 scalar MPI_INTEGER16 Param 358 I(4) 4 scalar MPI_INTEGER2 Param 352 I(4) 4 scalar MPI_INTEGER4 Param 354 I(4) 4 scalar MPI_INTEGER8 Param 356 I(4) 4 scalar MPI_IN_PLACE Scalar 517 I(4) 4 scalar COM MPI_IO Param 261 I(4) 4 scalar MPI_KEYVAL_INVALID Param 294 I(4) 4 scalar MPI_LAND Param 215 I(4) 4 scalar MPI_LASTUSEDCODE Param 267 I(4) 4 scalar MPI_LB Param 346 I(4) 4 scalar MPI_LOCK_EXCLUSIVE Param 314 I(4) 4 scalar MPI_LOCK_SHARED Param 316 I(4) 4 scalar MPI_LOGICAL Param 322 I(4) 4 scalar Page 21 Source Listing WMGLOW 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References MPI_LONG Param 391 I(4) 4 scalar MPI_LONG_DOUBLE Param 399 I(4) 4 scalar MPI_LONG_DOUBLE_INT Param 417 I(4) 4 scalar MPI_LONG_INT Param 411 I(4) 4 scalar MPI_LONG_LONG Param 405 I(4) 4 scalar MPI_LONG_LONG_INT Param 401 I(4) 4 scalar MPI_LOR Param 219 I(4) 4 scalar MPI_LXOR Param 223 I(4) 4 scalar MPI_MAX Param 207 I(4) 4 scalar MPI_MAXLOC Param 229 I(4) 4 scalar MPI_MAX_DATAREP_STRING Param 289 I(4) 4 scalar MPI_MAX_ERROR_STRING Param 277 I(4) 4 scalar MPI_MAX_INFO_KEY Param 283 I(4) 4 scalar MPI_MAX_INFO_VAL Param 285 I(4) 4 scalar MPI_MAX_OBJECT_NAME Param 281 I(4) 4 scalar MPI_MAX_PORT_NAME Param 279 I(4) 4 scalar MPI_MAX_PROCESSOR_NAME Param 287 I(4) 4 scalar MPI_MIN Param 209 I(4) 4 scalar MPI_MINLOC Param 227 I(4) 4 scalar MPI_MODE_APPEND Param 493 I(4) 4 scalar MPI_MODE_CREATE Param 489 I(4) 4 scalar MPI_MODE_DELETE_ON_CLOSE Param 485 I(4) 4 scalar MPI_MODE_EXCL Param 491 I(4) 4 scalar MPI_MODE_NOCHECK Param 461 I(4) 4 scalar MPI_MODE_NOPRECEDE Param 467 I(4) 4 scalar MPI_MODE_NOPUT Param 465 I(4) 4 scalar MPI_MODE_NOSTORE Param 463 I(4) 4 scalar MPI_MODE_NOSUCCEED Param 469 I(4) 4 scalar MPI_MODE_RDONLY Param 479 I(4) 4 scalar MPI_MODE_RDWR Param 481 I(4) 4 scalar MPI_MODE_SEQUENTIAL Param 495 I(4) 4 scalar MPI_MODE_UNIQUE_OPEN Param 487 I(4) 4 scalar MPI_MODE_WRONLY Param 483 I(4) 4 scalar MPI_NULL_COPY_FN Subr 518 scalar MPI_NULL_DELETE_FN Subr 518 scalar MPI_OFFSET_KIND Param 372 I(4) 4 scalar MPI_OP_NULL Param 247 I(4) 4 scalar MPI_ORDER_C Param 503 I(4) 4 scalar MPI_ORDER_FORTRAN Param 505 I(4) 4 scalar MPI_PACKED Param 348 I(4) 4 scalar MPI_PROC_NULL Param 298 I(4) 4 scalar MPI_PROD Param 213 I(4) 4 scalar MPI_REAL Param 324 I(4) 4 scalar 275,277 MPI_REAL16 Param 364 I(4) 4 scalar MPI_REAL4 Param 360 I(4) 4 scalar MPI_REAL8 Param 362 I(4) 4 scalar MPI_REPLACE Param 231 I(4) 4 scalar MPI_REQUEST_NULL Param 251 I(4) 4 scalar MPI_ROOT Param 304 I(4) 4 scalar MPI_SEEK_CUR Param 499 I(4) 4 scalar MPI_SEEK_END Param 501 I(4) 4 scalar MPI_SEEK_SET Param 497 I(4) 4 scalar MPI_SHORT Param 383 I(4) 4 scalar MPI_SHORT_INT Param 413 I(4) 4 scalar MPI_SIGNED_CHAR Param 377 I(4) 4 scalar Page 22 Source Listing WMGLOW 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References MPI_SIMILAR Param 203 I(4) 4 scalar MPI_SOURCE Param 76 I(4) 4 scalar MPI_STATUSES_IGNORE Scalar 81 I(4) 4 2 5 COM MPI_STATUS_IGNORE Scalar 80 I(4) 4 1 5 COM MPI_STATUS_SIZE Param 78 I(4) 4 scalar 80,81 MPI_SUBVERSION Param 312 I(4) 4 scalar MPI_SUCCESS Param 85 I(4) 4 scalar MPI_SUM Param 211 I(4) 4 scalar MPI_TAG Param 76 I(4) 4 scalar MPI_TAG_UB Param 257 I(4) 4 scalar MPI_THREAD_FUNNELED Param 473 I(4) 4 scalar MPI_THREAD_MULTIPLE Param 477 I(4) 4 scalar MPI_THREAD_SERIALIZED Param 475 I(4) 4 scalar MPI_THREAD_SINGLE Param 471 I(4) 4 scalar MPI_TYPECLASS_COMPLEX Param 459 I(4) 4 scalar MPI_TYPECLASS_INTEGER Param 457 I(4) 4 scalar MPI_TYPECLASS_REAL Param 455 I(4) 4 scalar MPI_TYPE_DUP_FN Subr 525 scalar MPI_TYPE_NULL_COPY_FN Subr 526 scalar MPI_TYPE_NULL_DELETE_FN Subr 525 scalar MPI_UB Param 344 I(4) 4 scalar MPI_UNDEFINED Param 291 I(4) 4 scalar MPI_UNDEFINED_RANK Param 291 I(4) 4 scalar MPI_UNEQUAL Param 205 I(4) 4 scalar MPI_UNIVERSE_SIZE Param 265 I(4) 4 scalar MPI_UNSIGNED Param 389 I(4) 4 scalar MPI_UNSIGNED_CHAR Param 379 I(4) 4 scalar MPI_UNSIGNED_LONG Param 393 I(4) 4 scalar MPI_UNSIGNED_LONG_LONG Param 403 I(4) 4 scalar MPI_UNSIGNED_SHORT Param 385 I(4) 4 scalar MPI_VERSION Param 310 I(4) 4 scalar MPI_WCHAR Param 381 I(4) 4 scalar MPI_WIN_BASE Param 271 I(4) 4 scalar MPI_WIN_DISP_UNIT Param 275 I(4) 4 scalar MPI_WIN_DUP_FN Subr 523 scalar MPI_WIN_NULL Param 241 I(4) 4 scalar MPI_WIN_NULL_COPY_FN Subr 524 scalar MPI_WIN_NULL_DELETE_FN Subr 523 scalar MPI_WIN_SIZE Param 273 I(4) 4 scalar MPI_WTICK Func 519 R(8) 8 scalar MPI_WTIME Func 519 R(8) 8 scalar MPI_WTIME_IS_GLOBAL Param 263 I(4) 4 scalar NBI Local 304 I(4) 4 scalar 304,513 NBI Local 325 I(4) 4 scalar PTR 325,524,530,549 NBI2 Local 521 I(4) 4 scalar PTR 521,528,529,534,546,558 NBI2G Local 297 I(4) 4 2 1 ALC 297,298,559 NBI2S Local 546 I(4) 4 2 1 PTR 546,547 NBI2S Local 547 I(4) 4 2 1 PTR 547,552,553,559 NBRELEVANT Local 237 I(4) 4 scalar 372,391,471 NK Local 277 I(4) 4 scalar PTR 277 NMPERR Local 251 I(4) 4 scalar 251,495,508,738 NRGRD Local 210 I(4) 4 scalar 210,222,224,248,297,300,523,579,58 1,588,595,597,760,762,769,774,776 NSEA Local 271 I(4) 4 scalar 271 NSEA Local 275 I(4) 4 scalar PTR 275 Page 23 Source Listing WMGLOW 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References NTRI Local 646 I(4) 4 scalar 646,695 NX Local 261 I(4) 4 scalar 261 NX Local 330 I(4) 4 scalar PTR 330 NXYG Local 217 I(4) 4 scalar 261,262,265,268,271,272 NY Local 261 I(4) 4 scalar 261 NY Local 329 I(4) 4 scalar PTR 329 OUT5 Local 304 OTYPE5 1640 scalar 304,509,510,511,513 OUTPTS Local 304 RECORD 5960 1 1 ALC,TGT 304,509,510,511,513 PMPI_WTICK Func 520 R(8) 8 scalar PMPI_WTIME Func 520 R(8) 8 scalar PRESENT Func 790 scalar 790 RDBPI Local 474 R(4) 4 2 1 PTR 474,477,481,489 RDBPI Local 511 R(4) 4 2 1 PTR 511 RESOL_CHECK Local 239 L(4) 4 scalar 730,731 RFILE Local 224 L(4) 4 1 0 295,311,507,790 RLGTYPE Param 637 I(4) 4 scalar 637,686 RW Local 230 R(4) 4 1 4 360,366,368,370,374,383,385,387,38 9,433,436,439,442,473,474 SGRDS Local 277 RECORD 1080 1 1 ALC,TGT 277 SIG Local 277 R(4) 4 1 1 PTR 277 SUM Func 489 scalar 489 SX Local 638 R(4) 4 scalar 638,640,687,689 SY Local 639 R(4) 4 scalar 639,641,688,690 TRIGP Local 653 I(4) 4 2 1 PTR 653,654,702,703 TSTORE Local 218 I(4) 4 2 1 ALC 325,456,475,478,482,525,527,531,53 3,552,553,564 UNGTYPE Param 359 I(4) 4 scalar 359,642,691 W3DIST Local 655 scalar 655,704 W3DIST_R8 Func 655 R(8) 8 scalar PRIV 655,704 W3DMO5 Subr 324 324,544 W3GDATMD Module 198 198 W3GRMP Local 374 scalar 374 W3GRMP_R4 Func 374 L(4) 4 scalar PRIV 374 W3ODATMD Module 199 199 W3SERVMD Module 196 196 W3SETG Subr 256 256,323 W3SETO Subr 255 255,322 W3TRIAMD Module 200 200 WMGLOW Subr 110 WMMDATMD Module 201 201 XA Local 220 R(4) 4 scalar 334,360,374,452,496 XBPI Local 452 R(4) 4 1 1 PTR 452 XBPI Local 510 R(4) 4 1 1 PTR 510 XGRD Local 334 R(4) 4 2 1 PTR 334 XYB Local 655 R(8) 8 2 1 PTR 655,656,657,704,705,706 YA Local 220 R(4) 4 scalar 335,360,374,453,496 YBPI Local 453 R(4) 4 1 1 PTR 453 YBPI Local 510 R(4) 4 1 1 PTR 510 YGRD Local 335 R(4) 4 2 1 PTR 335 Page 24 Source Listing WMGLOW 2014-09-16 16:48 wmgridmd.f90 1362 1363 !/ ------------------------------------------------------------------- / 1364 SUBROUTINE WMGHGH 1365 !/ 1366 !/ +-----------------------------------+ 1367 !/ | WAVEWATCH III NOAA/NCEP | 1368 !/ | H. L. Tolman | 1369 !/ | W. E. Rogers | 1370 !/ | FORTRAN 90 | 1371 !/ | Last update : 05-Aug-2013 | 1372 !/ +-----------------------------------+ 1373 !/ 1374 !/ 28-Dec-2005 : Origination. ( version 3.08 ) 1375 !/ 09-Mar-2006 : Carry over land mask. ( version 3.09 ) 1376 !/ 28-Dec-2006 : Simplify NIT for partial comm. ( version 3.10 ) 1377 !/ 07-Feb-2007 : Setting FLAGST. ( version 3.10 ) 1378 !/ 20-May-2009 : Linking FLAGST and FLGHG1. ( version 3.14 ) 1379 !/ 26-May-2009 : Fix erroneous cyclic updating. ( version 3.14 ) 1380 !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 ) 1381 !/ (W. E. Rogers & T. J. Campbell, NRL) 1382 !/ 23-Dec-2010 : Fix HPFAC and HQFAC by including the COS(YGRD) 1383 !/ factor with DXDP and DXDQ terms. ( version 3.14 ) 1384 !/ (T. J. Campbell, NRL) 1385 !/ 07-Jul-2011 : Bug fix for IX bounds with wrapping ( version 3.14+) 1386 !/ grids (see use of "IDSTLA" below) 1387 !/ (W. E. Rogers, NRL) 1388 !/ 02-Aug-2011 : Adapted for use with irregular ( version 3.14+) 1389 !/ grids (W. E. Rogers, NRL) 1390 !/ 21-Sep-2012 : Modified to implement SCRIP remap ( version 4.11 ) 1391 !/ file read and write option 1392 !/ (K. R. Lind, NRL) 1393 !/ 05-Aug-2013 : Change PR2/3 to UQ/UNO in distances.( version 4.12 ) 1394 !/ 1395 ! 1. Purpose : 1396 ! 1397 ! Determine relation to higher ranked grids for each grid. 1398 ! Base map set in WMGLOW, supplemental data computed here. 1399 ! 1400 ! 2. Method : 1401 ! 1402 ! Map averaging information for higher ranked grid to lower 1403 ! ranked grid. 1404 ! 1405 ! 3. Parameters : 1406 ! 1407 ! 4. Subroutines used : 1408 ! 1409 ! Name Type Module Description 1410 ! ---------------------------------------------------------------- 1411 ! W3SETO, W3SETG, W3DMO5, WMSETM 1412 ! Subr. W3xDATMD Manage data structures. 1413 ! STRACE Sur. W3SERVMD Subroutine tracing. 1414 ! EXTCDE Sur. Id. Program abort. 1415 ! ---------------------------------------------------------------- 1416 ! 1417 ! 5. Called by : 1418 ! Page 25 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 1419 ! 6. Error messages : 1420 ! 1421 ! 7. Remarks : 1422 ! 1423 ! Regarding the map of distances to the boundary : 1424 ! - v4.00 : the map of distances to the boundary was intentionally 1425 ! not an accurate characteristic distance. It was felt that 1426 ! it was more important that it be 'safe' and quick to compute. 1427 ! An iterative method was used to compute distance by starting 1428 ! at boundary and working inwards one grid row layer at a time, 1429 ! incrementing distance by dx etc. until the distance map was 1430 ! filled in. This was characterized as "local increment solution 1431 ! only." 1432 ! - v4.01 : conversion to work with irregular grids. Author could not 1433 ! think of any way to retain "local increment solution" method 1434 ! for situation of irregular grids. Therefore method has been 1435 ! changed to compute accurate distances. New method is also 1436 ! more transparent and simpler with much less code, thus 1437 ! easier to modify or debug. It is expected that this method 1438 ! could be more expensive to compute. Isolated timings were 1439 ! not performed. Since the iteration step has been removed, 1440 ! it is hoped that the expense is at least offset somewhat. 1441 ! 1442 ! Regarding method of calculating weights : 1443 ! o If SCRIP software is not compiled into WW3 by user 1444 ! (i.e. if SCRIP switch is not set, then original method 1445 ! (denoted "_OM") will be used. 1446 ! o If SCRIP is activated by user, and all grids are 1447 ! regular and specified in terms of meters (cartesian), 1448 ! then WMGHGH will calculate weights using both methods, 1449 ! and then compare the two, producing an error message 1450 ! if they do not match (built-in regression testing) 1451 ! For more info, see Section 0a below. 1452 ! 1453 ! 8. Structure : 1454 ! 1455 ! See source code. 1456 ! 1457 ! 9. Switches : 1458 ! 1459 ! !/SHRD Distributed memory approach 1460 ! !/DIST 1461 ! 1462 ! !/PRn propagation scheme. 1463 ! 1464 ! !/S Enable subroutine tracing. 1465 ! !/T Enable test output. 1466 ! !/T3 Test output for received spectra. 1467 ! !/T4 Test output for sent spectra. 1468 ! 1469 ! 10. Source code : 1470 ! 1471 !/ ------------------------------------------------------------------- / 1472 ! 1473 USE CONSTANTS 1474 USE W3SERVMD, ONLY: EXTCDE 1475 USE W3GSRUMD, ONLY: W3DIST Page 26 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 1476 ! 1477 USE W3GDATMD 1478 USE W3ODATMD 1479 USE WMMDATMD 1480 !/ 1481 IMPLICIT NONE 1482 ! 1483 INCLUDE "mpif.h" 1484 ! 1485 !/ 1486 !/ ------------------------------------------------------------------- / 1487 !/ Parameter list 1488 !/ 1489 !/ ------------------------------------------------------------------- / 1490 !/ Local parameters 1491 !/ 1492 1493 ! notes re: variable names: During the extension for irregular grids, 1494 ! some variable were renamed to make the code more readable: 1495 ! JX==> ISRC 1496 ! JY==> JSRC 1497 ! IX==> IDST 1498 ! IY==> JDST 1499 ! grid I ==> grid GDST 1500 ! grid J ==> grid GSRC 1501 2040 INTEGER :: GDST, IJ, IDST, JDST, GSRC, JJ, IB, ISEA, & 2041 JSEA, IDSTLA, IDSTHA, JDSTLA, JDSTHA, & 2042 ISRC, JSRC, ISRCL, ISRCH, JSRCL, JSRCH, NIT, & 2043 NRTOT, NROK, JF, JR, NLMAX, ISPROC, ISPRO2, & 2044 IREC, ISND, ITMP,ILOC 2045 2046 INTEGER :: LTAG0 2047 INTEGER :: IERR_MPI 2048 2049 INTEGER, ALLOCATABLE :: IDSTL(:), IDSTH(:), JDSTL(:), JDSTH(:), & 2050 MAPTST(:,:), & 2051 I1(:,:), I2(:,:), I3(:), I4(:), & 2052 INFLND(:,:) 2053 INTEGER, ALLOCATABLE :: NX_BEG(:), NX_END(:) 2054 INTEGER :: IM, NX_REM, TAG, NRQ 2055 2056 INTEGER, ALLOCATABLE :: TMPINT_OM(:,:),TMPINT(:,:) 2057 REAL, ALLOCATABLE :: TMPRL_OM(:,:) ,TMPRL(:,:) 2058 REAL, ALLOCATABLE :: BDIST_OM(:) ,BDIST(:) 2059 INTEGER :: NR0 , NR1 , NR2 , NRL , NLOC 2060 INTEGER :: NR0_OM, NR1_OM, NR2_OM, NRL_OM, NLOC_OM 2061 2062 INTEGER, ALLOCATABLE :: LTAG(:) 2063 2064 REAL :: FACTOR, STX, STY, STXY, NEWVAL, & 2065 XL, XH, YL, YH, XA, YA, DXC, JD, & 2066 WX, WY, WTOT 2067 2068 LOGICAL :: FLGREC 2069 2070 LOGICAL, ALLOCATABLE :: GRIDOK(:), & Page 27 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2071 STMASK(:,:), MASKI(:,:), TMPLOG(:) 2072 2073 INTEGER :: JBND,IBND ! counter for boundary points 2074 REAL :: DD ! distance to boundary point 2075 ! (temporary variable) 2076 REAL :: XDST,YDST 2077 REAL :: XSRC,YSRC 2078 REAL :: WXWY 2079 INTEGER :: NJDST,NIDST,KDST 2080 INTEGER :: NJSRC,NISRC,KSRC 2081 INTEGER :: IPNT,ISTAT,ICOUNT,IPNT2 2082 INTEGER :: DST_GRID_SIZE,ISTOP,JTMP 2083 2084 REAL :: DX_MAX_GDST,DY_MAX_GDST 2085 REAL :: DX_MIN_GSRC,DY_MIN_GSRC 2086 2087 2088 LOGICAL :: LSCRIP=.FALSE. ! true if SCRIP switch is set, 2089 ! indicates that SCRIP code has 2090 ! been compiled into WW3 2091 LOGICAL :: LSCRIPNC=.FALSE. ! true if SCRIPNC switch is set, 2092 ! indicates that SCRIP code has 2093 ! been compiled with netCDF 2094 ! into WW3 2095 LOGICAL :: T38=.FALSE. ! true if T38 switch is set. 2096 ! This logical is necessary 2097 ! since it isn't possible to 2098 ! have two switches disabling 2099 ! the same line of code. 2100 LOGICAL :: ALL_REGULAR=.TRUE. ! true if all grids are 2101 ! regular grids 2102 LOGICAL :: DO_CHECKING=.FALSE. ! true if we will be 2103 ! checking "old method" of 2104 ! computing weights vs. 2105 ! SCRIP method of computing 2106 ! weights. 2107 LOGICAL :: OLD_METHOD=.FALSE. ! true if we will compute 2108 ! using "old method" (does 2109 ! not necessarily mean 2110 ! that this solution is 2111 ! utilized) 2112 LOGICAL :: LMPIBDI=.FALSE. ! true if MPIBDI switch is set 2113 2114 INTEGER :: ITRI, IM1, IM2, IT, JT, IsFirst 2115 REAL :: DIST_MIN, DIST_MAX, eDist 2116 2117 !/ 2118 2119 ! 2120 CALL MPI_BARRIER(MPI_COMM_WORLD, IERR_MPI) 2121 2122 2123 ! -------------------------------------------------------------------- / 2124 ! 0. Initializations / tests 2125 ! 2126 IF ( .NOT. ALLOCATED(GRDHGH) ) THEN 2127 IF ( IMPROC.EQ.NMPERR ) WRITE(MDSE,1000) Page 28 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2128 CALL EXTCDE (1000) 2129 END IF 2130 ! 2131 !KRL Allocate helper arrays to enable bottleneck loop parallelization 2132 ALLOCATE ( NX_BEG(NMPROC), NX_END(NMPROC) ) 2133 ! 2134 !!HT: 2135 !!HT: Set up and initialize storage data structures .... 2136 !!HT: 2137 DO GDST=1, NRGRD 2138 DO GSRC=1, NRGRD 2139 IF ( HGSTGE(GDST,GSRC)%INIT ) THEN 2140 IF ( HGSTGE(GDST,GSRC)%NREC .NE. 0 ) DEALLOCATE & 2141 ( HGSTGE(GDST,GSRC)%LJSEA , HGSTGE(GDST,GSRC)%NRAVG, & 2142 HGSTGE(GDST,GSRC)%IMPSRC, HGSTGE(GDST,GSRC)%ITAG , & 2143 HGSTGE(GDST,GSRC)%WGTH , HGSTGE(GDST,GSRC)%SHGH ) 2144 IF ( HGSTGE(GDST,GSRC)%NSND .NE. 0 ) DEALLOCATE & 2145 ( HGSTGE(GDST,GSRC)%ISEND ) 2146 HGSTGE(GDST,GSRC)%NTOT = 0 2147 HGSTGE(GDST,GSRC)%NREC = 0 2148 HGSTGE(GDST,GSRC)%NRC1 = 0 2149 HGSTGE(GDST,GSRC)%NSND = 0 2150 HGSTGE(GDST,GSRC)%NSN1 = 0 2151 HGSTGE(GDST,GSRC)%NSMX = 0 2152 HGSTGE(GDST,GSRC)%INIT = .FALSE. 2153 END IF 2154 END DO 2155 END DO 2156 GDST=-999 ! unset grid 2157 GSRC=-999 ! unset grid 2158 2159 2160 ! -------------------------------------------------------------------- / 2161 ! 0.a Plan future behavior by setting logical variables. 2162 2163 2164 DO GDST=1, NRGRD 2165 IF ( GRIDS(GDST)%GTYPE .NE. RLGTYPE ) THEN 2166 ALL_REGULAR=.FALSE. 2167 END IF 2168 END DO 2169 2170 ! Notes re: FLAGLL case: Old method calculates overlap area based on deg lat 2171 ! and deg lon. New method (SCRIP) calculates overlap area based on real 2172 ! distances. Therefore weights will not match for FLAGLL case, so we 2173 ! do not perform checking for FLAGLL case. 2174 2175 IF ( (.NOT.FLAGLL) .AND. ALL_REGULAR .AND. LSCRIP ) THEN 2176 IF ( IMPROC.EQ.NMPERR ) & 2177 WRITE (MDSE,'(/2A)')'We will check SCRIP calculations ', & 2178 'against old method of calculating weights.' 2179 DO_CHECKING=.TRUE. 2180 END IF 2181 2182 IF (DO_CHECKING .OR. (.NOT.LSCRIP)) OLD_METHOD=.TRUE. 2183 2184 ! -------------------------------------------------------------------- / Page 29 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2185 ! 0.b Check solution method 2186 2187 IF ( (.NOT.LSCRIP) .AND. (.NOT.ALL_REGULAR) ) THEN 2188 IF ( IMPROC.EQ.NMPERR ) & 2189 WRITE (MDSE,'(/3A)') ' *** ERROR WMGHGH: ', & 2190 'IRREGULAR or UNSTRUCTURED grid detected: this requires ', & 2191 'SCRIP switch.' 2192 CALL EXTCDE ( 999 ) 2193 END IF 2194 2195 ! 2196 ! -------------------------------------------------------------------- / 2197 ! 1. Set boundary distance maps 2198 ! 1.a Check if needed 2199 ! 2200 !!HT: FLGBDI is a flag set in WMMDATMD to .FALSE. and is used to identify 2201 !!HT: if the boundary distance maps have been initialized 2202 !!HT: 2203 !!HT: For each individual grid a map is generated identifying the distance 2204 !!HT: to open boundaries (MAPBDI, saved in structure MDATA in WMMDATMD). 2205 !!HT: This map is used later to choose if more that 1 high-res grids 2206 !!HT: could provide data to a low-res grid. The high-res grid with data 2207 !!HT: furthest away from its own open boundary will be used. 2208 2209 IF ( .NOT. FLGBDI ) THEN 2210 ! 2211 IF ( FLAGLL ) THEN 2212 FACTOR = RADIUS * DERA 2213 !notes: was FACTOR = RADIUS / 360. (bug fix) 2214 ELSE 2215 FACTOR = 1. 2216 END IF 2217 ! 2218 ! 1.b Loop over grids 2219 ! 2220 DO GDST=1, NRGRD 2221 2222 2223 CALL W3SETO ( GDST, MDSE, MDST ) 2224 CALL W3SETG ( GDST, MDSE, MDST ) 2225 CALL WMSETM ( GDST, MDSE, MDST ) 2226 2227 ! IF ( GTYPE .EQ. UNGTYPE ) THEN 2228 ! IF ( IMPROC.EQ.NMPERR ) & 2229 ! WRITE (MDSE,'(/2A)') ' *** ERROR WMGHGH: ', & 2230 ! 'UNSTRUCTURED GRID SUPPORT NOT YET IMPLEMENTED ***' 2231 ! CALL EXTCDE ( 999 ) 2232 ! END IF 2233 2234 ! 2235 ! 1.c Not needed (test output only) 2236 ! 2237 IF ( GRANK(GDST) .EQ. 1 ) THEN 2238 ! 2239 ! 1.d Inconsistent RANK vs NBI (error message) 2240 ! 2241 ELSE IF ( NBI .EQ. 0 ) THEN Page 30 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2242 IF ( IMPROC.EQ.NMPERR ) WRITE (MDSE,1010) 2243 CALL EXTCDE (1010) 2244 ! 2245 ! 1.e Generate map with distances to boundary. 2246 2247 !!HT: Initialize MAPBDI 2248 !!HT: 0. for active boundary points 2249 !!HT: -1. for points that are not considered at all (rescaled for test 2250 !!HT: output only, only negative value is essentially later). 2251 !!HT: -2. for points that still need to be processed. 2252 2253 ELSE 2254 IF(IMPROC.EQ.NMPERR)WRITE(MDSE,'(A)') & 2255 ' Generating map with distances to boundary.' 2256 ! for purposes of screen output, would be useful to wait for other processors to catch up here...(if mpibdi switch used) 2257 ALLOCATE ( MDATAS(GDST)%MAPBDI(NY,NX) ) 2258 MAPBDI => MDATAS(GDST)%MAPBDI 2259 ! 2260 !KRL Set up ranges for X. If not MPIBDI, just 1 to NX 2261 NX_BEG(IMPROC) = 1 2262 NX_END(IMPROC) = NX 2263 !KRL Setup complete 2264 ! 2265 ! Loop to determine MAPBDI 2266 DO IDST=NX_BEG(IMPROC), NX_END(IMPROC) 2267 IF(MOD(IDST,25).EQ.0)THEN 2268 IF(LMPIBDI)THEN 2269 WRITE(MDSE,'(4x,3(A,I5))')& 2270 'processing column ',IDST,' out of ',NX, & 2271 ' on processor ',IMPROC 2272 ELSEIF(IMPROC.EQ.NMPERR)THEN 2273 WRITE(MDSE,'(4x,2(A,I5))')& 2274 'processing column ',IDST,' out of ',NX 2275 ENDIF 2276 ENDIF 2277 DO JDST=1, NY 2278 IF ( MAPSTA(JDST,IDST) .EQ. 0 ) THEN ! (excluded point) 2279 MAPBDI(JDST,IDST) = -1. / SIG(1) * DTMAX ! new (bug fix) 2280 ELSE IF ( ABS(MAPSTA(JDST,IDST)) .EQ. 2 ) THEN 2281 ! (boundary point) 2282 MAPBDI(JDST,IDST) = 0. 2283 ELSE ! ABS(MAPSTA)=1 (sea point) 2284 MAPBDI(JDST,IDST) = 1.0E+10 2285 ENDIF ! (if sea point) 2286 END DO ! DO IDST... 2287 END DO ! DO JDST... 2288 2289 DO IBND=1,NX 2290 DO JBND=1,NY 2291 IF ( ABS(MAPSTA(JBND,IBND)) .EQ. 2 ) THEN 2292 ! (boundary point) 2293 DO IDST=NX_BEG(IMPROC), NX_END(IMPROC) 2294 DO JDST=1, NY 2295 IF (ABS(MAPSTA(JDST,IDST)) .EQ. 1) THEN 2296 !....find distance to this boundary point. 2297 DD=FACTOR*W3DIST(FLAGLL,XGRD(JDST,IDST), & 2298 YGRD(JDST,IDST),XGRD(JBND,IBND), & Page 31 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2299 YGRD(JBND,IBND)) 2300 2301 ! Notes: The origin of "0.58 * GRAV" is to translate from distance (in meters) 2302 ! to time (in seconds) required for a wave to travel from the boundary to point 2303 ! JDST,IDST based on a specific group velocity 0.58*grav would be the group 2304 ! velocity of a 7.3 s wave in deep water. Significance of T=7.3 s is explained 2305 ! in notes by HT below. 2306 2307 DD=DD/ ( 0.58 * GRAV ) 2308 MAPBDI(JDST,IDST)=MIN(MAPBDI(JDST,IDST),DD) 2309 ENDIF 2310 END DO ! DO IBND=1,NX 2311 END DO ! DO JBND=1,NY 2312 ENDIF ! (if sea point) 2313 2314 END DO ! DO IDST... 2315 END DO ! DO JDST... 2316 IF(IMPROC.EQ.NMPERR)WRITE(MDSE,'(A/)') & 2317 ' Finished generating map with distances to boundary.' 2318 2319 !...notes regarding old method of doing what we just did 2320 !!HT: 2321 !!HT: (1) 2322 !!HT: 2323 !!HT: CHANGE array is used to identify grid points that still need to 2324 !!HT: be processed, and that are adjacent to points that have been 2325 !!HT: processed. Only those points can be updated in this step of the 2326 !!HT: loop started above here. The two loops below set the CHANGE array. 2327 !!HT: 2328 !!HT: (2) 2329 !!HT: 2330 !!HT: CHANGD identify if more points have been updated 2331 !!HT: 2332 !!HT: STX and STY are partial normalized distances, defined as the 2333 !!HT: physical distance Delta Y ( FACTOR * SY ) and Delta X 2334 !!HT: ( FACTOR * SX * XLAT(JDST) ), devided by the sistance traveled, 2335 !!HT: which is CgMAX * DTMAX. CgMAX is approximately 1.15 * CgDEEP, 2336 !!HT: or 1.15 * 0.5 * C_DEEP = 0.58 * GRAV / SIG(1). Since SIG(1) and 2337 !!HT: DTMAX may vary, these two factors are not included in MAPBDI. 2338 !!HT: 2339 !!HT: This defines MAPBDI similar to an inverse CFL number. 2340 !!HT: 2341 !!HT: (3) 2342 !!HT: 2343 !!HT: ERROR : Should be CLAT(JDST), not CLATI(JDST) : "STX = FACTOR * SX * CLATI(JDST) / ( 0.58 * GRAV )" 2344 2345 ! 1.f Test output 2346 ! 2347 !!HT: Note that SIG(1) and DTMAX are included here so that the map defines 2348 !!HT: how many time steps DTMAX it takes to reach this place. 2349 2350 ! 2351 END IF 2352 END DO 2353 FLGBDI = .TRUE. 2354 END IF 2355 ! Page 32 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2356 ! -------------------------------------------------------------------- / 2357 ! 2. Data sources for reconcilliation 2358 ! 2.a Loop over grids, processing check 2359 ! 2360 2361 !!HT: GRDHGH(GDST,0) was set in WMGLOW to identify how many grids may 2362 !!HT: contribute from higher ranks to the present grid (GDST). 2363 2364 ALLOCATE ( I1(NRGRD,NMPROC), I2(NRGRD,NMPROC), & 2365 I3(NRGRD), I4(NRGRD) ) 2366 2367 LTAG0 = 0 2368 2369 IF (LSCRIPNC) CALL MPI_BARRIER(MPI_COMM_WORLD, IERR_MPI) 2370 2371 LOWRANK_GRID : DO GDST=1, NRGRD 2372 2373 2374 ! Test output 2375 2376 ! 2377 IF ( GRDHGH(GDST,0) .EQ. 0 ) THEN ! no grids of higher rank than this 2378 ! one. 2379 ELSE ! processing required 2380 ! 2381 ! 2.b Process grid 2382 ! 2.b.1 Preparations 2383 ! 2384 !!HT: Grid I has higher rank grids covering it, we now set up MAPTST 2385 !!HT: MAPTST shows from which gid the data is averages. 2386 !!HT: INFLND inferred land points based on land in high-res grids. 2387 !!HT: 2388 CALL W3SETO ( GDST, MDSE, MDST ) 2389 CALL W3SETG ( GDST, MDSE, MDST ) 2390 CALL WMSETM ( GDST, MDSE, MDST ) 2391 2392 ALLOCATE ( MAPTST(NY,NX), INFLND(NY,NX) ) 2393 MAPTST = 0 2394 INFLND = 0 2395 2396 !################################################################ 2397 ! Start new block of code: Calculate weights by calling SCRIP interface 2398 !################################################################ 2399 2400 ! Notes on grid variables: 2401 ! GRIDS(GSRC)%{grid variable} (src grid, high rank, high resolution grid) 2402 ! GRIDS(GDST)%{grid variable} (dst grid, low rank, low resolution grid) 2403 2404 ! At this point, we are working on a particular low rank (dst) grid. 2405 ! We will save our weight information in the structure "ALLWGTS". 2406 ! For this dst grid, it is possible to have many src grids. That is 2407 ! why we store it this way. 2408 ! First, we ALLOCATE ALLWGTS from 1 up to the largest value of all 2409 ! the possible source grids. This will be referenced as "GSRC" 2410 ! Not every value of GSRC will be filled (e.g. "1" usually isn't filled) 2411 ! but since we are doing this as a derived data type, we are still 2412 ! efficient in terms of memory usage. Page 33 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2413 ! Inside SCRIP interface, we have: 2414 ! type weight_data 2415 ! integer (kind=int_kind) :: n ! number of weights for 2416 ! dst cell, formerly npnts(:) 2417 ! real (kind=dbl_kind), allocatable :: w(:) ! weights, sized by n, 2418 ! formerly wxwy(:,:) 2419 ! integer (kind=int_kind), allocatable :: k(:) ! source grid cells, 2420 ! sized by n, formerly KSRC(:,:) 2421 ! end type weight_data 2422 ! .... 2423 ! type(weight_data), allocatable :: WGTDATA(:) 2424 ! .... 2425 ! ALLOCATE(WGTDATA(grid2_size)) ! grid2=destination grid 2426 2427 2428 ! Next, we loop through the src grids for the dst grid that we are working on. 2429 2430 2431 ! Next, we call SCRIP for this src grid 2432 2433 2434 ! SCRIP has now created the data strucure "WGTDATA" and stored the weights 2435 ! in it. However, this is only for the present src grid. We want to store the 2436 ! data for all the src grids. Thus, we use a new data structure of type 2437 ! "ALLWGT" to store this data. First though, we need to ALLOCATE it: 2438 ! (note: "k" is equivalent to isea, but includes *all* points) 2439 2440 2441 ! Now that we have it allocated, we can just copy WGTDATA into ALLWGTS 2442 2443 ! Notes re: short and long way to do this: 2444 ! pgf90 on IBM Opteron, gfortran, g95, xlf, all tested ok with "short method" 2445 ! pgf90 on our linux workstations (Intel) requires the "long method" 2446 ! (possible compiler bug) 2447 ! ALLWGTS(GSRC)%WGTDATA = WGTDATA !short method 2448 2449 ! BEGIN long method for filling derived data type "ALLWGTS" 2450 2451 2452 ! END long method for filling derived data type "ALLWGTS" 2453 2454 ! We're done with WGTDATA, so we can DEALLOCATE it. This is important, 2455 ! since it will be allocated again the next time SCRIP is called. 2456 2457 2458 ! Here's a "test output" block of code to demonstrate how the weights can 2459 ! be called up from ALLWGTS...and to verify that the data is stored properly. 2460 ! (again note that "k" is equivalent to isea, but includes *all* points) 2461 2462 2463 2464 !################################################################ 2465 ! End new block of code: Calculate weights by calling SCRIP interface 2466 !################################################################ 2467 2468 ! 2.b.2 Find points used for boundary data in higher ranked grids 2469 ! Page 34 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2470 !!HT: These points are marked in MAPTST as negative values to assure 2471 !!HT: that the grid poits used for boundary data are not getting 2472 !!HT: averaged values from high-reswolution grids as that will result 2473 !!HT: in cyclic, possibly non-conservative updating. 2474 !!HT: 2475 !!HT: NBI2S has all necessary data set in WMGLOW as called before WMGHGH. 2476 !!HT: 2477 !!HT: JJ loop goes over grids that reviously have been identified as 2478 !!HT: getting data from the grid presently cousidered. 2479 ! 2480 ! notes: The purpose of this loop is unclear. Perhaps it is to identify points 2481 ! that should not be used in the averaging procedure. It could be 2482 ! related to statement in Tolman (OM, 2008): "Second, Eq (7) is not 2483 ! applied to grid points in the low resolution grid that contribute 2484 ! to boundary data for the high resolution grid. This avoids cyclic 2485 ! updating of data between grids. 2486 2487 ! notes: GRDHGH(GDST,0) is number of grids of higher rank than the present 2488 ! grid (GDST) 2489 ! GRDHGH(GDST,1...etc.) is the grid number 2490 2491 DO JJ=1, GRDHGH(GDST,0) 2492 GSRC = GRDHGH(GDST,JJ) 2493 DO IB=1, SIZE(MDATAS(GSRC)%NBI2S(:,1)) 2494 IF ( MDATAS(GSRC)%NBI2S(IB,1) .EQ. GDST ) THEN 2495 IDST = MAPSF(MDATAS(GSRC)%NBI2S(IB,2),1) 2496 JDST = MAPSF(MDATAS(GSRC)%NBI2S(IB,2),2) 2497 MAPTST(JDST,IDST) = - GSRC 2498 END IF 2499 END DO 2500 END DO 2501 GSRC = -999 ! unset grid 2502 ! 2503 ! 2.b.3 Range of coverage per grid 2504 2505 !!HT: 2506 !!HT: In this JJ loop, we go over all higher resolution grids to find 2507 !!HT: ranges that can be averaged to replace data in the 'I' (GDST) grid.! 2508 !!HT: 2509 2510 ALLOCATE ( IDSTL(GRDHGH(GDST,0)), IDSTH(GRDHGH(GDST,0)), & 2511 JDSTL(GRDHGH(GDST,0)), JDSTH(GRDHGH(GDST,0)), & 2512 GRIDOK(GRDHGH(GDST,0)),BDIST(GRDHGH(GDST,0)) ) 2513 2514 IF(OLD_METHOD)ALLOCATE (BDIST_OM(GRDHGH(GDST,0))) 2515 2516 ! 2517 ! Notes: For case of lower ranked grid GDST being irregular, grid indices 2518 ! i and j do not correspond to x and y, so optimization 2519 ! by limiting search in manner of pre-curvilinear versions of 2520 ! WW3 is not appropriate. 2521 ! 2522 IF ( (GTYPE .EQ. CLGTYPE).or.(GTYPE .EQ. UNGTYPE) ) THEN 2523 2524 IDSTLA = 1 2525 IDSTHA = NX 2526 JDSTLA = 1 Page 35 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2527 JDSTHA = NY 2528 2529 ELSE 2530 2531 ! loop through higher ranked grids GSRC 2532 2533 DO JJ=1, GRDHGH(GDST,0) 2534 GSRC = GRDHGH(GDST,JJ) 2535 !!HT: 2536 !!HT: XL,XH, and YL,YH and the low and high (X,Y) values of the grid box 2537 !!HT: in the grid 'I' fro which the high-res data needs to be averaged. 2538 !!HT: To be efficient, we compute a range of high-res grid point that 2539 !!HT: could be considered, rather than looking through the whole grid. 2540 !!HT: This will work only for the old grids, not for the newer curvilinear 2541 !!HT: and unstructured grids. 2542 !!HT: 2543 !!HT: This sets the range in the low-res grid to consider. 2544 ! 2545 ! Notes (HLT): outer edges already taken off here ... 2546 ! will not work in a simple way for spherical grids, 2547 ! so we don't even try .... 2548 ! 2549 ! Notes: SX and SY are only used in cases where GTYPE .NE. CLGTYPE, 2550 ! i.e. regular grids. In case of regular grids, SX and SY 2551 ! can be replaced with HPFAC HQFAC, if desired. 2552 ! 2553 ! find upper and lower bounds of higher ranks grids 2554 2555 IF ( (GRIDS(GSRC)%GTYPE .EQ. CLGTYPE) .OR. & 2556 (GRIDS(GSRC)%GTYPE .EQ. UNGTYPE) ) THEN 2557 2558 ! Notes: in case of irregular grids, there is no obvious way to 2559 ! offset by dx/2 dy/2, so we omit that sliver (thus we increase 2560 ! search area slightly). 2561 2562 XL=MINVAL(GRIDS(GSRC)%XGRD) 2563 YL=MINVAL(GRIDS(GSRC)%YGRD) 2564 XH=MAXVAL(GRIDS(GSRC)%XGRD) 2565 YH=MAXVAL(GRIDS(GSRC)%YGRD) 2566 2567 ELSE 2568 2569 XL = GRIDS(GSRC)%X0 + 0.5 * GRIDS(GSRC)%SX 2570 XH = GRIDS(GSRC)%X0 + ( REAL(GRIDS(GSRC)%NX) - 1.5 ) & 2571 * GRIDS(GSRC)%SX 2572 YL = GRIDS(GSRC)%Y0 + 0.5 * GRIDS(GSRC)%SY 2573 YH = GRIDS(GSRC)%Y0 + ( REAL(GRIDS(GSRC)%NY) - 1.5 ) & 2574 * GRIDS(GSRC)%SY 2575 2576 ENDIF ! IF ( GRIDS(GSRC)%GTYPE .EQ. CLGTYPE ) 2577 2578 ! 2579 ! find where this falls in the current (low) ranked grid 2580 2581 IF ( FLAGLL ) THEN 2582 IDSTL(JJ) = 1 2583 IDSTH(JJ) = NX Page 36 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2584 ELSE 2585 2586 ! Notes: from check "IF ( GTYPE .EQ. CLGTYPE ) THEN" above, we know that 2587 ! GTYPE .NE CLGTYPE....so it is safe to use SX SY etc here 2588 2589 IDSTL(JJ) = 2 + INT( (XL-X0)/SX + 0.49 ) 2590 IDSTH(JJ) = 1 + INT( (XH-X0)/SX - 0.49 ) 2591 END IF 2592 2593 JDSTL(JJ) = 2 + INT( (YL-Y0)/SY + 0.49 ) 2594 JDSTH(JJ) = 1 + INT( (YH-Y0)/SY - 0.49 ) 2595 2596 IDSTL(JJ) = MAX ( 1 , IDSTL(JJ) ) 2597 IDSTH(JJ) = MIN ( NX , IDSTH(JJ) ) 2598 JDSTL(JJ) = MAX ( 1 , JDSTL(JJ) ) 2599 JDSTH(JJ) = MIN ( NY , JDSTH(JJ) ) 2600 ! 2601 END DO ! end loop through higher ranked grids 2602 GSRC = -999 ! unset grid 2603 ! 2604 2605 ! save the extremities of that set of high-ranked grids 2606 IDSTLA = MINVAL(IDSTL) 2607 IDSTHA = MAXVAL(IDSTH) 2608 JDSTLA = MINVAL(JDSTL) 2609 JDSTHA = MAXVAL(JDSTH) 2610 2611 ENDIF ! IF ( (GTYPE .EQ. CLGTYPE ) .or. (GTYPE .EQ. UNGTYPE)) 2612 2613 ! loop through higher ranked grids 2614 2615 ! 2616 ! 2.b.4 Point by point check 2617 ! 2618 ! Notes: We loop through all grids of higher rank 2619 ! GSRC=the grid number of the higher rank grid. 2620 ! NLMAX is used for dimensioning purposes. 2621 ! It is apparently using the ratio between the resolution 2622 ! of the low rank grid (GDST) and high rank grid (GSRC) 2623 ! Obviously, we cannot use this calculation for irregular grids. 2624 2625 NLMAX = 0 2626 DO JJ=1, GRDHGH(GDST,0) 2627 GSRC = GRDHGH(GDST,JJ) 2628 2629 ! Notes: NLMAX is used to dimension TMPINT,TMPRL, and to set ITAG and LTAG 2630 ! (MPI case). 2631 ! As we remove more of the older code, it may turn out that 2632 ! NLMAX is no longer needed, in which case we can remove this 2633 ! block of code. For example, the weights data structure is introduced 2634 ! to WW3 already dimensioned. 2635 2636 IF ( GRIDS(GDST)%GTYPE .EQ. CLGTYPE ) THEN 2637 DX_MAX_GDST=MAXVAL(GRIDS(GDST)%HPFAC) 2638 DY_MAX_GDST=MAXVAL(GRIDS(GDST)%HQFAC) 2639 ELSEIF ( GRIDS(GDST)%GTYPE .EQ. RLGTYPE ) THEN 2640 DX_MAX_GDST=GRIDS(GDST)%SX Page 37 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2641 DY_MAX_GDST=GRIDS(GDST)%SY 2642 ELSE 2643 IsFirst=1 2644 DIST_MAX=0 2645 DIST_MIN=0 2646 DO ITRI=1,GRIDS(GDST)%NTRI 2647 DO IT=1,3 2648 IF (IT.eq.3) THEN 2649 JT=1 2650 ELSE 2651 JT=IT+1 2652 END IF 2653 IM1=GRIDS(GDST)%TRIGP(ITRI,IT) 2654 IM2=GRIDS(GDST)%TRIGP(ITRI,JT) 2655 eDist=W3DIST(FLAGLL, GRIDS(GDST)%XYB(IM1,1), & 2656 GRIDS(GDST)%XYB(IM1,2), & 2657 GRIDS(GDST)%XYB(IM2,1), GRIDS(GDST)%XYB(IM2,2)) 2658 IF (IsFirst.eq.1) THEN 2659 DIST_MAX=eDist 2660 DIST_MIN=eDist 2661 IsFirst=0 2662 ELSE 2663 IF (eDist.gt.DIST_MAX) THEN 2664 DIST_MAX=eDist 2665 END IF 2666 IF (eDist.lt.DIST_MIN) THEN 2667 DIST_MIN=eDist 2668 END IF 2669 END IF 2670 END DO 2671 END DO 2672 DX_MAX_GDST=DIST_MAX 2673 DY_MAX_GDST=DIST_MAX 2674 END IF 2675 2676 IF ( GRIDS(GSRC)%GTYPE .EQ. CLGTYPE ) THEN 2677 DX_MIN_GSRC=MINVAL(GRIDS(GSRC)%HPFAC) 2678 DY_MIN_GSRC=MINVAL(GRIDS(GSRC)%HQFAC) 2679 ELSEIF ( GRIDS(GSRC)%GTYPE .EQ. RLGTYPE ) THEN 2680 DX_MIN_GSRC=GRIDS(GSRC)%SX 2681 DY_MIN_GSRC=GRIDS(GSRC)%SY 2682 ELSE 2683 IsFirst=1 2684 DIST_MAX=0 2685 DIST_MIN=0 2686 DO ITRI=1,GRIDS(GSRC)%NTRI 2687 DO IT=1,3 2688 IF (IT.eq.3) THEN 2689 JT=1 2690 ELSE 2691 JT=IT+1 2692 END IF 2693 IM1=GRIDS(GSRC)%TRIGP(ITRI,IT) 2694 IM2=GRIDS(GSRC)%TRIGP(ITRI,JT) 2695 eDist=W3DIST(FLAGLL, GRIDS(GSRC)%XYB(IM1,1), & 2696 GRIDS(GSRC)%XYB(IM1,2), & 2697 GRIDS(GSRC)%XYB(IM2,1), GRIDS(GSRC)%XYB(IM2,2)) Page 38 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2698 IF (IsFirst.eq.1) THEN 2699 DIST_MAX=eDist 2700 DIST_MIN=eDist 2701 IsFirst=0 2702 ELSE 2703 IF (eDist.gt.DIST_MAX) THEN 2704 DIST_MAX=eDist 2705 END IF 2706 IF (eDist.lt.DIST_MIN) THEN 2707 DIST_MIN=eDist 2708 END IF 2709 END IF 2710 END DO 2711 END DO 2712 DX_MIN_GSRC=DIST_MIN 2713 DY_MIN_GSRC=DIST_MIN 2714 END IF 2715 2716 ! notes: original code was much simpler: 2717 ! NLMAX = MAX ( NLMAX , (2+INT(SX/GRIDS(J)%SX+0.001)) * & 2718 ! (2+INT(SY/GRIDS(J)%SY+0.001)) ) 2719 2720 NLMAX = MAX ( NLMAX , & 2721 (2+INT(DX_MAX_GDST/DX_MIN_GSRC+0.001)) * & 2722 (2+INT(DY_MAX_GDST/DY_MIN_GSRC+0.001)) ) 2723 2724 2725 2726 END DO ! DO JJ=1, GRDHGH(GDST,0) 2727 GSRC=-999 ! unset grid 2728 2729 ! Notes regarding 3 possible scenarios: 2730 ! If only using SCRIP, then 2731 ! * set NLMAX=NLMAX_SCRIP here. 2732 ! * TMPRL_OM will not be created 2733 ! * TMPRL will be calculated using SCRIP 2734 ! If only using old method 2735 ! * NLMAX is already set, and SCRIP switch does not exist, so 2736 ! nothing is done here 2737 ! * both TMPRL and TMPRL_OM will be dimensioned 2738 ! * TMPRL_OM will be calculated 2739 ! * TMPRL_OM will be copied to TMPRL for use 2740 ! If using both methods ("DO_CHECKING") 2741 ! * set NLMAX=MAX(NLMAX, NLMAX_SCRIP) here. 2742 ! * both TMPRL_OM and TMPRL will be created 2743 ! * both will be calculated using the 2 methods, and 2744 ! checked against each other 2745 ! * the SCRIP version of weights (TMPRL) will be the ones used. 2746 2747 2748 IF(NLMAX.GT.100)THEN 2749 WRITE(MDSE,'(/A,I8)') & 2750 'WARNING: unusually large value for NLMAX : ',NLMAX 2751 END IF 2752 2753 NRTOT = 0 2754 IF(OLD_METHOD)THEN Page 39 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2755 ALLOCATE ( TMPINT_OM(NX*NY,-4:NLMAX) ) 2756 ALLOCATE ( TMPRL_OM(NX*NY,0:NLMAX) ) 2757 ENDIF 2758 ALLOCATE ( TMPINT(NX*NY,-4:NLMAX) ) 2759 ALLOCATE ( TMPRL(NX*NY,0:NLMAX) ) 2760 ALLOCATE ( TMPLOG(NX*NY) ) 2761 ! 2762 ALLOCATE ( LTAG(NLMAX) ) 2763 DO JJ=1, NLMAX 2764 LTAG(JJ) = JJ + LTAG0 2765 END DO 2766 ! 2767 !!HT: 2768 !!HT: After the search range is set, we are actually searching in the 2769 !!HT: high-res grid. IDST, JDST are counters in the grid to which the 2770 !!HT: averaged data is to go. XA and YA are center locatons of target 2771 !!HT: grid. Necxt two loops over all relevant point in target grid. 2772 !!HT: 2773 2774 ! Notes: This is the start of the large loop through the individual 2775 ! grid points of the low-rank grid. 2776 ! The checks below for JDST.LT.JDSTLA , IDST.LT.IDSTLA etc are to save 2777 ! time but will only be useful for the case of regular grids. 2778 2779 LOWRANK_J : DO JDST=1, NY 2780 IF ( JDST.LT.JDSTLA .OR. JDST.GT.JDSTHA ) CYCLE 2781 2782 LOWRANK_I : DO IDST=1, NX 2783 IF ( IDST.LT.IDSTLA .OR. IDST.GT.IDSTHA ) CYCLE 2784 ! check that this is a sea point 2785 IF ( ABS(MAPSTA(JDST,IDST)) .NE. 1 ) CYCLE 2786 ! MAPTST: see Section 2.b.2 above 2787 IF ( MAPTST(JDST,IDST) .LT. 0 ) CYCLE 2788 XA = XGRD(JDST,IDST) ! old code: X0 + REAL(IDST-1)*SX 2789 YA = YGRD(JDST,IDST) ! old code: Y0 + REAL(JDST-1)*SY 2790 2791 !!HT: For each point in the target grid, loop over all relevant high-res 2792 !!HT: grid (JJ loop). 2793 2794 NROK = 0 2795 2796 ! notes: GRDHGH(GDST,0) is number of grids of higher rank than the present 2797 ! grid (GDST) 2798 ! GRDHGH(GDST,1...etc.) is the grid number 2799 2800 DO JJ=1, GRDHGH(GDST,0) 2801 GSRC = GRDHGH(GDST,JJ) 2802 2803 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2804 ! Start counting using old method 2805 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2806 2807 ! Note for LLG: Assumption is made that the higher ranked grid 2808 ! cannot be global. 2809 ! 2810 !!HT: Set search range in [candidate] high-res grid. 2811 Page 40 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2812 ! Notes: The quantities XL YL XH YH apear to be a bounding box in 2813 ! index space for later searching within the high rank grid (or 2814 ! otherwise making computations from the high rank grid). They 2815 ! are the distance from the coarse grid point to the origin of 2816 ! the high rank grid, measured in grid cells of the high rank 2817 ! grid. So, they are the i and j values in the high rank 2818 ! bounding the low rank grid cell. 2819 2820 IF (OLD_METHOD)THEN 2821 ! ...then we do the counting using the old method 2822 2823 ! Notes: Resulting "old method" variables are saved with "_OM" suffix. 2824 2825 IF ( FLAGLL ) THEN 2826 DXC = MOD ( 1080.+XA-GRIDS(GSRC)%X0 , 360. ) 2827 XL = 1. + (DXC-0.5*SX)/GRIDS(GSRC)%SX 2828 XH = 1. + (DXC+0.5*SX)/GRIDS(GSRC)%SX 2829 ELSE 2830 XL = 1. + (XA-GRIDS(GSRC)%X0-0.5*SX)/GRIDS(GSRC)%SX 2831 XH = 1. + (XA-GRIDS(GSRC)%X0+0.5*SX)/GRIDS(GSRC)%SX 2832 END IF 2833 YL = 1. + (YA-GRIDS(GSRC)%Y0-0.5*SY)/GRIDS(GSRC)%SY 2834 YH = 1. + (YA-GRIDS(GSRC)%Y0+0.5*SY)/GRIDS(GSRC)%SY 2835 2836 ISRCL = NINT(XL+0.01) 2837 ISRCH = NINT(XH-0.01) 2838 JSRCL = NINT(YL+0.01) 2839 JSRCH = NINT(YH-0.01) 2840 2841 IF ( ISRCL.LT.1 .OR. ISRCH.GT.GRIDS(GSRC)%NX .OR. & 2842 JSRCL.LT.1 .OR. JSRCH.GT.GRIDS(GSRC)%NY ) THEN 2843 ! dst point not in src grid, so go to next src grid 2844 GRIDOK(JJ) = .FALSE. ! does this get used anywhere? 2845 CYCLE ! leave GSRC loop 2846 END IF 2847 2848 !!HT: Loop over search range in high-res grid, ISRC and JSRC loops. 2849 !!HT: NR0_OM counts high-res grid points with MAPSTA=0, etc. 2850 !!HT: NRL_OM separately identifies explitcit land points. 2851 !!HT: BDIST_OM saves the boundary data from the source grid. 2852 !!HT: 2853 2854 ! Notes: We appear to be searching for the smallest boundary distance and 2855 ! doing some counting 2856 ! Purpose of counting is unknown (for dimensioning?) 2857 2858 ! Initialize 2859 NR0_OM = 0 ! counter of MAPSTA=0 (indicates 2860 ! excluded point) 2861 NRL_OM = 0 ! counter of MAPSTA=0 (indicates 2862 ! excluded point) and MAPST2=0 2863 ! (indicates land) 2864 NR1_OM = 0 ! counter of |MAPSTA|=1 2865 ! (indicates sea point) 2866 NR2_OM = 0 ! counter of |MAPSTA|=2 2867 ! (indicates boundary point) 2868 BDIST_OM(JJ) = 9.99E33 Page 41 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2869 2870 DO ISRC=ISRCL, ISRCH 2871 DO JSRC=JSRCL, JSRCH 2872 IF (GRIDS(GSRC)%MAPSTA(JSRC,ISRC).EQ.0) THEN 2873 ! excluded point 2874 NR0_OM = NR0_OM + 1 2875 2876 ! Notes: Q: What does MAPST2=0 indicate? 2877 ! A: MAPST2 is the "second grid status map" 2878 ! For disabled points (MAPSTA=0) , MAPST2 indicates land (0) or 2879 ! excluded (1). For sea and active boundary points, MAPST2 indicates 2880 ! a) ice coverage b) drying out of points c) land in moving grid or 2881 ! inferred land in nesting and d) masked in two-way nesting 2882 2883 IF (GRIDS(GSRC)%MAPST2(JSRC,ISRC).EQ.0) & 2884 NRL_OM = NRL_OM + 1 2885 ELSE IF (ABS(GRIDS(GSRC)%MAPSTA(JSRC,ISRC)) & 2886 .EQ.1) THEN ! sea point 2887 NR1_OM = NR1_OM + 1 2888 2889 ! Notes: check against stored "distance to boundary point" 2890 ! This BDIST_OM array will be used later, when we select 2891 ! the high rank grid to average from. 2892 2893 BDIST_OM(JJ) = MIN ( BDIST_OM(JJ) , & 2894 MDATAS(GSRC)%MAPBDI(JSRC,ISRC) ) 2895 ELSE IF (ABS(GRIDS(GSRC)%MAPSTA(JSRC,ISRC)) & 2896 .EQ.2) THEN ! bnd point 2897 NR2_OM = NR2_OM + 1 2898 END IF 2899 END DO ! DO JSRC=JSRCL, JSRCH 2900 END DO ! DO ISRC=ISRCL, ISRCH 2901 2902 END IF ! (if OLD_METHOD) 2903 2904 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2905 ! Done with counting using old method. 2906 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2907 2908 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2909 ! Start counting using new method 2910 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2911 2912 ! Initialize 2913 2914 2915 ! Notes on variables used here: 2916 ! IDST, JDST given by loop, NIDST set above, the rest we need to set here 2917 2918 2919 ! sea point 2920 2921 ! Pull NR0, etc. from storage... 2922 ! counter of MAPSTA=0 (indicates excluded point) 2923 ! counter of MAPSTA=0 (indicates excluded point) 2924 ! and MAPST2=0 (indicates land) 2925 ! counter of |MAPSTA|=1 (indicates sea point) Page 42 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2926 ! counter of |MAPSTA|=2 (indicates boundary point) 2927 2928 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2929 ! Finished counting using new method. 2930 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2931 2932 ! Compare results 2933 IF(DO_CHECKING)THEN 2934 ! then it is OK to compare with the values that we got using the old method 2935 IF(NR0_OM.NE.NR0)THEN 2936 IF ( IMPROC.EQ.NMPERR )WRITE (MDSE,'(/1A,2(I8))') & 2937 ' *** ERROR WMGHGH: NR0_OM,NR0 = ',NR0_OM,NR0 2938 CALL EXTCDE ( 999 ) 2939 ENDIF 2940 IF(NR1_OM.NE.NR1)THEN 2941 IF ( IMPROC.EQ.NMPERR )WRITE (MDSE,'(/1A,2(I8))') & 2942 ' *** ERROR WMGHGH: NR1_OM,NR1 = ',NR1_OM,NR1 2943 CALL EXTCDE ( 999 ) 2944 ENDIF 2945 IF(NR2_OM.NE.NR2)THEN 2946 IF ( IMPROC.EQ.NMPERR )WRITE (MDSE,'(/1A,2(I8))') & 2947 ' *** ERROR WMGHGH: NR2_OM,NR2 = ',NR2_OM,NR2 2948 CALL EXTCDE ( 999 ) 2949 ENDIF 2950 IF(NRL_OM.NE.NRL)THEN 2951 IF ( IMPROC.EQ.NMPERR )WRITE (MDSE,'(/1A,2(I8))') & 2952 ' *** ERROR WMGHGH: NRL_OM,NRL = ',NRL_OM,NRL 2953 CALL EXTCDE ( 999 ) 2954 ENDIF 2955 IF(BDIST_OM(JJ).NE.BDIST(JJ))THEN 2956 IF ( IMPROC.EQ.NMPERR ) & 2957 WRITE (MDSE,'(/2A,2(F12.5))') & 2958 ' *** ERROR WMGHGH: ', & 2959 ' BDIST_OM(JJ),BDIST(JJ) = ', & 2960 BDIST_OM(JJ),BDIST(JJ) 2961 CALL EXTCDE ( 999 ) 2962 ENDIF 2963 END IF ! (if DO_CHECKING) 2964 2965 ! Notes: We are done with the counting. If we didn't use SCRIP to get NR0, 2966 ! etc., then we need to set them using the _OM variables. 2967 2968 IF(.NOT.LSCRIP)THEN 2969 NR0=NR0_OM 2970 NR1=NR1_OM 2971 NR2=NR2_OM 2972 NRL=NRL_OM 2973 BDIST=BDIST_OM 2974 END IF 2975 2976 ! Notes: Potential future improvement: for irregular grids, it would make 2977 ! more sense to use the overlapped area, rather than simply counting cells 2978 ! to decide on "inferred land". However, since grid cell size it typically 2979 ! fairly uniform locally, the current approach will suffice for now. 2980 2981 ! Notes: This is the only place that the "NRL" "NR0" "NR1" and "NR2" variables 2982 ! are used directly. They affect MAPST2 indirectly below. Page 43 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 2983 ! The calculation itself is essentially "50% or more of the grid 2984 ! cells are land". 2985 2986 IF ( NRL .GT. (NR0+NR1+NR2)/2 ) THEN 2987 2988 ! Notes: This is not considered an OK grid (NROK is not incremented) and 2989 ! it is considered "inferred land" 2990 2991 INFLND(JDST,IDST) = 1 2992 ELSE 2993 GRIDOK(JJ) = NR1.GT.0 .AND. NR2.EQ.0 2994 2995 ! Notes: for a grid cell to be considered "OK", we require that there is 2996 ! at least one sea point being used, and no boundary points being used 2997 2998 IF ( GRIDOK(JJ) ) NROK = NROK + 1 2999 END IF 3000 3001 END DO ! GSRC loop 3002 GSRC=-999 ! unset grid 3003 3004 IF ( NROK .EQ. 0 ) THEN 3005 3006 ! Notes: exit IDST loop since there are no "OK" source grid cells for this 3007 ! dst point. At this point, INFLND could be 1, but isn't necessarily 1 3008 3009 CYCLE 3010 3011 ELSE 3012 3013 ! Notes: If any grids are OK for this dst point, then we override any prior 3014 ! setting of INFLD=1. Apparently this is for the situation of having some src 3015 ! grids giving INFLD=1 and another giving INFLD=0 for the same dst point. 3016 ! I wouldn't expect this to happen very often. 3017 3018 INFLND(JDST,IDST) = 0 3019 3020 END IF 3021 ! 3022 ! 2.b.5 Select source grid 3023 ! 3024 ! Notes: It appears that we are selecting the high rank grid from 3025 ! which we will perform the averaging. 3026 ! The code is written such that the first higher rank 3027 ! grid that we find has the rank that we want, but isn't necessarily the 3028 ! grid that we want. 3029 ! Are grids necessarily in order of rank? If so, then we want the grid 3030 ! that is higher rank but of nearest rank to the present grid. 3031 ! Anyway, once we have decided on the grid rank that we want, we select 3032 ! the specific grid according to criterion: larger distance to 3033 ! boundary = better 3034 ! Keep in mind that this grid is selected for *this* (IDST,JDST) and not 3035 ! necesssarily for the next... 3036 3037 JF = 0 3038 3039 !!HT: Another loop over all high-res grid to decide which grid will Page 44 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 3040 !!HT: be used to average data. If more than 1 grids are available, 3041 !!HT: the boundary distance in the high-res grid, stored in BDIST is 3042 !!HT: used to make the choice. 3043 3044 DO JJ=1, GRDHGH(GDST,0) 3045 3046 GSRC = GRDHGH(GDST,JJ) 3047 3048 IF ( GRIDOK(JJ) ) THEN 3049 IF ( JF .EQ. 0 ) THEN ! we haven't already found a grid 3050 JF = GSRC ! now we have found a grid. 3051 JR = GRANK(GSRC) 3052 ! this is the rank that we want....the rank of the first grid that we find 3053 JD = BDIST(JJ) ! larger distance = better 3054 ELSE 3055 ! we already found a grid, but maybe this one is better 3056 IF ( GRANK(GSRC) .NE. JR ) EXIT 3057 ! this is not the rank that we want 3058 IF ( BDIST(JJ) .GT. JD ) THEN 3059 ! we like this grid better 3060 JF = GSRC 3061 JD = BDIST(JJ) 3062 END IF 3063 END IF 3064 END IF 3065 END DO 3066 GSRC=JF 3067 3068 !!HT: Data for grid point IDST,JDST in the low-res grid will be taken from 3069 !!HT: high-res grid GSRC. 3070 3071 MAPTST(JDST,IDST) = GSRC 3072 ! 3073 ! 2.b.6 Store data (temp) 3074 ! 3075 ! Notes: This section is for calculations of weights for the 3076 ! area-weighted averaging. 3077 3078 NRTOT = NRTOT + 1 3079 TMPINT(NRTOT,-4) = IDST 3080 TMPINT(NRTOT,-3) = JDST 3081 TMPINT(NRTOT,-2) = MAPFS(JDST,IDST) 3082 TMPINT(NRTOT,-1) = GSRC 3083 TMPRL (NRTOT, 0) = JD * SIG(1) / DTMAX 3084 3085 ! Notes: Calculation for XL YL XH YH is same as it was in section 2.b.4, so 3086 ! see notes in that section. 3087 3088 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 3089 !...Begin block of code for computing weights using old method 3090 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 3091 3092 IF (OLD_METHOD)THEN 3093 ! it is OK to do the counting using the old method 3094 ! (These variables are saved with "_OM" suffix) 3095 3096 DO ITMP=-4,-1 Page 45 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 3097 TMPINT_OM(NRTOT,ITMP)=TMPINT(NRTOT,ITMP) 3098 END DO 3099 TMPRL_OM(NRTOT,0)=TMPRL(NRTOT,0) 3100 3101 IF ( FLAGLL ) THEN 3102 DXC = MOD ( 1080.+XA-GRIDS(GSRC)%X0 , 360. ) 3103 XL = 1. + (DXC-0.5*SX)/GRIDS(GSRC)%SX 3104 XH = 1. + (DXC+0.5*SX)/GRIDS(GSRC)%SX 3105 ELSE 3106 XL = 1. + (XA-GRIDS(GSRC)%X0-0.5*SX)/GRIDS(GSRC)%SX 3107 XH = 1. + (XA-GRIDS(GSRC)%X0+0.5*SX)/GRIDS(GSRC)%SX 3108 END IF 3109 YL = 1. + (YA-GRIDS(GSRC)%Y0-0.5*SY)/GRIDS(GSRC)%SY 3110 YH = 1. + (YA-GRIDS(GSRC)%Y0+0.5*SY)/GRIDS(GSRC)%SY 3111 3112 ! Notes: Here, we save the search bounds. These bounds are given in terms of 3113 ! index space of the high rank grid. "L" and "H" here do *not* refer 3114 ! to grid rank! They refer to lower and upper bounds. 3115 3116 ISRCL = NINT(XL+0.01) 3117 ISRCH = NINT(XH-0.01) 3118 JSRCL = NINT(YL+0.01) 3119 JSRCH = NINT(YH-0.01) 3120 3121 WTOT = 0. 3122 NLOC_OM = 0 3123 DO ISRC=ISRCL, ISRCH 3124 WX = MIN(XH,REAL(ISRC)+0.5) - MAX(XL,REAL(ISRC)-0.5) 3125 DO JSRC=JSRCL, JSRCH 3126 IF (ABS(GRIDS(GSRC)%MAPSTA(JSRC,ISRC)).EQ.1) THEN 3127 ! sea point 3128 WY = MIN(YH,REAL(JSRC)+0.5) - & 3129 MAX(YL,REAL(JSRC)-0.5) 3130 WTOT = WTOT + WX*WY 3131 NLOC_OM = NLOC_OM + 1 3132 ! Notes: check here that we are sufficiently dimensioned. 3133 IF ( NLOC_OM .GT. NLMAX ) THEN 3134 IF ( IMPROC.EQ.NMPERR ) WRITE (MDSE,1020) 3135 CALL EXTCDE(1020) 3136 END IF 3137 TMPINT_OM(NRTOT,NLOC_OM) = & 3138 GRIDS(GSRC)%MAPFS(JSRC,ISRC) 3139 TMPRL_OM (NRTOT,NLOC_OM) = WX*WY 3140 END IF 3141 END DO 3142 END DO 3143 TMPINT_OM(NRTOT,0) = NLOC_OM 3144 TMPRL_OM (NRTOT,1:NLOC_OM) = TMPRL_OM(NRTOT,1:NLOC_OM) & 3145 / WTOT 3146 3147 END IF ! (if OLD_METHOD) 3148 3149 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 3150 !...End block of code for computing weights using old method 3151 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 3152 3153 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Page 46 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 3154 !...Begin block of code for "computing" weights using new method 3155 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 3156 3157 ! Notes: Weights have already been computed by SCRIP. 3158 ! We just need to transfer them to TMPINT and TMPRL 3159 3160 3161 ! Test output 3162 3163 ! Notes: check here that we are sufficiently dimensioned. 3164 3165 3166 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 3167 !...End block of code for "computing" weights using new method 3168 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 3169 3170 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 3171 !...Begin block of code that is just for testing 3172 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 3173 3174 IF (DO_CHECKING)THEN 3175 ! compare with the values that we got using the old method 3176 if (NLOC.NE.NLOC_OM) THEN 3177 IF ( IMPROC.EQ.NMPERR )WRITE (MDSE,'(/1A,2(I8))') & 3178 ' *** ERROR WMGHGH: NLOC,NLOC_OM = ',NLOC,NLOC_OM 3179 CALL EXTCDE ( 999 ) 3180 END IF 3181 ISTOP=0 3182 ICOUNT=0 3183 DO IPNT=1,NLOC 3184 DO IPNT2=1,NLOC 3185 IF (TMPINT_OM(NRTOT,IPNT).EQ.TMPINT(NRTOT,IPNT2))THEN 3186 ! we found our point 3187 ICOUNT=ICOUNT+1 3188 IF(ABS(TMPRL_OM(NRTOT,IPNT)-TMPRL(NRTOT,IPNT2)) & 3189 .GT.4.0e-5)then 3190 IF ( IMPROC.EQ.NMPERR )WRITE & 3191 (MDSE,'(/2A,2(F12.5))') & 3192 ' *** ERROR WMGHGH: ', & 3193 ' *** TMPRL_OM(NRTOT,IPNT),TMPRL(NRTOT,IPNT2) = ', & 3194 TMPRL_OM(NRTOT,IPNT),TMPRL(NRTOT,IPNT2) 3195 ISTOP=1 3196 END IF 3197 END IF 3198 END DO 3199 END DO 3200 IF(ICOUNT.NE.NLOC)THEN 3201 IF ( IMPROC.EQ.NMPERR )WRITE (MDSE,'(/1A,2(I8))') & 3202 ' *** ERROR WMGHGH: ICOUNT,NLOC = ',ICOUNT,NLOC 3203 ISTOP=1 3204 END IF 3205 IF(ISTOP.EQ.1)THEN 3206 CALL EXTCDE ( 999 ) 3207 END IF 3208 3209 END IF ! (if both grids are regular grids) 3210 Page 47 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 3211 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 3212 !...End block of code that is just for testing 3213 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 3214 3215 NROK = 0 3216 3217 END DO LOWRANK_I ! DO IDST=1, NX 3218 END DO LOWRANK_J ! DO JDST=1, NY 3219 3220 3221 ! Notes: We are done with the counting. If we didn't use SCRIP to get NLOC, 3222 ! etc., then we need to set them using the _OM variables. 3223 3224 IF(.NOT.LSCRIP)THEN 3225 NLOC=NLOC_OM 3226 TMPINT=TMPINT_OM 3227 TMPRL=TMPRL_OM 3228 END IF 3229 3230 ! 3231 ! 2.c Set up masks based on stencil width of scheme and inferred land 3232 ! 2.c.1 Inferred land 3233 ! 3234 !!HT: Inferred land from INFLND is added to MAPSTA / MAPST2 3235 !!HT: 3236 MAPST2 = MAPST2 - 4*MOD(MAPST2/4,2) 3237 MAPST2 = MAPST2 + 4*INFLND 3238 DO IDST=1, NX 3239 DO JDST=1, NY 3240 IF ( MAPST2(JDST,IDST).GT.0 ) MAPSTA(JDST,IDST) = & 3241 - ABS(MAPSTA(JDST,IDST)) 3242 END DO 3243 END DO 3244 ! 3245 ! 2.c.2 Masking 3246 ! 3247 !!HT: This is masking in the low-res grid to identify where the grid 3248 !!HT: is covered by high-res grids, and far enough away from the 3249 !!HT: high-res grid edges so that no dynamic computations are needed 3250 !!HT: in the low-res grid. 3251 !!HT: 3252 ALLOCATE ( STMASK(NY,0:NX+1), MASKI(NY,NX) ) 3253 IF ( MDATAS(GDST)%MSKINI ) DEALLOCATE ( MDATAS(GDST)%MAPMSK ) 3254 ALLOCATE ( MDATAS(GDST)%MAPMSK(NY,NX) ) 3255 MAPMSK => MDATAS(GDST)%MAPMSK 3256 MDATAS(GDST)%MSKINI = .TRUE. 3257 3258 MAPMSK = MOD(MAPST2/8,2) 3259 MAPST2 = MAPST2 - 8*MAPMSK 3260 3261 !!HT: STMASK (logical) is used to start this up. We first use the point 3262 !!HT: MAPTST that have been marked as used for boundary points in 3263 !!HT: the corrsponding high-res grids. 3264 !!HT: NIT sets the stencil width of the propagation scheme, used to see 3265 !!HT: how far we need to move in from the boundary points of 3266 !!HT: the high-res grid to reach the area in the low-res grid 3267 !!HT: where we do not need to compute. Page 48 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 3268 3269 STMASK(:,1:NX) = MAPTST .LT. 0 3270 STMASK(:,0) = STMASK(:,NX) 3271 STMASK(:,NX+1) = STMASK(:,1) 3272 3273 NIT = ( 1 + INT(DTMAX/DTCFL-0.001) ) * 3 3274 3275 IDSTLA=2 3276 IDSTHA=NX-1 3277 3278 ! notes....bug fix: in official release 3.14, the if-then below 3279 ! was missing. This would produce incorrect results for a global grid that 3280 ! had a higher rank grid on the branch cut (180 to -180 or 360 to 0). See 3281 ! treatment of STMASK after the if-then statement. There, it is clear that 3282 ! it was intended that MASKI be available for i=1 and i=nx, ... but it wasn't 3283 ! available. Symptoms of bug: when using "T T" for masking options, a strip 3284 ! of land would be placed along the i-column just east of the branch cut. 3285 ! This would be seen in the global (low rank) grid. 3286 3287 IF ( ICLOSE.NE.ICLOSE_NONE ) THEN 3288 IDSTLA=1 3289 IDSTHA=NX 3290 END IF 3291 3292 DO JTMP=1, NIT 3293 MASKI = .FALSE. 3294 DO IDST=IDSTLA,IDSTHA 3295 DO JDST=2, NY-1 3296 IF ( .NOT. STMASK(JDST,IDST) .AND. ( & 3297 STMASK(JDST+1,IDST+1) .OR. STMASK(JDST+1,IDST ) .OR. & 3298 STMASK(JDST+1,IDST-1) .OR. STMASK(JDST ,IDST-1) .OR. & 3299 STMASK(JDST-1,IDST-1) .OR. STMASK(JDST-1,IDST ) .OR. & 3300 STMASK(JDST-1,IDST+1) .OR. STMASK(JDST ,IDST+1) ) ) & 3301 MASKI(JDST,IDST) = .TRUE. 3302 END DO 3303 END DO 3304 STMASK(:,1:NX) = STMASK(:,1:NX) .OR. MASKI 3305 STMASK(:,0) = STMASK(:,NX) 3306 STMASK(:,NX+1) = STMASK(:,1) 3307 END DO 3308 3309 !!HT: Loop over all point from which low-res grid gets data from 3310 !!HT: high-res grid(s). Comparing to STMASK shows which points can be 3311 !!HT: masked out for computation. 3312 !!HT: 3313 !!HT: MAPMSK is stored in WMMDATMD for use in wave model. 3314 3315 DO ILOC=1, NRTOT 3316 IDST = TMPINT(ILOC,-4) 3317 JDST = TMPINT(ILOC,-3) 3318 TMPLOG(ILOC) = STMASK(JDST,IDST) 3319 IF ( .NOT. STMASK(JDST,IDST) ) THEN 3320 MAPMSK(JDST,IDST) = 1 3321 IF ( FLGHG1 ) MAPSTA(JDST,IDST) = -ABS(MAPSTA(JDST,IDST)) 3322 MAPTST(JDST,IDST) = 99 3323 END IF 3324 END DO Page 49 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 3325 3326 IF ( FLGHG1 ) MAPST2 = MAPST2 + 8*MAPMSK 3327 3328 DEALLOCATE ( STMASK, MASKI ) 3329 3330 !!HT: Now that all temporary data is stored, and all mosks are set, all 3331 !!HT: can be put from temporaty storage in permanent storage. 3332 !!HT: 3333 !!HT: Should require no modifications for newer grids ... 3334 !!HT: ... unless more data is needed than for old grids ..... 3335 3336 ! 3337 ! 2.d Set up mapping for staging data 3338 ! 2.d.1 Set counters / required array sizes 3339 ! 3340 I1 = 0 3341 I2 = 0 3342 I3 = 0 3343 I4 = 0 3344 3345 DO ILOC=1, NRTOT 3346 3347 JJ = TMPINT(ILOC,-1) 3348 HGSTGE(GDST,JJ)%NTOT = HGSTGE(GDST,JJ)%NTOT + 1 3349 ISEA = TMPINT(ILOC,-2) 3350 JSEA = 1 + (ISEA-1)/NAPROC 3351 ISPROC = ISEA - (JSEA-1)*NAPROC + CROOT - 1 3352 ! 3353 I1(JJ,ISPROC) = I1(JJ,ISPROC) + 1 3354 IF ( TMPLOG(ILOC) ) I2(JJ,ISPROC) = I2(JJ,ISPROC) + 1 3355 IF ( IMPROC .EQ. ISPROC ) THEN 3356 HGSTGE(GDST,JJ)%NSMX = MAX(HGSTGE(GDST,JJ)%NSMX,TMPINT(ILOC,0)) 3357 END IF 3358 3359 DO JR=1, TMPINT(ILOC,0) 3360 ISEA = TMPINT(ILOC,JR) 3361 JSEA = 1 + (ISEA-1)/OUTPTS(JJ)%NAPROC 3362 ISPRO2 = ISEA - (JSEA-1)*OUTPTS(JJ)%NAPROC + & 3363 MDATAS(JJ)%CROOT - 1 3364 IF ( ISPRO2 .EQ. IMPROC ) THEN 3365 HGSTGE(GDST,JJ)%NSND = HGSTGE(GDST,JJ)%NSND + 1 3366 IF ( TMPLOG(ILOC) ) HGSTGE(GDST,JJ)%NSN1 = & 3367 HGSTGE(GDST,JJ)%NSN1 + 1 3368 END IF 3369 END DO 3370 ! 3371 END DO 3372 3373 HGSTGE(GDST,:)%NREC = I1(:,IMPROC) 3374 HGSTGE(GDST,:)%NRC1 = I2(:,IMPROC) 3375 ! 3376 ! 2.d.2 ALLOCATE (DEALLOCATE in section 0 as needed) 3377 ! 3378 DO GSRC=1, NRGRD 3379 IF ( HGSTGE(GDST,GSRC)%NREC .GT. 0 ) THEN 3380 ALLOCATE ( HGSTGE(GDST,GSRC)%LJSEA (HGSTGE(GDST,GSRC)%NREC), & 3381 HGSTGE(GDST,GSRC)%NRAVG (HGSTGE(GDST,GSRC)%NREC), & Page 50 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 3382 HGSTGE(GDST,GSRC)%IMPSRC(HGSTGE(GDST,GSRC)%NREC, & 3383 HGSTGE(GDST,GSRC)%NSMX), & 3384 HGSTGE(GDST,GSRC)%ITAG (HGSTGE(GDST,GSRC)%NREC, & 3385 HGSTGE(GDST,GSRC)%NSMX), & 3386 HGSTGE(GDST,GSRC)%WGTH (HGSTGE(GDST,GSRC)%NREC, & 3387 HGSTGE(GDST,GSRC)%NSMX), & 3388 HGSTGE(GDST,GSRC)%SHGH (SGRDS(GSRC)%NSPEC, & 3389 HGSTGE(GDST,GSRC)%NSMX, & 3390 HGSTGE(GDST,GSRC)%NREC) ) 3391 END IF 3392 IF ( HGSTGE(GDST,GSRC)%NSND .GT. 0 ) THEN 3393 ALLOCATE ( HGSTGE(GDST,GSRC)%ISEND (HGSTGE(GDST,GSRC)%NSND,5)) 3394 END IF 3395 HGSTGE(GDST,GSRC)%INIT = .TRUE. 3396 END DO 3397 ! 3398 ! 2.d.3 Fill allocated arrays 3399 ! 3400 FLGREC = .TRUE. 3401 I2 = I1 + 1 3402 I1 = 0 3403 I4 = HGSTGE(GDST,:)%NSND + 1 3404 I3 = 0 3405 3406 DO ILOC=1, NRTOT 3407 3408 ISEA = TMPINT(ILOC,-2) 3409 JJ = TMPINT(ILOC,-1) 3410 NR0 = TMPINT(ILOC, 0) 3411 JSEA = 1 + (ISEA-1)/NAPROC 3412 ISPROC = ISEA - (JSEA-1)*NAPROC + CROOT - 1 3413 FLGREC = ISPROC .EQ. IMPROC 3414 ! 3415 IF ( TMPLOG(ILOC) ) THEN 3416 I1(JJ,ISPROC) = I1(JJ,ISPROC) + 1 3417 IREC = I1(JJ,ISPROC) 3418 ELSE 3419 I2(JJ,ISPROC) = I2(JJ,ISPROC) - 1 3420 IREC = I2(JJ,ISPROC) 3421 END IF 3422 3423 IF ( FLGREC ) THEN 3424 HGSTGE(GDST,JJ)%LJSEA(IREC) = JSEA 3425 HGSTGE(GDST,JJ)%NRAVG(IREC) = NR0 3426 HGSTGE(GDST,JJ)%WGTH(IREC,:NR0) = TMPRL(ILOC,1:NR0) 3427 HGSTGE(GDST,JJ)%ITAG(IREC,:NR0) = LTAG(:NR0) 3428 END IF 3429 3430 DO IJ=1, NR0 3431 3432 ISEA = TMPINT(ILOC,IJ) 3433 JSEA = 1 + (ISEA-1)/OUTPTS(JJ)%NAPROC 3434 ISPRO2 = ISEA - (JSEA-1)*OUTPTS(JJ)%NAPROC & 3435 + MDATAS(JJ)%CROOT - 1 3436 ! 3437 IF ( FLGREC ) HGSTGE(GDST,JJ)%IMPSRC(IREC,IJ) = ISPRO2 3438 Page 51 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 3439 IF ( ISPRO2 .EQ. IMPROC ) THEN 3440 IF ( TMPLOG(ILOC) ) THEN 3441 I3(JJ) = I3(JJ) + 1 3442 ISND = I3(JJ) 3443 ELSE 3444 I4(JJ) = I4(JJ) - 1 3445 ISND = I4(JJ) 3446 END IF 3447 HGSTGE(GDST,JJ)%ISEND(ISND,1) = JSEA 3448 HGSTGE(GDST,JJ)%ISEND(ISND,2) = ISPROC 3449 HGSTGE(GDST,JJ)%ISEND(ISND,3) = IREC 3450 HGSTGE(GDST,JJ)%ISEND(ISND,4) = IJ 3451 HGSTGE(GDST,JJ)%ISEND(ISND,5) = LTAG(IJ) 3452 END IF 3453 3454 END DO 3455 ! 3456 LTAG = LTAG + NR0 3457 LTAG0 = LTAG0 + NR0 3458 ! 3459 END DO 3460 ! 3461 ! 2.e Adjust FLAGST using MAPTST 3462 ! 3463 DO ISEA=1, NSEA 3464 IDST = MAPSF(ISEA,1) 3465 JDST = MAPSF(ISEA,2) 3466 IF ( MAPTST(JDST,IDST) .GT. 0 ) FLAGST(ISEA) = .NOT. FLGHG1 3467 END DO 3468 ! 3469 ! 2.f Test output map 3470 ! 3471 DEALLOCATE ( MAPTST, INFLND ) 3472 ! 3473 ! 2.g Test output receiving 3474 ! 3475 ! 2.h Test output sending 3476 ! 3477 ! 2.i Final clean up 3478 ! 3479 DEALLOCATE ( IDSTL, IDSTH, JDSTL, JDSTH, GRIDOK, BDIST, TMPINT, & 3480 TMPRL, TMPLOG ) 3481 3482 IF(OLD_METHOD)DEALLOCATE ( BDIST_OM, TMPINT_OM, TMPRL_OM) 3483 3484 DEALLOCATE ( LTAG ) 3485 ! 3486 3487 ! Notes: We are done with this dst (low rank) grid, so we deallocate ALLWGTS . 3488 ! This is important because ALLWGTS will be allocated again for the next 3489 ! dst grid. 3490 3491 3492 END IF ! IF ( GRDHGH(GDST,0) ... 3493 END DO LOWRANK_GRID 3494 3495 ! Page 52 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 3496 DEALLOCATE ( I1, I2, I3, I4 ) 3497 DEALLOCATE ( NX_BEG, NX_END ) 3498 3499 ! 3500 ! 2.j Test output counters 3501 ! 3502 3503 RETURN 3504 ! 3505 ! Formats 3506 ! 3507 1000 FORMAT (/' *** WAVEWATCH III ERROR IN WMGHGH : *** '/ & 3508 ' GRDHGH NOT YET ALLOCATED, CALL WMGLOW FIRST'/) 3509 1010 FORMAT (/' *** WAVEWATCH III ERROR IN WMGHGH : *** '/ & 3510 ' NBI = 0 MAKES NO SENCE FOR RANK > 1 '/) 3511 1020 FORMAT (/' *** WAVEWATCH III ERROR IN WMGHGH : *** '/ & 3512 ' TMPINT AND TMPRL TOO SMALL (w/out SCRIP)'/) 3513 1021 FORMAT (/' *** WAVEWATCH III ERROR IN WMGHGH : *** '/ & 3514 ' TMPINT AND TMPRL TOO SMALL (w/SCRIP) '/) 3515 ! 3516 !/ 3517 ! 3518 !/ 3519 !/ End of WMGHGH ----------------------------------------------------- / 3520 !/ 3521 END SUBROUTINE WMGHGH ENTRY POINTS Name wmgridmd_mp_wmghgh_ Page 53 Source Listing WMGHGH 2014-09-16 16:48 Symbol Table wmgridmd.f90 SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1000 Label 2431 1051 1010 Label 2433 1166 1020 Label 2435 2058 1021 Label 2437 ABS Func 1204 scalar 1204,1215,1219,1709,1809,1819,2050 ,2112,2165,2245 ALLOCATED Func 1050 scalar 1050 ALL_REGULAR Local 1024 L(4) 4 scalar 1024,1090,1099,1111 BDIST Local 982 R(4) 4 1 1 ALC 1436,1879,1884,1897,1977,1982,1985 ,2403 BDIST_OM Local 982 R(4) 4 1 1 ALC 1438,1792,1817,1879,1884,1897,2406 CLGTYPE Param 1446 I(4) 4 scalar 1446,1479,1560,1600 CONSTANTS Module 935 935 CROOT Local 2275 I(4) 4 scalar PTR 2275,2336 CROOT Local 2287 I(4) 4 scalar 2287,2359 DD Local 998 R(4) 4 scalar 1221,1231,1232 DERA Param 1136 R(4) 4 scalar 1136 DIST_MAX Local 1039 R(4) 4 scalar 1568,1583,1587,1588,1596,1597,1608 ,1623,1627,1628 DIST_MIN Local 1039 R(4) 4 scalar 1569,1584,1590,1591,1609,1624,1630 ,1631,1636,1637 DO_CHECKING Local 1026 L(4) 4 scalar 1026,1103,1106,1857,2098 DST_GRID_SIZE Local 1006 I(4) 4 scalar DTCFL Local 2197 R(4) 4 scalar PTR 2197 DTMAX Local 1203 R(4) 4 scalar PTR 1203,2007,2197 DXC Local 989 R(4) 4 scalar 1750,1751,1752,2026,2027,2028 DX_MAX_GDST Local 1008 R(4) 4 scalar 1561,1564,1596,1645 DX_MIN_GSRC Local 1009 R(4) 4 scalar 1601,1604,1636,1645 DY_MAX_GDST Local 1008 R(4) 4 scalar 1562,1565,1597,1646 DY_MIN_GSRC Local 1009 R(4) 4 scalar 1602,1605,1637,1646 EDIST Local 1039 R(4) 4 scalar 1579,1583,1584,1587,1588,1590,1591 ,1619,1623,1624,1627,1628,1630,163 1 EXTCDE Subr 936 936,1052,1116,1167,1862,1867,1872, 1877,1885,2059,2103,2130 FACTOR Local 988 R(4) 4 scalar 1136,1139,1221 FLAGLL Local 1099 L(4) 4 scalar 1099,1135,1221,1505,1579,1619,1749 ,2025 FLAGST Local 2390 L(4) 4 1 1 PTR 2390 FLGBDI Local 1133 L(4) 4 scalar 1133,1277 FLGHG1 Local 2245 L(4) 4 scalar 2245,2250,2390 FLGREC Local 992 L(4) 4 scalar 2324,2337,2347,2361 GDST Local 964 I(4) 4 scalar 1061,1063,1064,1065,1066,1067,1068 ,1069,1070,1071,1072,1073,1074,107 5,1076,1080,1088,1089,1144,1147,11 48,1149,1161,1181,1182,1295,1301,1 312,1313,1314,1415,1416,1418,1434, 1435,1436,1438,1457,1458,1550,1551 ,1560,1561,1562,1563,1564,1565,157 0,1577,1578,1579,1580,1581,1724,17 25,1968,1970,2177,2178,2179,2180,2 Page 54 Source Listing WMGHGH 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 272,2280,2289,2290,2291,2297,2298, 2303,2304,2305,2306,2307,2308,2309 ,2310,2311,2312,2313,2314,2316,231 7,2319,2327,2348,2349,2350,2351,23 61,2371,2372,2373,2374,2375 GRANK Local 1161 I(4) 4 1 1 ALC 1161,1975,1980 GRAV Param 1231 R(4) 4 scalar 1231 GRDHGH Local 1050 I(4) 4 2 1 ALC 1050,1301,1415,1416,1434,1435,1436 ,1438,1457,1458,1550,1551,1724,172 5,1968,1970 GRIDOK Local 994 L(4) 4 1 1 ALC 1436,1768,1917,1922,1972,2403 GRIDS Local 1089 RECORD 4376 1 1 ALC,TGT 1089,1479,1480,1486,1487,1488,1489 ,1493,1494,1495,1496,1497,1498,156 0,1561,1562,1563,1564,1565,1570,15 77,1578,1579,1580,1581,1600,1601,1 602,1603,1604,1605,1610,1617,1618, 1619,1620,1621,1750,1751,1752,1754 ,1755,1757,1758,1765,1766,1796,180 7,1809,1819,2026,2027,2028,2030,20 31,2033,2034,2050,2062 GSRC Local 964 I(4) 4 scalar 1062,1063,1064,1065,1066,1067,1068 ,1069,1070,1071,1072,1073,1074,107 5,1076,1081,1416,1417,1418,1419,14 20,1421,1425,1458,1479,1480,1486,1 487,1488,1489,1493,1494,1495,1496, 1497,1498,1526,1551,1600,1601,1602 ,1603,1604,1605,1610,1617,1618,161 9,1620,1621,1651,1725,1750,1751,17 52,1754,1755,1757,1758,1765,1766,1 796,1807,1809,1818,1819,1926,1970, 1974,1975,1980,1984,1990,1995,2006 ,2026,2027,2028,2030,2031,2033,203 4,2050,2062,2302,2303,2304,2305,23 06,2307,2308,2309,2310,2311,2312,2 313,2314,2316,2317,2319 GTYPE Local 1089 I(4) 4 scalar 1089,1479,1480,1560,1563,1600,1603 GTYPE Local 1446 I(4) 4 scalar PTR 1446 HGSTGE Local 1063 RECORD 968 2 1 ALC,TGT 1063,1064,1065,1066,1067,1068,1069 ,1070,1071,1072,1073,1074,1075,107 6,2272,2280,2289,2290,2291,2297,22 98,2303,2304,2305,2306,2307,2308,2 309,2310,2311,2312,2313,2314,2316, 2317,2319,2327,2348,2349,2350,2351 ,2361,2371,2372,2373,2374,2375 HPFAC Local 1561 R(4) 4 2 1 PTR 1561,1601 HQFAC Local 1562 R(4) 4 2 1 PTR 1562,1602 I1 Local 975 I(4) 4 2 1 ALC 1288,2264,2277,2297,2325,2326,2340 ,2341,2420 I2 Local 975 I(4) 4 2 1 ALC 1288,2265,2278,2298,2325,2343,2344 ,2420 I3 Local 975 I(4) 4 1 1 ALC 1289,2266,2328,2365,2366,2420 I4 Local 975 I(4) 4 1 1 ALC 1289,2267,2327,2368,2369,2420 IB Local 964 I(4) 4 scalar 1417,1418,1419,1420 IBND Local 997 I(4) 4 scalar 1213,1215,1222,1223 ICLOSE Local 2211 I(4) 4 scalar PTR 2211 Page 55 Source Listing WMGHGH 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References ICLOSE_NONE Param 2211 I(4) 4 scalar 2211 ICOUNT Local 1005 I(4) 4 scalar 2106,2111,2124,2126 IDST Local 964 I(4) 4 scalar 1190,1191,1194,1198,1202,1203,1204 ,1206,1208,1217,1219,1221,1222,123 2,1419,1421,1706,1707,1709,1711,17 12,1713,1915,1942,1995,2003,2005,2 162,2164,2165,2218,2220,2221,2222, 2223,2224,2225,2240,2242,2243,2244 ,2245,2246,2388,2390 IDSTH Local 973 I(4) 4 1 1 ALC 1434,1507,1514,1521,1531,2403 IDSTHA Local 965 I(4) 4 scalar 1449,1531,1707,2200,2213,2218 IDSTL Local 973 I(4) 4 1 1 ALC 1434,1506,1513,1520,1530,2403 IDSTLA Local 965 I(4) 4 scalar 1448,1530,1707,2199,2212,2218 IERR_MPI Local 971 I(4) 4 scalar 1044,1293 IJ Local 964 I(4) 4 scalar 2354,2356,2361,2374,2375 ILOC Local 968 I(4) 4 scalar 2239,2240,2241,2242,2269,2271,2273 ,2278,2280,2283,2284,2290,2330,233 2,2333,2334,2339,2350,2356,2364 IM Local 978 I(4) 4 scalar IM1 Local 1038 I(4) 4 scalar 1577,1579,1580,1617,1619,1620 IM2 Local 1038 I(4) 4 scalar 1578,1581,1618,1621 IMPROC Local 1051 I(4) 4 scalar 1051,1100,1112,1166,1178,1185,1186 ,1190,1195,1196,1217,1240,1860,186 5,1870,1875,1880,2058,2101,2114,21 25,2279,2288,2297,2298,2337,2363 IMPSRC Local 1066 I(4) 4 2 1 PTR 1066,2306,2361 INFLND Local 976 I(4) 4 2 1 ALC 1316,1318,1915,1942,2161,2395 INIT Local 1063 L(4) 4 scalar 1063,1076,2319 INT Func 1513 scalar 1513,1514,1517,1518,1645,1646,2197 IPNT Local 1005 I(4) 4 scalar 2107,2109,2112,2118 IPNT2 Local 1005 I(4) 4 scalar 2108,2109,2112,2118 IREC Local 968 I(4) 4 scalar 2341,2344,2348,2349,2350,2351,2361 ,2373 ISEA Local 964 I(4) 4 scalar 2273,2274,2275,2284,2285,2286,2332 ,2335,2336,2356,2357,2358,2387,238 8,2389,2390 ISEND Local 1069 I(4) 4 2 1 PTR 1069,2317,2371,2372,2373,2374,2375 ISFIRST Local 1038 I(4) 4 scalar 1567,1582,1585,1607,1622,1625 ISND Local 968 I(4) 4 scalar 2366,2369,2371,2372,2373,2374,2375 ISPRO2 Local 967 I(4) 4 scalar 2286,2288,2358,2361,2363 ISPROC Local 967 I(4) 4 scalar 2275,2277,2278,2279,2336,2337,2340 ,2341,2343,2344,2372 ISRC Local 966 I(4) 4 scalar 1794,1796,1807,1809,1818,1819,2047 ,2048,2050,2062 ISRCH Local 966 I(4) 4 scalar 1761,1765,1794,2041,2047 ISRCL Local 966 I(4) 4 scalar 1760,1765,1794,2040,2047 ISTAT Local 1005 I(4) 4 scalar ISTOP Local 1006 I(4) 4 scalar 2105,2119,2127,2129 IT Local 1038 I(4) 4 scalar 1571,1572,1575,1577,1611,1612,1615 ,1617 ITAG Local 1066 I(4) 4 2 1 PTR 1066,2308,2351 ITMP Local 968 I(4) 4 scalar 2020,2021 ITRI Local 1038 I(4) 4 scalar 1570,1577,1578,1610,1617,1618 JBND Local 997 I(4) 4 scalar 1214,1215,1222,1223 JD Local 989 R(4) 4 scalar 1977,1982,1985,2007 Page 56 Source Listing WMGHGH 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References JDST Local 964 I(4) 4 scalar 1201,1202,1203,1204,1206,1208,1218 ,1219,1221,1222,1232,1420,1421,170 3,1704,1709,1711,1712,1713,1915,19 42,1995,2004,2005,2163,2164,2165,2 219,2220,2221,2222,2223,2224,2225, 2241,2242,2243,2244,2245,2246,2389 ,2390 JDSTH Local 973 I(4) 4 1 1 ALC 1435,1518,1523,1533,2403 JDSTHA Local 965 I(4) 4 scalar 1451,1533,1704 JDSTL Local 973 I(4) 4 1 1 ALC 1435,1517,1522,1532,2403 JDSTLA Local 965 I(4) 4 scalar 1450,1532,1704 JF Local 967 I(4) 4 scalar 1961,1973,1974,1984,1990 JJ Local 964 I(4) 4 scalar 1415,1416,1457,1458,1506,1507,1513 ,1514,1517,1518,1520,1521,1522,152 3,1550,1551,1687,1688,1724,1725,17 68,1792,1817,1879,1884,1917,1922,1 968,1970,1972,1977,1982,1985,2271, 2272,2277,2278,2280,2285,2286,2287 ,2289,2290,2291,2333,2340,2341,234 3,2344,2348,2349,2350,2351,2357,23 58,2359,2361,2365,2366,2368,2369,2 371,2372,2373,2374,2375 JR Local 967 I(4) 4 scalar 1975,1980,2283,2284 JSEA Local 965 I(4) 4 scalar 2274,2275,2285,2286,2335,2336,2348 ,2357,2358,2371 JSRC Local 966 I(4) 4 scalar 1795,1796,1807,1809,1818,1819,2049 ,2050,2052,2053,2062 JSRCH Local 966 I(4) 4 scalar 1763,1766,1795,2043,2049 JSRCL Local 966 I(4) 4 scalar 1762,1766,1795,2042,2049 JT Local 1038 I(4) 4 scalar 1573,1575,1578,1613,1615,1618 JTMP Local 1006 I(4) 4 scalar 2216 KDST Local 1003 I(4) 4 scalar KSRC Local 1004 I(4) 4 scalar LJSEA Local 1065 I(4) 4 1 1 PTR 1065,2304,2348 LMPIBDI Local 1036 L(4) 4 scalar 1036,1192 LOWRANK_GRID Label 1295 scalar 2417 LOWRANK_I Label 1706 scalar 2141 LOWRANK_J Label 1703 scalar 2142 LSCRIP Local 1012 L(4) 4 scalar 1012,1099,1106,1111,1892,2148 LSCRIPNC Local 1015 L(4) 4 scalar 1015,1293 LTAG Local 986 I(4) 4 1 1 ALC 1686,1688,2351,2375,2380,2408 LTAG0 Local 970 I(4) 4 scalar 1291,1688,2381 MAPBDI Local 1181 R(4) 4 2 1 PTR 1181,1182,1818 MAPBDI Local 1182 R(4) 4 2 1 PTR 1182,1203,1206,1208,1232 MAPFS Local 2005 I(4) 4 2 1 PTR 2005 MAPFS Local 2062 I(4) 4 2 1 PTR 2062 MAPMSK Local 2177 I(4) 4 2 1 PTR 2177,2178,2179 MAPMSK Local 2179 I(4) 4 2 1 PTR 2179,2182,2183,2244,2250 MAPSF Local 1419 I(4) 4 2 1 PTR 1419,1420,2388,2389 MAPST2 Local 1807 I(4) 4 2 1 PTR 1807 MAPST2 Local 2160 I(4) 4 2 1 PTR 2160,2161,2164,2182,2183,2250 MAPSTA Local 1202 I(4) 4 2 1 PTR 1202,1204,1215,1219,1709,2164,2165 ,2245 MAPSTA Local 1796 I(4) 4 2 1 PTR 1796,1809,1819,2050 MAPTST Local 974 I(4) 4 2 1 ALC 1316,1317,1421,1711,1995,2193,2246 Page 57 Source Listing WMGHGH 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References ,2390,2395 MASKI Local 995 L(4) 4 2 1 ALC 2176,2217,2225,2228,2252 MAX Func 1520 scalar 1520,1522,1644,2048,2053,2280 MAXVAL Func 1488 scalar 1488,1489,1531,1533,1561,1562 MDATAS Local 1181 RECORD 1360 1 1 ALC,TGT 1181,1182,1417,1418,1419,1420,1818 ,2177,2178,2179,2180,2287,2359 MDSE Local 1051 I(4) 4 scalar 1051,1101,1113,1147,1148,1149,1166 ,1178,1193,1197,1240,1312,1313,131 4,1673,1860,1865,1870,1875,1881,20 58,2101,2115,2125 MDST Local 1147 I(4) 4 scalar 1147,1148,1149,1312,1313,1314 MIN Func 1232 scalar 1232,1521,1523,1817,2048,2052 MINVAL Func 1486 scalar 1486,1487,1530,1532,1601,1602 MOD Func 1191 scalar 1191,1750,2026,2160,2182 MPIPRIV1 Common 532 28 MPIPRIV2 Common 534 24 MPIPRIVC Common 537 2 MPI_2COMPLEX Param 332 I(4) 4 scalar MPI_2DOUBLE_COMPLEX Param 338 I(4) 4 scalar MPI_2DOUBLE_PRECISION Param 334 I(4) 4 scalar MPI_2INT Param 415 I(4) 4 scalar MPI_2INTEGER Param 330 I(4) 4 scalar MPI_2REAL Param 336 I(4) 4 scalar MPI_ADDRESS_KIND Param 372 I(4) 4 scalar MPI_ANY_SOURCE Param 300 I(4) 4 scalar MPI_ANY_TAG Param 302 I(4) 4 scalar MPI_APPNUM Param 269 I(4) 4 scalar MPI_ARGVS_NULL Scalar 83 CHAR 1 2 1 COM MPI_ARGV_NULL Scalar 84 CHAR 1 1 1 COM MPI_BAND Param 217 I(4) 4 scalar MPI_BARRIER Subr 1044 1044,1293 MPI_BOR Param 221 I(4) 4 scalar MPI_BOTTOM Scalar 517 I(4) 4 scalar COM MPI_BSEND_OVERHEAD Param 296 I(4) 4 scalar MPI_BXOR Param 225 I(4) 4 scalar MPI_BYTE Param 342 I(4) 4 scalar MPI_CART Param 308 I(4) 4 scalar MPI_CHAR Param 375 I(4) 4 scalar MPI_CHARACTER Param 340 I(4) 4 scalar MPI_COMBINER_CONTIGUOUS Param 423 I(4) 4 scalar MPI_COMBINER_DARRAY Param 445 I(4) 4 scalar MPI_COMBINER_DUP Param 421 I(4) 4 scalar MPI_COMBINER_F90_COMPLEX Param 449 I(4) 4 scalar MPI_COMBINER_F90_INTEGER Param 451 I(4) 4 scalar MPI_COMBINER_F90_REAL Param 447 I(4) 4 scalar MPI_COMBINER_HINDEXED Param 435 I(4) 4 scalar MPI_COMBINER_HINDEXED_INTE GER Param 433 I(4) 4 scalar MPI_COMBINER_HVECTOR Param 429 I(4) 4 scalar MPI_COMBINER_HVECTOR_INTEG ER Param 427 I(4) 4 scalar MPI_COMBINER_INDEXED Param 431 I(4) 4 scalar MPI_COMBINER_INDEXED_BLOCK Param 437 I(4) 4 scalar MPI_COMBINER_NAMED Param 419 I(4) 4 scalar MPI_COMBINER_RESIZED Param 453 I(4) 4 scalar Page 58 Source Listing WMGHGH 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References MPI_COMBINER_STRUCT Param 441 I(4) 4 scalar MPI_COMBINER_STRUCT_INTEGE R Param 439 I(4) 4 scalar MPI_COMBINER_SUBARRAY Param 443 I(4) 4 scalar MPI_COMBINER_VECTOR Param 425 I(4) 4 scalar MPI_COMM_DUP_FN Subr 521 scalar MPI_COMM_NULL Param 239 I(4) 4 scalar MPI_COMM_NULL_COPY_FN Subr 522 scalar MPI_COMM_NULL_DELETE_FN Subr 521 scalar MPI_COMM_SELF Param 235 I(4) 4 scalar MPI_COMM_WORLD Param 233 I(4) 4 scalar 1044,1293 MPI_COMPLEX Param 318 I(4) 4 scalar MPI_COMPLEX16 Param 368 I(4) 4 scalar MPI_COMPLEX32 Param 370 I(4) 4 scalar MPI_COMPLEX8 Param 366 I(4) 4 scalar MPI_CONGRUENT Param 201 I(4) 4 scalar MPI_CONVERSION_FN_NULL Subr 527 scalar MPI_DATATYPE_NULL Param 249 I(4) 4 scalar 359 MPI_DISPLACEMENT_CURRENT Param 515 I(8) 8 scalar MPI_DISTRIBUTE_BLOCK Param 507 I(4) 4 scalar MPI_DISTRIBUTE_CYCLIC Param 509 I(4) 4 scalar MPI_DISTRIBUTE_DFLT_DARG Param 513 I(4) 4 scalar MPI_DISTRIBUTE_NONE Param 511 I(4) 4 scalar MPI_DOUBLE Param 397 I(4) 4 scalar MPI_DOUBLE_COMPLEX Param 320 I(4) 4 scalar MPI_DOUBLE_INT Param 409 I(4) 4 scalar MPI_DOUBLE_PRECISION Param 326 I(4) 4 scalar MPI_DUP_FN Subr 518 scalar MPI_ERRCODES_IGNORE Scalar 82 I(4) 4 1 1 COM MPI_ERRHANDLER_NULL Param 253 I(4) 4 scalar MPI_ERROR Param 76 I(4) 4 scalar MPI_ERRORS_ARE_FATAL Param 195 I(4) 4 scalar MPI_ERRORS_RETURN Param 197 I(4) 4 scalar MPI_ERR_ACCESS Param 189 I(4) 4 scalar MPI_ERR_AMODE Param 173 I(4) 4 scalar MPI_ERR_ARG Param 109 I(4) 4 scalar MPI_ERR_ASSERT Param 131 I(4) 4 scalar MPI_ERR_BAD_FILE Param 163 I(4) 4 scalar MPI_ERR_BASE Param 97 I(4) 4 scalar MPI_ERR_BUFFER Param 115 I(4) 4 scalar MPI_ERR_COMM Param 137 I(4) 4 scalar MPI_ERR_CONVERSION Param 193 I(4) 4 scalar MPI_ERR_COUNT Param 93 I(4) 4 scalar MPI_ERR_DIMS Param 179 I(4) 4 scalar MPI_ERR_DISP Param 125 I(4) 4 scalar MPI_ERR_DUP_DATAREP Param 117 I(4) 4 scalar MPI_ERR_FILE Param 91 I(4) 4 scalar MPI_ERR_FILE_EXISTS Param 133 I(4) 4 scalar MPI_ERR_FILE_IN_USE Param 165 I(4) 4 scalar MPI_ERR_GROUP Param 145 I(4) 4 scalar MPI_ERR_INFO Param 159 I(4) 4 scalar MPI_ERR_INFO_KEY Param 103 I(4) 4 scalar MPI_ERR_INFO_NOKEY Param 129 I(4) 4 scalar MPI_ERR_INFO_VALUE Param 153 I(4) 4 scalar MPI_ERR_INTERN Param 185 I(4) 4 scalar Page 59 Source Listing WMGHGH 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References MPI_ERR_IN_STATUS Param 101 I(4) 4 scalar MPI_ERR_IO Param 187 I(4) 4 scalar MPI_ERR_KEYVAL Param 139 I(4) 4 scalar MPI_ERR_LASTCODE Param 121 I(4) 4 scalar MPI_ERR_LOCKTYPE Param 105 I(4) 4 scalar MPI_ERR_NAME Param 141 I(4) 4 scalar MPI_ERR_NOT_SAME Param 155 I(4) 4 scalar MPI_ERR_NO_MEM Param 161 I(4) 4 scalar MPI_ERR_NO_SPACE Param 191 I(4) 4 scalar MPI_ERR_NO_SUCH_FILE Param 181 I(4) 4 scalar MPI_ERR_OP Param 107 I(4) 4 scalar MPI_ERR_OTHER Param 87 I(4) 4 scalar MPI_ERR_PENDING Param 135 I(4) 4 scalar MPI_ERR_PORT Param 127 I(4) 4 scalar MPI_ERR_QUOTA Param 171 I(4) 4 scalar MPI_ERR_RANK Param 177 I(4) 4 scalar MPI_ERR_READ_ONLY Param 111 I(4) 4 scalar MPI_ERR_REQUEST Param 143 I(4) 4 scalar MPI_ERR_RMA_CONFLICT Param 99 I(4) 4 scalar MPI_ERR_RMA_SYNC Param 157 I(4) 4 scalar MPI_ERR_ROOT Param 175 I(4) 4 scalar MPI_ERR_SERVICE Param 183 I(4) 4 scalar MPI_ERR_SIZE Param 113 I(4) 4 scalar MPI_ERR_SPAWN Param 95 I(4) 4 scalar MPI_ERR_TAG Param 151 I(4) 4 scalar MPI_ERR_TOPOLOGY Param 147 I(4) 4 scalar MPI_ERR_TRUNCATE Param 123 I(4) 4 scalar MPI_ERR_TYPE Param 149 I(4) 4 scalar MPI_ERR_UNKNOWN Param 167 I(4) 4 scalar MPI_ERR_UNSUPPORTED_DATARE P Param 119 I(4) 4 scalar MPI_ERR_UNSUPPORTED_OPERAT ION Param 169 I(4) 4 scalar MPI_ERR_WIN Param 89 I(4) 4 scalar MPI_FILE_NULL Param 243 I(4) 4 scalar MPI_FLOAT Param 395 I(4) 4 scalar MPI_FLOAT_INT Param 407 I(4) 4 scalar MPI_GRAPH Param 306 I(4) 4 scalar MPI_GROUP_EMPTY Param 237 I(4) 4 scalar MPI_GROUP_NULL Param 245 I(4) 4 scalar MPI_HOST Param 259 I(4) 4 scalar MPI_IDENT Param 199 I(4) 4 scalar MPI_INFO_NULL Param 255 I(4) 4 scalar MPI_INT Param 387 I(4) 4 scalar MPI_INTEGER Param 328 I(4) 4 scalar MPI_INTEGER1 Param 350 I(4) 4 scalar MPI_INTEGER16 Param 358 I(4) 4 scalar MPI_INTEGER2 Param 352 I(4) 4 scalar MPI_INTEGER4 Param 354 I(4) 4 scalar MPI_INTEGER8 Param 356 I(4) 4 scalar MPI_IN_PLACE Scalar 517 I(4) 4 scalar COM MPI_IO Param 261 I(4) 4 scalar MPI_KEYVAL_INVALID Param 294 I(4) 4 scalar MPI_LAND Param 215 I(4) 4 scalar MPI_LASTUSEDCODE Param 267 I(4) 4 scalar Page 60 Source Listing WMGHGH 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References MPI_LB Param 346 I(4) 4 scalar MPI_LOCK_EXCLUSIVE Param 314 I(4) 4 scalar MPI_LOCK_SHARED Param 316 I(4) 4 scalar MPI_LOGICAL Param 322 I(4) 4 scalar MPI_LONG Param 391 I(4) 4 scalar MPI_LONG_DOUBLE Param 399 I(4) 4 scalar MPI_LONG_DOUBLE_INT Param 417 I(4) 4 scalar MPI_LONG_INT Param 411 I(4) 4 scalar MPI_LONG_LONG Param 405 I(4) 4 scalar MPI_LONG_LONG_INT Param 401 I(4) 4 scalar MPI_LOR Param 219 I(4) 4 scalar MPI_LXOR Param 223 I(4) 4 scalar MPI_MAX Param 207 I(4) 4 scalar MPI_MAXLOC Param 229 I(4) 4 scalar MPI_MAX_DATAREP_STRING Param 289 I(4) 4 scalar MPI_MAX_ERROR_STRING Param 277 I(4) 4 scalar MPI_MAX_INFO_KEY Param 283 I(4) 4 scalar MPI_MAX_INFO_VAL Param 285 I(4) 4 scalar MPI_MAX_OBJECT_NAME Param 281 I(4) 4 scalar MPI_MAX_PORT_NAME Param 279 I(4) 4 scalar MPI_MAX_PROCESSOR_NAME Param 287 I(4) 4 scalar MPI_MIN Param 209 I(4) 4 scalar MPI_MINLOC Param 227 I(4) 4 scalar MPI_MODE_APPEND Param 493 I(4) 4 scalar MPI_MODE_CREATE Param 489 I(4) 4 scalar MPI_MODE_DELETE_ON_CLOSE Param 485 I(4) 4 scalar MPI_MODE_EXCL Param 491 I(4) 4 scalar MPI_MODE_NOCHECK Param 461 I(4) 4 scalar MPI_MODE_NOPRECEDE Param 467 I(4) 4 scalar MPI_MODE_NOPUT Param 465 I(4) 4 scalar MPI_MODE_NOSTORE Param 463 I(4) 4 scalar MPI_MODE_NOSUCCEED Param 469 I(4) 4 scalar MPI_MODE_RDONLY Param 479 I(4) 4 scalar MPI_MODE_RDWR Param 481 I(4) 4 scalar MPI_MODE_SEQUENTIAL Param 495 I(4) 4 scalar MPI_MODE_UNIQUE_OPEN Param 487 I(4) 4 scalar MPI_MODE_WRONLY Param 483 I(4) 4 scalar MPI_NULL_COPY_FN Subr 518 scalar MPI_NULL_DELETE_FN Subr 518 scalar MPI_OFFSET_KIND Param 372 I(4) 4 scalar MPI_OP_NULL Param 247 I(4) 4 scalar MPI_ORDER_C Param 503 I(4) 4 scalar MPI_ORDER_FORTRAN Param 505 I(4) 4 scalar MPI_PACKED Param 348 I(4) 4 scalar MPI_PROC_NULL Param 298 I(4) 4 scalar MPI_PROD Param 213 I(4) 4 scalar MPI_REAL Param 324 I(4) 4 scalar MPI_REAL16 Param 364 I(4) 4 scalar MPI_REAL4 Param 360 I(4) 4 scalar MPI_REAL8 Param 362 I(4) 4 scalar MPI_REPLACE Param 231 I(4) 4 scalar MPI_REQUEST_NULL Param 251 I(4) 4 scalar MPI_ROOT Param 304 I(4) 4 scalar MPI_SEEK_CUR Param 499 I(4) 4 scalar MPI_SEEK_END Param 501 I(4) 4 scalar Page 61 Source Listing WMGHGH 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References MPI_SEEK_SET Param 497 I(4) 4 scalar MPI_SHORT Param 383 I(4) 4 scalar MPI_SHORT_INT Param 413 I(4) 4 scalar MPI_SIGNED_CHAR Param 377 I(4) 4 scalar MPI_SIMILAR Param 203 I(4) 4 scalar MPI_SOURCE Param 76 I(4) 4 scalar MPI_STATUSES_IGNORE Scalar 81 I(4) 4 2 5 COM MPI_STATUS_IGNORE Scalar 80 I(4) 4 1 5 COM MPI_STATUS_SIZE Param 78 I(4) 4 scalar 80,81 MPI_SUBVERSION Param 312 I(4) 4 scalar MPI_SUCCESS Param 85 I(4) 4 scalar MPI_SUM Param 211 I(4) 4 scalar MPI_TAG Param 76 I(4) 4 scalar MPI_TAG_UB Param 257 I(4) 4 scalar MPI_THREAD_FUNNELED Param 473 I(4) 4 scalar MPI_THREAD_MULTIPLE Param 477 I(4) 4 scalar MPI_THREAD_SERIALIZED Param 475 I(4) 4 scalar MPI_THREAD_SINGLE Param 471 I(4) 4 scalar MPI_TYPECLASS_COMPLEX Param 459 I(4) 4 scalar MPI_TYPECLASS_INTEGER Param 457 I(4) 4 scalar MPI_TYPECLASS_REAL Param 455 I(4) 4 scalar MPI_TYPE_DUP_FN Subr 525 scalar MPI_TYPE_NULL_COPY_FN Subr 526 scalar MPI_TYPE_NULL_DELETE_FN Subr 525 scalar MPI_UB Param 344 I(4) 4 scalar MPI_UNDEFINED Param 291 I(4) 4 scalar MPI_UNDEFINED_RANK Param 291 I(4) 4 scalar MPI_UNEQUAL Param 205 I(4) 4 scalar MPI_UNIVERSE_SIZE Param 265 I(4) 4 scalar MPI_UNSIGNED Param 389 I(4) 4 scalar MPI_UNSIGNED_CHAR Param 379 I(4) 4 scalar MPI_UNSIGNED_LONG Param 393 I(4) 4 scalar MPI_UNSIGNED_LONG_LONG Param 403 I(4) 4 scalar MPI_UNSIGNED_SHORT Param 385 I(4) 4 scalar MPI_VERSION Param 310 I(4) 4 scalar MPI_WCHAR Param 381 I(4) 4 scalar MPI_WIN_BASE Param 271 I(4) 4 scalar MPI_WIN_DISP_UNIT Param 275 I(4) 4 scalar MPI_WIN_DUP_FN Subr 523 scalar MPI_WIN_NULL Param 241 I(4) 4 scalar MPI_WIN_NULL_COPY_FN Subr 524 scalar MPI_WIN_NULL_DELETE_FN Subr 523 scalar MPI_WIN_SIZE Param 273 I(4) 4 scalar MPI_WTICK Func 519 R(8) 8 scalar MPI_WTIME Func 519 R(8) 8 scalar MPI_WTIME_IS_GLOBAL Param 263 I(4) 4 scalar MSKINI Local 2177 L(4) 4 scalar 2177,2180 NAPROC Local 2274 I(4) 4 scalar PTR 2274,2275,2335,2336 NAPROC Local 2285 I(4) 4 scalar 2285,2286,2357,2358 NBI Local 1165 I(4) 4 scalar PTR 1165 NBI2S Local 1417 I(4) 4 2 1 PTR 1417,1418,1419,1420 NEWVAL Local 988 R(4) 4 scalar NIDST Local 1003 I(4) 4 scalar NINT Func 1760 scalar 1760,1761,1762,1763,2040,2041,2042 ,2043 Page 62 Source Listing WMGHGH 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References NISRC Local 1004 I(4) 4 scalar NIT Local 966 I(4) 4 scalar 2197,2216 NJDST Local 1003 I(4) 4 scalar NJSRC Local 1004 I(4) 4 scalar NLMAX Local 967 I(4) 4 scalar 1549,1644,1672,1674,1679,1680,1682 ,1683,1686,1687,2057 NLOC Local 983 I(4) 4 scalar 2100,2102,2107,2108,2124,2126,2149 NLOC_OM Local 984 I(4) 4 scalar 2046,2055,2057,2061,2063,2067,2068 ,2100,2102,2149 NMPERR Local 1051 I(4) 4 scalar 1051,1100,1112,1166,1178,1196,1240 ,1860,1865,1870,1875,1880,2058,210 1,2114,2125 NMPROC Local 1056 I(4) 4 scalar 1056,1288 NR0 Local 983 I(4) 4 scalar 1859,1861,1893,1910,2334,2349,2350 ,2351,2354,2380,2381 NR0_OM Local 984 I(4) 4 scalar 1783,1798,1859,1861,1893 NR1 Local 983 I(4) 4 scalar 1864,1866,1894,1910,1917 NR1_OM Local 984 I(4) 4 scalar 1788,1811,1864,1866,1894 NR2 Local 983 I(4) 4 scalar 1869,1871,1895,1910,1917 NR2_OM Local 984 I(4) 4 scalar 1790,1821,1869,1871,1895 NRAVG Local 1065 I(4) 4 1 1 PTR 1065,2305,2349 NRC1 Local 1072 I(4) 4 scalar 1072,2298 NREC Local 1064 I(4) 4 scalar 1064,1071,2297,2303,2304,2305,2306 ,2308,2310,2314 NRGRD Local 1061 I(4) 4 scalar 1061,1062,1088,1144,1288,1289,1295 ,2302 NRL Local 983 I(4) 4 scalar 1874,1876,1896,1910 NRL_OM Local 984 I(4) 4 scalar 1785,1808,1874,1876,1896 NROK Local 967 I(4) 4 scalar 1718,1922,1928,2139 NRQ Local 978 I(4) 4 scalar NRTOT Local 967 I(4) 4 scalar 1677,2002,2003,2004,2005,2006,2007 ,2021,2023,2061,2063,2067,2068,210 9,2112,2118,2239,2269,2330 NSEA Local 2387 I(4) 4 scalar PTR 2387 NSMX Local 1075 I(4) 4 scalar 1075,2280,2307,2309,2311,2313 NSN1 Local 1074 I(4) 4 scalar 1074,2290,2291 NSND Local 1068 I(4) 4 scalar 1068,1073,2289,2316,2317,2327 NSPEC Local 2312 I(4) 4 scalar 2312 NTOT Local 1070 I(4) 4 scalar 1070,2272 NTRI Local 1570 I(4) 4 scalar 1570,1610 NX Local 1181 I(4) 4 scalar PTR 1181,1186,1194,1198,1213,1316,1449 ,1507,1521,1679,1680,1682,1683,168 4,1706,2162,2176,2178,2193,2194,21 95,2200,2213,2228,2229,2230 NX Local 1494 I(4) 4 scalar 1494,1765 NX_BEG Local 977 I(4) 4 1 1 ALC 1056,1185,1190,1217,2421 NX_END Local 977 I(4) 4 1 1 ALC 1056,1186,1190,1217,2421 NX_REM Local 978 I(4) 4 scalar NY Local 1181 I(4) 4 scalar PTR 1181,1201,1214,1218,1316,1451,1523 ,1679,1680,1682,1683,1684,1703,216 3,2176,2178,2219 NY Local 1497 I(4) 4 scalar 1497,1766 OLD_METHOD Local 1031 L(4) 4 scalar 1031,1106,1438,1678,1744,2016,2406 OUTPTS Local 2285 RECORD 5960 1 1 ALC,TGT 2285,2286,2357,2358 PMPI_WTICK Func 520 R(8) 8 scalar Page 63 Source Listing WMGHGH 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References PMPI_WTIME Func 520 R(8) 8 scalar RADIUS Param 1136 R(4) 4 scalar 1136 REAL Func 1494 scalar 1494,1497,2048,2052,2053 RLGTYPE Param 1089 I(4) 4 scalar 1089,1563,1603 SGRDS Local 2312 RECORD 1080 1 1 ALC,TGT 2312 SHGH Local 1067 R(4) 4 3 1 PTR 1067,2312 SIG Local 1203 R(4) 4 1 1 PTR 1203,2007 SIZE Func 1417 scalar 1417 STMASK Local 995 L(4) 4 2 1 ALC 2176,2193,2194,2195,2220,2221,2222 ,2223,2224,2228,2229,2230,2242,224 3,2252 STX Local 988 R(4) 4 scalar STXY Local 988 R(4) 4 scalar STY Local 988 R(4) 4 scalar SX Local 1493 R(4) 4 scalar 1493,1495,1564,1604,1751,1752,1754 ,1755,2027,2028,2030,2031 SX Local 1513 R(4) 4 scalar PTR 1513,1514,1751,1752,1754,1755,2027 ,2028,2030,2031 SY Local 1496 R(4) 4 scalar 1496,1498,1565,1605,1757,1758,2033 ,2034 SY Local 1517 R(4) 4 scalar PTR 1517,1518,1757,1758,2033,2034 T38 Local 1019 L(4) 4 scalar 1019 TAG Local 978 I(4) 4 scalar TMPINT Local 980 I(4) 4 2 1 ALC 1682,2003,2004,2005,2006,2021,2109 ,2150,2240,2241,2271,2273,2280,228 3,2284,2332,2333,2334,2356,2403 TMPINT_OM Local 980 I(4) 4 2 1 ALC 1679,2021,2061,2067,2109,2150,2406 TMPLOG Local 995 L(4) 4 1 1 ALC 1684,2242,2278,2290,2339,2364,2404 TMPRL Local 981 R(4) 4 2 1 ALC 1683,2007,2023,2112,2118,2151,2350 ,2404 TMPRL_OM Local 981 R(4) 4 2 1 ALC 1680,2023,2063,2068,2112,2118,2151 ,2406 TRIGP Local 1577 I(4) 4 2 1 PTR 1577,1578,1617,1618 UNGTYPE Param 1446 I(4) 4 scalar 1446,1480 W3DIST Local 937 scalar 937,1221,1579,1619 W3DIST_R4 Func 1221 R(4) 4 scalar PRIV 1221 W3DIST_R8 Func 1579 R(8) 8 scalar PRIV 1579,1619 W3GDATMD Module 939 939 W3GSRUMD Module 937 937 W3ODATMD Module 940 940 W3SERVMD Module 936 936 W3SETG Subr 1148 1148,1313 W3SETO Subr 1147 1147,1312 WGTH Local 1067 R(4) 4 2 1 PTR 1067,2310,2350 WMGHGH Subr 826 WMMDATMD Module 941 941 WMSETM Subr 1149 1149,1314 WTOT Local 990 R(4) 4 scalar 2045,2054,2069 WX Local 990 R(4) 4 scalar 2048,2054,2063 WXWY Local 1002 R(4) 4 scalar WY Local 990 R(4) 4 scalar 2052,2054,2063 X0 Local 1493 R(4) 4 scalar 1493,1494,1750,1754,1755,2026,2030 ,2031 X0 Local 1513 R(4) 4 scalar PTR 1513,1514 XA Local 989 R(4) 4 scalar 1712,1750,1754,1755,2026,2030,2031 Page 64 Source Listing WMGHGH 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References XDST Local 1000 R(4) 4 scalar XGRD Local 1221 R(4) 4 2 1 PTR 1221,1222,1712 XGRD Local 1486 R(4) 4 2 1 PTR 1486,1488 XH Local 989 R(4) 4 scalar 1488,1494,1514,1752,1755,1761,2028 ,2031,2041,2048 XL Local 989 R(4) 4 scalar 1486,1493,1513,1751,1754,1760,2027 ,2030,2040,2048 XSRC Local 1001 R(4) 4 scalar XYB Local 1579 R(8) 8 2 1 PTR 1579,1580,1581,1619,1620,1621 Y0 Local 1496 R(4) 4 scalar 1496,1497,1757,1758,2033,2034 Y0 Local 1517 R(4) 4 scalar PTR 1517,1518 YA Local 989 R(4) 4 scalar 1713,1757,1758,2033,2034 YDST Local 1000 R(4) 4 scalar YGRD Local 1222 R(4) 4 2 1 PTR 1222,1223,1713 YGRD Local 1487 R(4) 4 2 1 PTR 1487,1489 YH Local 989 R(4) 4 scalar 1489,1497,1518,1758,1763,2034,2043 ,2052 YL Local 989 R(4) 4 scalar 1487,1496,1517,1757,1762,2033,2042 ,2053 YSRC Local 1001 R(4) 4 scalar Page 65 Source Listing WMGHGH 2014-09-16 16:48 wmgridmd.f90 3522 !/ ------------------------------------------------------------------- / 3523 SUBROUTINE WMGEQL 3524 !/ 3525 !/ +-----------------------------------+ 3526 !/ | WAVEWATCH III NOAA/NCEP | 3527 !/ | H. L. Tolman | 3528 !/ | FORTRAN 90 | 3529 !/ | Last update : 05-Aug-2013 | 3530 !/ +-----------------------------------+ 3531 !/ 3532 !/ 24-Apr-2006 : Origination. ( version 3.09 ) 3533 !/ 23-Dec-2006 : Adding group test. ( version 3.10 ) 3534 !/ 28-Dec-2006 : Simplify NIT for partial comm. ( version 3.10 ) 3535 !/ 22-Jan-2007 : Add saving og NAVMAX. ( version 3.10 ) 3536 !/ 02-Feb-2007 : Setting FLAGST for replaced points. ( version 3.10 ) 3537 !/ 15-Feb-2007 : Tweaking MAPODI algorithm in WMGEQL.( version 3.10 ) 3538 !/ 11-Apr-2008 : Big fix active edges (MAPSTA=2) ( version 3.13 ) 3539 !/ 14-Apr-2008 : Big fix for global grids. ( version 3.13 ) 3540 !/ 20-May-2009 : Linking FLAGST and FLGHG1. ( version 3.14 ) 3541 !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 ) 3542 !/ (W. E. Rogers & T. J. Campbell, NRL) 3543 !/ 06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to 3544 !/ specify index closure for a grid. ( version 3.14 ) 3545 !/ (T. J. Campbell, NRL) 3546 !/ 23-Dec-2010 : Fix HPFAC and HQFAC by including the COS(YGRD) 3547 !/ factor with DXDP and DXDQ terms. ( version 3.14 ) 3548 !/ (T. J. Campbell, NRL) 3549 !/ 05-Aug-2013 : Change PR2/3 to UQ/UNO in distances.( version 4.12 ) 3550 !/ 3551 ! 1. Purpose : 3552 ! 3553 ! Determine relations to same ranked grids for each grid. 3554 ! 3555 ! 2. Method : 3556 ! 3557 ! Cross mapping of grid points, determine boundary distance data 3558 ! and interpolation weights. 3559 ! 3560 ! 3. Parameters : 3561 ! 3562 ! 4. Subroutines used : 3563 ! 3564 ! Name Type Module Description 3565 ! ---------------------------------------------------------------- 3566 ! W3SETG, W3SETO, WMSETM 3567 ! Subr. W3GDATMD Manage data structures. 3568 ! STRACE Subr. W3SERVMD Subroutine tracing. 3569 ! EXTCDE Subr. Id. Program abort. 3570 ! ---------------------------------------------------------------- 3571 ! 3572 ! 5. Called by : 3573 ! 3574 ! 6. Error messages : 3575 ! 3576 ! 7. Remarks : 3577 ! 3578 ! - In looking for compatable boundary points in overlapping grids Page 66 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 3579 ! two assumptions hav been made. 3580 ! a) No active boundary points exist in global grids. 3581 ! b) For a lower resolution grid an expanded sewarch area is 3582 ! required for corresponding active grid points. By limiting 3583 ! the resolution ratio to 2, only one extra grid point needs 3584 ! to be considered (JXL2 versus JXL etc.). 3585 ! 3586 ! 8. Structure : 3587 ! 3588 ! 9. Switches : 3589 ! 3590 ! !/PRn Propagation scheme. 3591 ! 3592 ! !/O12 Removed boundary points output (central). 3593 ! !/O13 Removed boundary points output (edge). 3594 3595 ! !/S Enable subroutine tracing. 3596 ! !/T Enable test output. 3597 ! !/T5 Detailed test output 'receiving'. 3598 ! !/T6 Detailed test output 'sending'. 3599 ! !/T7 Detailed test output all. 3600 ! 3601 ! !/MPI Distribbuted memory management. 3602 ! 3603 ! 10. Source code : 3604 ! 3605 !/ ------------------------------------------------------------------- / 3606 ! 3607 USE CONSTANTS 3608 USE W3GDATMD 3609 USE W3ODATMD 3610 USE W3ADATMD 3611 USE WMMDATMD 3612 ! 3613 USE W3SERVMD, ONLY: EXTCDE 3614 ! 3615 IMPLICIT NONE 3616 !/ 3617 !/ ------------------------------------------------------------------- / 3618 !/ Parameter list 3619 !/ 3620 !/ ------------------------------------------------------------------- / 3621 !/ Local parameters 3622 !/ 3623 INTEGER :: I, J, IX, IXL, IXH, IY, IYL, IYH, & 3624 JX, JXL, JXH, JXL2, JXH2, & 3625 JY, JYL, JYH, JYL2, JYH2, & 3626 NR, NT, NA, NTL, JJ, NIT, NG, NOUT, & 3627 ISEA, JSEA, ISPROC, ITAG, TGRP, & 3628 EXTRA, IP, NP 3629 INTEGER, ALLOCATABLE :: MAP3D(:,:,:), NREC(:), NSND(:), & 3630 NTPP(:), MAPOUT(:,:) 3631 REAL :: FACTOR, XSL, XSH, YSL, YSH, XA, YA, & 3632 XR, YR, RX(2), RY(2), STX, STY, & 3633 STXY, NEWVAL, WGTH 3634 REAL, PARAMETER :: TODO = -9.99E25 3635 REAL, PARAMETER :: ODIMAX = 25. Page 67 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 3636 REAL, PARAMETER :: FACMAX = 2.001 3637 REAL, ALLOCATABLE :: WGT3D(:,:,:) 3638 LOGICAL :: CHANGE, XEXPND, YEXPND 3639 LOGICAL, ALLOCATABLE :: SHRANK(:,:), DOGRID(:), & 3640 MASKA(:,:), MASKI(:,:) 3641 ! 3642 TYPE STORE 3643 INTEGER :: NTOT, NFIN 3644 INTEGER, POINTER :: IX(:), IY(:), NAV(:), ISS(:,:), & 3645 JSS(:,:), IPS(:,:), ITG(:,:) 3646 REAL, POINTER :: AWG(:,:) 3647 LOGICAL, POINTER :: FLA(:) 3648 LOGICAL :: INIT 3649 END TYPE STORE 3650 ! 3651 TYPE(STORE), ALLOCATABLE :: STORES(:,:) 3652 !/ 3653 ! 3654 ! -------------------------------------------------------------------- / 3655 ! 0. Initializations 3656 ! 3657 3658 ALLOCATE ( SHRANK(NRGRD,NRGRD), STORES(NRGRD,NRGRD), & 3659 DOGRID(NRGRD) ) 3660 ! 3661 SHRANK = .FALSE. 3662 ! 3663 DO I=1, NRGRD 3664 3665 DO J=1, NRGRD 3666 STORES(I,J)%INIT = .FALSE. 3667 STORES(I,J)%NTOT = 0 3668 STORES(I,J)%NFIN = 0 3669 END DO 3670 END DO 3671 ! 3672 IF ( FLAGLL ) THEN 3673 FACTOR = RADIUS * DERA 3674 !notes: was FACTOR = RADIUS / 360. (I don't know where this came from.... 3675 ! ...maybe it was supposed to be CIRCUMFERENCE/360) 3676 ELSE 3677 FACTOR = 1. 3678 END IF 3679 ITAG = 0 3680 ! 3681 ! -------------------------------------------------------------------- / 3682 ! 1. Grid point relations and temp data storage 3683 ! 1.a Outer loop over all grids 3684 ! 3685 DO I=1, NRGRD 3686 3687 ! 3688 ! 1.b Find grids with same rank 3689 ! 3690 NR = 0 3691 ! 3692 DO J=1, NRGRD Page 68 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 3693 3694 IF ( GRANK(I).NE.GRANK(J) .OR. I.EQ.J ) CYCLE 3695 SHRANK(I,J) = .TRUE. 3696 NR = NR + 1 3697 END DO 3698 ! 3699 CALL W3SETG ( I, MDSE, MDST ) 3700 ! 3701 DOGRID(I) = NR .GT. 0 3702 3703 !..notes: we will reach this point even if there are no equal rank grids 3704 3705 IF ( NR .EQ. 0 ) CYCLE 3706 3707 !..notes: we will not reach this point if are no equal rank grids. that makes it a good place to check against grid type 3708 3709 IF ( GTYPE .EQ. UNGTYPE ) THEN 3710 IF ( IMPROC.EQ.NMPERR )WRITE (MDSE,'(/2A)') ' *** ERROR WMGEQL: ', & 3711 'UNSTRUCTURED GRID SUPPORT NOT YET IMPLEMENTED ***' 3712 CALL EXTCDE ( 999 ) 3713 END IF 3714 IF ( GTYPE .EQ. CLGTYPE ) THEN 3715 IF ( IMPROC.EQ.NMPERR )WRITE (MDSE,'(/2A)') ' *** ERROR WMGEQL: ', & 3716 'CURVILINEAR GRID SUPPORT NOT IMPLEMENTED FOR NRGRD > 1 ***' 3717 CALL EXTCDE ( 999 ) 3718 END IF 3719 3720 ! 3721 ! 1.c Fill TMPMAP with raw relational data 3722 ! 3723 ! 1.c.1 Loop over grids, select same rank 3724 ! 3725 DO J=1, NRGRD 3726 3727 IF ( .NOT. SHRANK(I,J) ) CYCLE 3728 ! 3729 ! 1.c.2 Determine shared area 3730 ! Don't even try for X in LLG 3731 ! 3732 3733 ! Note: Check is against FLAGLL. Would it be more appropriate 3734 ! to check against ICLOSE? 3735 IF ( FLAGLL ) THEN 3736 IXL = 1 3737 IXH = NX 3738 ELSE 3739 XSL = ( GRIDS(J)%X0 - X0 ) / SX - 0.01 3740 XSH = ( GRIDS(J)%X0 + GRIDS(J)%SX*(GRIDS(J)%NX-1) & 3741 - X0 ) / SX + 0.01 3742 IXL = MAX ( 1+NINT(XSL) , 1 ) 3743 IXH = MIN ( 1+NINT(XSH) , NX ) 3744 END IF 3745 ! 3746 YSL = ( GRIDS(J)%Y0 - Y0 ) / SY - 0.01 3747 YSH = ( GRIDS(J)%Y0 + GRIDS(J)%SY*(GRIDS(J)%NY-1) & 3748 - Y0 ) / SY + 0.01 3749 IYL = MAX ( 1+NINT(YSL) , 1 ) Page 69 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 3750 IYH = MIN ( 1+NINT(YSH) , NY ) 3751 ! 3752 NT = (1+IXH-IXL) * (1+IYH-IYL) 3753 IF ( NT .EQ. 0 ) CYCLE 3754 ! 3755 STORES(I,J)%INIT = .TRUE. 3756 ALLOCATE ( STORES(I,J)%IX(NT) , STORES(I,J)%IY(NT) , & 3757 STORES(I,J)%NAV(NT) , STORES(I,J)%FLA(NT) , & 3758 STORES(I,J)%ISS(NT,4), STORES(I,J)%JSS(NT,4), & 3759 STORES(I,J)%IPS(NT,4), STORES(I,J)%ITG(NT,4), & 3760 STORES(I,J)%AWG(NT,4) ) 3761 STORES(I,J)%NAV = 0 3762 STORES(I,J)%FLA = .FALSE. 3763 STORES(I,J)%ISS = 0 3764 STORES(I,J)%JSS = 0 3765 STORES(I,J)%IPS = 0 3766 STORES(I,J)%ITG = 0 3767 STORES(I,J)%AWG = 0. 3768 ! 3769 ! 1.c.3 Loops over shared area 3770 ! 3771 NT = 0 3772 ! 3773 XEXPND = SX .GT. GRIDS(J)%SX 3774 YEXPND = SY .GT. GRIDS(J)%SY 3775 ! 3776 DO IX=IXL, IXH 3777 XA = X0 + REAL(IX-1)*SX 3778 IF ( FLAGLL ) THEN 3779 XR = 1. + MOD (1080. + XA - GRIDS(J)%X0 , 360. ) & 3780 / GRIDS(J)%SX 3781 ELSE 3782 XR = 1. + (XA-GRIDS(J)%X0) / GRIDS(J)%SX 3783 END IF 3784 JXL = INT(XR) 3785 JXH = JXL + 1 3786 RX(1) = 1. - MOD(XR,1.) 3787 IF ( RX(1).GT.0.99 .OR. JXH.EQ.GRIDS(J)%NX+1 ) THEN 3788 JXH = JXL 3789 RX(1) = 1. 3790 END IF 3791 IF ( RX(1).LT.0.01 .OR. JXL.EQ.0 ) THEN 3792 JXL = JXH 3793 RX(1) = 1. 3794 END IF 3795 RX(2) = 1. - RX(1) 3796 ! 3797 IF ( JXL.LT.1 .OR. JXH.GT.GRIDS(J)%NX ) CYCLE 3798 ! 3799 IF ( XEXPND ) THEN 3800 JXL2 = MAX ( 1 , JXL-1 ) 3801 JXH2 = MIN ( GRIDS(J)%NX , JXH+1 ) 3802 ELSE 3803 JXL2 = JXL 3804 JXH2 = JXH 3805 END IF 3806 ! Page 70 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 3807 DO IY=IYL, IYH 3808 YA = Y0 + REAL(IY-1)*SY 3809 YR = 1. + (YA-GRIDS(J)%Y0) / GRIDS(J)%SY 3810 JYL = INT(YR) 3811 JYH = JYL + 1 3812 RY(1) = 1. - MOD(YR,1.) 3813 IF ( RY(1).GT.0.99 .OR. JYH.EQ.GRIDS(J)%NY+1 ) THEN 3814 JYH = JYL 3815 RY(1) = 1. 3816 END IF 3817 IF ( RY(1).LT.0.01 .OR. JYL.EQ.0 ) THEN 3818 JYL = JYH 3819 RY(1) = 1. 3820 END IF 3821 IF ( RY(1) .GT. 0.99 ) JYH = JYL 3822 RY(2) = 1. - RY(1) 3823 ! 3824 IF ( JYL.LT.1 .OR. JYH.GT.GRIDS(J)%NY ) CYCLE 3825 ! 3826 IF ( YEXPND ) THEN 3827 JYL2 = MAX ( 1 , JYL-1 ) 3828 JYH2 = MIN ( GRIDS(J)%NY , JYH+1 ) 3829 ELSE 3830 JYL2 = JYL 3831 JYH2 = JYH 3832 END IF 3833 ! 3834 ! 1.c.4 Temp storage of raw data 3835 ! 3836 NT = NT + 1 3837 NA = 0 3838 STORES(I,J)%IX(NT) = IX 3839 STORES(I,J)%IY(NT) = IY 3840 ! 3841 DO JX = JXL, JXH 3842 DO JY = JYL, JYH 3843 IF ( GRIDS(J)%MAPSTA(JY,JX) .NE. 0 ) THEN 3844 NA = NA + 1 3845 ITAG = ITAG + 1 3846 WGTH = RX(1+JX-JXL) * RY(1+JY-JYL) 3847 ISEA = GRIDS(J)%MAPFS(JY,JX) 3848 IF ( ISEA .EQ. 0 ) THEN 3849 JSEA = 0 3850 ISPROC = 1 3851 ELSE 3852 JSEA = 1 + (ISEA-1)/OUTPTS(J)%NAPROC 3853 ISPROC = ISEA - & 3854 (JSEA-1)*OUTPTS(J)%NAPROC & 3855 + MDATAS(J)%CROOT - 1 3856 END IF 3857 STORES(I,J)%AWG(NT,NA) = WGTH 3858 STORES(I,J)%ISS(NT,NA) = ISEA 3859 STORES(I,J)%JSS(NT,NA) = JSEA 3860 STORES(I,J)%IPS(NT,NA) = ISPROC 3861 STORES(I,J)%ITG(NT,NA) = ITAG 3862 END IF 3863 END DO Page 71 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 3864 END DO 3865 ! 3866 DO JX = JXL2, JXH2 3867 DO JY = JYL2, JYH2 3868 IF ( ABS(GRIDS(J)%MAPSTA(JY,JX)) .EQ. 2 ) & 3869 STORES(I,J)%FLA(NT) = .TRUE. 3870 END DO 3871 END DO 3872 ! 3873 WGTH = SUM ( STORES(I,J)%AWG(NT,1:NA) ) 3874 IF ( WGTH .LT. 0.499 ) THEN 3875 NA = 0 3876 ELSE 3877 STORES(I,J)%AWG(NT,:) = STORES(I,J)%AWG(NT,:) / WGTH 3878 END IF 3879 ! 3880 STORES(I,J)%NAV(NT) = NA 3881 ! 3882 ! ... End of loops in 1.c 3883 ! 3884 END DO 3885 END DO 3886 ! 3887 STORES(I,J)%NTOT = NT 3888 ! 3889 END DO 3890 ! 3891 ! -------------------------------------------------------------------- / 3892 ! 2. Generate open edge distance maps 3893 ! 2.a Base map based on MAPSTA only, time step not included. 3894 ! 3895 ALLOCATE ( MDATAS(I)%MAPODI(NY,NX) ) 3896 MAPODI => MDATAS(I)%MAPODI 3897 MAPODI = 0. 3898 ! 3899 DO IX=1, NX 3900 DO IY=1, NY 3901 IF ( ABS(MAPSTA(IY,IX)) .EQ. 1 ) THEN 3902 MAPODI(IY,IX) = TODO 3903 ELSE IF ( ABS(MAPSTA(IY,IX)) .EQ. 2 ) THEN 3904 MAPODI(IY,IX) = -2. / SIG(1) * DTMAX 3905 ELSE 3906 MAPODI(IY,IX) = -1. / SIG(1) * DTMAX 3907 END IF 3908 END DO 3909 END DO 3910 ! 3911 ! 2.b Add in cross-grid information from STORES 3912 ! 3913 ALLOCATE ( MASKA(NY,NX) ) 3914 MASKA = .FALSE. 3915 ! 3916 DO J=1, NRGRD 3917 IF ( .NOT. SHRANK(I,J) ) CYCLE 3918 DO JJ=1, STORES(I,J)%NTOT 3919 IX = STORES(I,J)%IX(JJ) 3920 IY = STORES(I,J)%IY(JJ) Page 72 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 3921 IF ( IX.EQ.1 .OR. IX.EQ.NX .OR. IY.EQ.1 .OR. IY.EQ.NY ) THEN 3922 MASKA(IY,IX) = STORES(I,J)%FLA(JJ) .OR. & 3923 STORES(I,J)%NAV(JJ).EQ.0 3924 IF ( ABS(MAPSTA(IY,IX)).EQ.2 .AND. & 3925 .NOT.STORES(I,J)%FLA(JJ) .AND. & 3926 STORES(I,J)%NAV(JJ).GT.0 ) THEN 3927 MAPODI(IY,IX) = 0. 3928 END IF 3929 ELSE 3930 MASKA(IY,IX) = STORES(I,J)%FLA(JJ) 3931 END IF 3932 IF ( MAPSTA(IY,IX).EQ.0 .AND. MAPST2(IY,IX) .EQ.1 .AND. & 3933 STORES(I,J)%NAV(JJ).GT.0 ) MAPODI(IY,IX) = 0. 3934 END DO 3935 END DO 3936 ! 3937 ! 2.c Remove incompatable boundary points 3938 ! 3939 ALLOCATE ( MASKI(NY,NX) ) 3940 MASKI = .FALSE. 3941 ! 3942 DO IX=2, NX-1 3943 DO IY=2, NY-1 3944 IF ( ABS(MAPSTA(IY,IX)) .EQ. 2 .AND. & 3945 .NOT. MASKA(IY,IX) .AND. ( & 3946 MAPODI(IY-1,IX ) .GE. 0. .OR. & 3947 MAPODI(IY+1,IX ) .GE. 0. .OR. & 3948 MAPODI(IY ,IX-1) .GE. 0. .OR. & 3949 MAPODI(IY ,IX+1) .GE. 0. ) ) THEN 3950 MASKI(IY,IX) = .TRUE. 3951 END IF 3952 END DO 3953 END DO 3954 ! 3955 DEALLOCATE ( MASKA ) 3956 ! 3957 DO IX=1, NX 3958 DO IY=1, NY 3959 IF ( MASKI(IY,IX) ) MAPODI(IY,IX) = 0. 3960 END DO 3961 END DO 3962 ! 3963 ! 2.d Mask out influenced edge 3964 ! 3965 NIT = ( 1 + INT(DTMAX/DTCFL-0.001) ) * 3 3966 ! 3967 IF ( ICLOSE.NE.ICLOSE_NONE ) THEN 3968 IXL = 1 3969 IXH = NX 3970 ELSE 3971 IXL = 2 3972 IXH = NX - 1 3973 END IF 3974 ! 3975 DO J=1, NIT 3976 ! 3977 MASKI = .FALSE. Page 73 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 3978 ! 3979 DO IX=IXL, IXH 3980 IF ( IX .EQ. 1 ) THEN 3981 JXL = NX 3982 JXH = 2 3983 ELSE IF ( IX .EQ. NX ) THEN 3984 JXL = NX - 1 3985 JXH = 1 3986 ELSE 3987 JXL = IX - 1 3988 JXH = IX + 1 3989 END IF 3990 ! 3991 DO IY=2, NY-1 3992 IF ( MAPODI(IY,IX) .EQ. TODO .AND. ( & 3993 MAPODI(IY+1,IX ) .GE. 0. .OR. & 3994 MAPODI(IY ,JXL) .GE. 0. .OR. & 3995 MAPODI(IY-1,IX ) .GE. 0. .OR. & 3996 MAPODI(IY ,JXH) .GE. 0. .OR. & 3997 ( MAPODI(IY+1,JXH) .GE. 0. .AND. .NOT. & 3998 ( MAPSTA(IY+1,IX ) .NE. 1 .AND. & 3999 MAPSTA(IY ,JXH) .NE. 1 ) ) .OR. & 4000 ( MAPODI(IY+1,JXL) .GE. 0. .AND. .NOT. & 4001 ( MAPSTA(IY+1,IX ) .NE. 1 .AND. & 4002 MAPSTA(IY ,JXL) .NE. 1 ) ) .OR. & 4003 ( MAPODI(IY-1,JXL) .GE. 0. .AND. .NOT. & 4004 ( MAPSTA(IY-1,IX ) .NE. 1 .AND. & 4005 MAPSTA(IY ,JXL) .NE. 1 ) ) .OR. & 4006 ( MAPODI(IY-1,JXH) .GE. 0. .AND. .NOT. & 4007 ( MAPSTA(IY-1,IX ) .NE. 1 .AND. & 4008 MAPSTA(IY ,JXH) .NE. 1 ) ) ) ) & 4009 MASKI(IY,IX) = .TRUE. 4010 END DO 4011 ! 4012 END DO 4013 ! 4014 DO IX=IXL, IXH 4015 DO IY=2, NY-1 4016 IF ( MASKI(IY,IX) ) MAPODI(IY,IX) = 0. 4017 END DO 4018 END DO 4019 ! 4020 END DO 4021 ! 4022 ! 2.e Compute distances 4023 ! 4024 DO 4025 MASKI = .FALSE. 4026 ! 4027 DO IX=IXL, IXH 4028 IF ( IX .EQ. 1 ) THEN 4029 JXL = NX 4030 JXH = 2 4031 ELSE IF ( IX .EQ. NX ) THEN 4032 JXL = NX - 1 4033 JXH = 1 4034 ELSE Page 74 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 4035 JXL = IX - 1 4036 JXH = IX + 1 4037 END IF 4038 DO IY=2, NY-1 4039 IF ( MAPODI(IY,IX) .EQ. TODO .AND. ( & 4040 MAPODI(IY+1,IX ) .GE. 0. .OR. & 4041 MAPODI(IY-1,IX ) .GE. 0. .OR. & 4042 MAPODI(IY ,JXH) .GE. 0. .OR. & 4043 MAPODI(IY ,JXL) .GE. 0. .OR. & 4044 ( MAPODI(IY+1,JXH) .GE. 0. .AND. .NOT. & 4045 ( MAPSTA(IY+1,IX ) .NE. 1 .AND. & 4046 MAPSTA(IY ,JXH) .NE. 1 ) ) .OR. & 4047 ( MAPODI(IY+1,JXL) .GE. 0. .AND. .NOT. & 4048 ( MAPSTA(IY+1,IX ) .NE. 1 .AND. & 4049 MAPSTA(IY ,JXL) .NE. 1 ) ) .OR. & 4050 ( MAPODI(IY-1,JXL) .GE. 0. .AND. .NOT. & 4051 ( MAPSTA(IY-1,IX ) .NE. 1 .AND. & 4052 MAPSTA(IY ,JXL) .NE. 1 ) ) .OR. & 4053 ( MAPODI(IY-1,JXH) .GE. 0. .AND. .NOT. & 4054 ( MAPSTA(IY-1,IX ) .NE. 1 .AND. & 4055 MAPSTA(IY ,JXH) .NE. 1 ) ) ) ) & 4056 MASKI(IY,IX) = .TRUE. 4057 END DO 4058 END DO 4059 ! 4060 CHANGE = .FALSE. 4061 DO IY=2, NY-1 4062 DO IX=IXL, IXH 4063 IF ( IX .EQ. 1 ) THEN 4064 JXL = NX 4065 JXH = 2 4066 ELSE IF ( IX .EQ. NX ) THEN 4067 JXL = NX - 1 4068 JXH = 1 4069 ELSE 4070 JXL = IX - 1 4071 JXH = IX + 1 4072 END IF 4073 ISEA = MAPFS(IY,IX) 4074 STY = FACTOR * HQFAC(IY,IX) / ( 0.58 * GRAV ) 4075 STX = FACTOR * HPFAC(IY,IX) & 4076 / ( 0.58 * GRAV ) 4077 STXY = SQRT ( STX**2 + STY**2 ) 4078 IF ( MASKI(IY,IX) ) THEN 4079 NEWVAL = ODIMAX / SIG(1) * DTMAX 4080 IF ( MAPODI(IY+1,IX ).GE.0. .AND. .NOT. & 4081 MASKI (IY+1,IX ) ) NEWVAL = MIN ( & 4082 NEWVAL , MAPODI(IY+1,IX )+STY ) 4083 IF ( MAPODI(IY-1,IX ).GE.0. .AND. .NOT. & 4084 MASKI (IY-1,IX ) ) NEWVAL = MIN ( & 4085 NEWVAL , MAPODI(IY-1,IX )+STY ) 4086 IF ( MAPODI(IY ,JXH).GE.0. .AND. .NOT. & 4087 MASKI (IY ,JXH) ) NEWVAL = MIN ( & 4088 NEWVAL , MAPODI(IY ,JXH)+STX) 4089 IF ( MAPODI(IY ,JXL).GE.0. .AND. .NOT. & 4090 MASKI (IY ,JXL) ) NEWVAL = MIN ( & 4091 NEWVAL , MAPODI(IY ,JXL)+STX) Page 75 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 4092 IF ( MAPODI(IY+1,JXH).GE.0. .AND. .NOT. & 4093 ( MAPSTA(IY+1,IX ) .NE. 1 .AND. & 4094 MAPSTA(IY ,JXH) .NE. 1 ) ) NEWVAL = & 4095 MIN ( NEWVAL , MAPODI(IY+1,JXH)+STXY) 4096 IF ( MAPODI(IY+1,JXL).GE.0. .AND. .NOT. & 4097 ( MAPSTA(IY+1,IX ) .NE. 1 .AND. & 4098 MAPSTA(IY ,JXL) .NE. 1 ) ) NEWVAL = & 4099 MIN ( NEWVAL , MAPODI(IY+1,JXL)+STXY) 4100 IF ( MAPODI(IY-1,JXL).GE.0. .AND. .NOT. & 4101 ( MAPSTA(IY-1,IX ) .NE. 1 .AND. & 4102 MAPSTA(IY ,JXL) .NE. 1 ) ) NEWVAL = & 4103 MIN ( NEWVAL , MAPODI(IY-1,JXL)+STXY) 4104 IF ( MAPODI(IY-1,JXH).GE.0. .AND. .NOT. & 4105 ( MAPSTA(IY-1,IX ) .NE. 1 .AND. & 4106 MAPSTA(IY ,JXH) .NE. 1 ) ) NEWVAL = & 4107 MIN ( NEWVAL , MAPODI(IY-1,JXH)+STXY) 4108 MAPODI(IY,IX) = NEWVAL 4109 CHANGE = .TRUE. 4110 END IF 4111 END DO 4112 END DO 4113 ! 4114 IF ( .NOT. CHANGE ) EXIT 4115 END DO 4116 ! 4117 DO IX=2, NX-1 4118 DO IY=2, NY-1 4119 IF ( MAPODI(IY,IX) .EQ. TODO ) & 4120 MAPODI(IY,IX) = 2. * ODIMAX / SIG(1) * DTMAX 4121 END DO 4122 END DO 4123 ! 4124 DEALLOCATE ( MASKI ) 4125 ! 4126 ! 2.f Update FLAGST 4127 ! 4128 DO ISEA=1, NSEA 4129 IX = MAPSF(ISEA,1) 4130 IY = MAPSF(ISEA,2) 4131 IF ( MAPODI(IY,IX) .EQ. 0. ) FLAGST(ISEA) = .NOT. FLGHG1 4132 END DO 4133 ! 4134 ! 2.g Test output 4135 ! 4136 ! ... End of loop in 1.a 4137 ! 4138 END DO 4139 ! 4140 ! -------------------------------------------------------------------- / 4141 ! 3. Final data base (full data base, scratched at end of routine) 4142 ! 3.a Loop over grids 4143 ! 4144 ALLOCATE ( NREC(NRGRD), NSND(NRGRD), NTPP(NMPROC) ) 4145 ! 4146 DO I=1, NRGRD 4147 IF ( .NOT. DOGRID(I) ) CYCLE 4148 ! Page 76 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 4149 CALL W3SETG ( I, MDSE, MDST ) 4150 CALL W3SETO ( I, MDSE, MDST ) 4151 CALL WMSETM ( I, MDSE, MDST ) 4152 ! 4153 ALLOCATE ( MAP3D(NY,NX,-4:NRGRD), WGT3D(NY,NX,0:NRGRD) ) 4154 MAP3D = 0 4155 WGT3D = 0. 4156 NREC = 0 4157 NSND = 0 4158 ! 4159 ! 3.b Filling MAP3D and WGT3D, as well as NREC and NSND 4160 ! 4161 DO J=1, NRGRD 4162 IF ( .NOT. SHRANK(I,J) ) CYCLE 4163 MAPODI => MDATAS(J)%MAPODI 4164 ! 4165 DO JJ=1, STORES(I,J)%NTOT 4166 IX = STORES(I,J)%IX(JJ) 4167 IY = STORES(I,J)%IY(JJ) 4168 WGT3D(IY,IX,0) = MDATAS(I)%MAPODI(IY,IX) 4169 MAP3D(IY,IX,-2) = MAPFS(IY,IX) 4170 IF ( MAP3D(IY,IX,-2) .NE. 0 ) THEN 4171 MAP3D(IY,IX,-3) = 1 + (MAP3D(IY,IX,-2)-1)/NAPROC 4172 MAP3D(IY,IX,-4) = MAP3D(IY,IX,-2) - & 4173 (MAP3D(IY,IX,-3)-1)*NAPROC + CROOT - 1 4174 END IF 4175 IF ( WGT3D(IY,IX,0).GE.0. .AND. MAPSTA(IY,IX).NE.0. .AND. & 4176 STORES(I,J)%NAV(JJ).GT.0 ) THEN 4177 WGT3D(IY,IX,J) = ODIMAX / SIG(1) * DTMAX 4178 DO NA=1, STORES(I,J)%NAV(JJ) 4179 JX = GRIDS(J)%MAPSF(STORES(I,J)%ISS(JJ,NA),1) 4180 JY = GRIDS(J)%MAPSF(STORES(I,J)%ISS(JJ,NA),2) 4181 IF ( MAPODI(JY,JX) .GE. 0. ) WGT3D(IY,IX,J) = & 4182 MIN( WGT3D(IY,IX,J) , MAPODI(JY,JX) ) 4183 END DO 4184 IF ( WGT3D(IY,IX,J) .GT. 0. ) MAP3D(IY,IX,J) = 1 4185 END IF 4186 END DO 4187 ! 4188 STORES(I,J)%NFIN = SUM(MAP3D(:,:,J)) 4189 ! 4190 END DO 4191 ! 4192 MAPODI => MDATAS(I)%MAPODI 4193 DO IX=1, NX 4194 DO IY=1, NY 4195 MAP3D(IY,IX, 0) = MAXVAL(MAP3D(IY,IX,1:)) 4196 MAP3D(IY,IX,-1) = SUM(MAP3D(IY,IX,1:)) 4197 IF ( MAP3D(IY,IX,-1) .GT. 0 ) THEN 4198 IF ( MAPODI(IY,IX)*SIG(1)/DTMAX .GT. 1.5*ODIMAX ) THEN 4199 WGT3D(IY,IX, 0:) = 0. 4200 MAP3D(IY,IX,-1:) = 0 4201 ELSE 4202 WGTH = SUM(WGT3D(IY,IX,:)) 4203 IF ( WGTH .GT. 1.E-25 ) THEN 4204 WGT3D(IY,IX,:) = WGT3D(IY,IX,:) / WGTH 4205 ELSE Page 77 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 4206 WGT3D(IY,IX,:) = 0. 4207 END IF 4208 IF ( MAP3D(IY,IX,-4) .EQ. IMPROC ) THEN 4209 NREC(I) = NREC(I) + 1 4210 DO JJ=1, NRGRD 4211 IF ( MAP3D(IY,IX,JJ) .GT. 0 ) & 4212 NREC(JJ) = NREC(JJ) + 1 4213 END DO 4214 END IF 4215 END IF 4216 END IF 4217 END DO 4218 END DO 4219 ! 4220 DO J=1, NRGRD 4221 IF ( .NOT. SHRANK(I,J) ) CYCLE 4222 DO JJ=1, STORES(I,J)%NTOT 4223 IX = STORES(I,J)%IX(JJ) 4224 IY = STORES(I,J)%IY(JJ) 4225 IF ( MAP3D(IY,IX,J) .NE. 0 ) THEN 4226 DO NA=1, STORES(I,J)%NAV(JJ) 4227 IF ( STORES(I,J)%IPS(JJ,NA) .EQ. IMPROC ) & 4228 NSND(J) = NSND(J) + 1 4229 END DO 4230 END IF 4231 END DO 4232 END DO 4233 ! 4234 NG = MAXVAL(MAP3D(:,:,-1)) 4235 NTL = SUM(MAP3D(:,:,0)) 4236 ! 4237 ! 3.c Check for points with all ODI = 0 4238 ! 4239 MAPODI => MDATAS(I)%MAPODI 4240 NOUT = 0 4241 ! 4242 JXL = NX 4243 JXH = 1 4244 JYL = NY 4245 JYH = 1 4246 ! 4247 ALLOCATE ( MAPOUT(NY,NX) ) 4248 MAPOUT = MAPSTA 4249 ! 4250 DO IX=1, NX 4251 DO IY=1, NY 4252 IF ( ABS(MAPSTA(IY,IX)).EQ. 1 .AND. & 4253 MAPODI(IY,IX) .EQ. 0. .AND. & 4254 MAP3D(IY,IX,-1) .EQ. 0 ) THEN 4255 NOUT = NOUT + 1 4256 IF ( IMPROC.EQ.NMPERR .AND. NOUT.EQ. 1 ) & 4257 WRITE(MDSE,*) ' ' 4258 IF ( IMPROC.EQ.NMPERR .AND. NOUT.LE.25 ) & 4259 WRITE(MDSE,1001) I, IX, IY 4260 IF ( IMPROC.EQ.NMPERR .AND. NOUT.EQ.25 ) & 4261 WRITE(MDSE,1006) 4262 JXL = MIN ( IX, JXL ) Page 78 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 4263 JXH = MAX ( IX, JXH ) 4264 JYL = MIN ( IY, JYL ) 4265 JYH = MAX ( IY, JYH ) 4266 MAPOUT(IY,IX) = 999 4267 END IF 4268 END DO 4269 END DO 4270 ! 4271 ! 3.d Test and error output 4272 ! 4273 IF ( NOUT .GT. 0 ) THEN 4274 IF ( IMPROC.EQ.NMPERR ) THEN 4275 WRITE(MDSE,1000) I, NOUT 4276 EXTRA = 2 4277 JXL = MAX ( 1, JXL - EXTRA ) 4278 JXH = MIN ( NX, JXH + EXTRA ) 4279 JYL = MAX ( 1, JYL - EXTRA ) 4280 JYH = MIN ( NY, JYH + EXTRA ) 4281 WRITE (MDSE,1002) JXL, JXH, JYL, JYH 4282 NP = 1 + (JXH-JXL)/65 4283 DO IP=1, NP 4284 IXL = JXL + (IP-1)*65 4285 IXH = MIN( NX, IXL+64 ) 4286 WRITE (MDSE,1005) IXL, IXH 4287 WRITE (MDSE,1003) 'STATUS MAP MAPSTA' 4288 DO IY=JYH, JYL, -1 4289 WRITE (MDSE,1004) MAPSTA(IY,IXL:IXH) 4290 END DO 4291 WRITE (MDSE,1003) 'MISSING POINTS IN MAPSTA (**)' 4292 DO IY=JYH, JYL, -1 4293 WRITE (MDSE,1004) MAPOUT(IY,IXL:IXH) 4294 END DO 4295 WRITE (MDSE,1003) 'OPEN BOUND. DISTANCE MAP MAPODI' 4296 DO IY=JYH, JYL, -1 4297 WRITE (MDSE,1004) & 4298 NINT(MAPODI(IY,IXL:IXH)*SIG(1)/DTMAX) 4299 END DO 4300 WRITE (MDSE,1003) 'GRID COVERAGE MAP MAP3D' 4301 DO IY=JYH, JYL, -1 4302 WRITE (MDSE,1004) MAP3D(IY,IXL:IXH,-1) 4303 END DO 4304 WRITE (MDSE,*) 4305 END DO 4306 END IF 4307 CALL EXTCDE (1000) 4308 END IF 4309 ! 4310 DEALLOCATE ( MAPOUT ) 4311 ! 4312 ! -------------------------------------------------------------------- / 4313 ! 4. Save data base as needed in EQSTGE 4314 ! 4315 ! 4.a ALLOCATE storage 4316 ! 4.a.1 Local counters, weights and sea counters (grid 'I') 4317 ! 4318 IF ( EQSTGE(I,I)%NREC .NE. 0 ) THEN 4319 DEALLOCATE (EQSTGE(I,I)%ISEA , EQSTGE(I,I)%JSEA , & Page 79 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 4320 EQSTGE(I,I)%WGHT ) 4321 EQSTGE(I,I)%NREC = 0 4322 END IF 4323 ! 4324 IF ( NREC(I) .GT. 0 ) THEN 4325 ALLOCATE ( EQSTGE(I,I)%ISEA(NREC(I)) , & 4326 EQSTGE(I,I)%JSEA(NREC(I)) , & 4327 EQSTGE(I,I)%WGHT(NREC(I)) ) 4328 EQSTGE(I,I)%NREC = NREC(I) 4329 END IF 4330 ! 4331 ! 4.a.1 Local counters, arrays weights etc. (grid 'J' receive) 4332 ! 4333 DO J=1, NRGRD 4334 IF ( I .EQ. J ) CYCLE 4335 EQSTGE(I,I)%NTOT = STORES(I,J)%NFIN 4336 ! 4337 IF ( EQSTGE(I,J)%NREC .NE. 0 ) THEN 4338 DEALLOCATE ( EQSTGE(I,J)%ISEA , EQSTGE(I,J)%JSEA , & 4339 EQSTGE(I,J)%WGHT , EQSTGE(I,J)%SEQL , & 4340 EQSTGE(I,J)%NAVG , EQSTGE(I,J)%WAVG , & 4341 EQSTGE(I,J)%RIP , EQSTGE(I,J)%RTG ) 4342 EQSTGE(I,J)%NREC = 0 4343 EQSTGE(I,J)%NAVMAX = 1 4344 END IF 4345 ! 4346 IF ( NREC(J) .GT. 0 ) THEN 4347 NA = MAXVAL ( STORES(I,J)%NAV(1:STORES(I,J)%NTOT) ) 4348 EQSTGE(I,J)%NAVMAX = NA 4349 ALLOCATE ( EQSTGE(I,J)%ISEA(NREC(J)) , & 4350 EQSTGE(I,J)%JSEA(NREC(J)) , & 4351 EQSTGE(I,J)%WGHT(NREC(J)) , & 4352 EQSTGE(I,J)%SEQL(SGRDS(J)%NSPEC,NREC(J),NA), & 4353 EQSTGE(I,J)%NAVG(NREC(J)) , & 4354 EQSTGE(I,J)%WAVG(NREC(J),NA), & 4355 EQSTGE(I,J)%RIP(NREC(J),NA), & 4356 EQSTGE(I,J)%RTG(NREC(J),NA) ) 4357 EQSTGE(I,J)%NREC = NREC(J) 4358 END IF 4359 ! 4360 IF ( EQSTGE(I,J)%NSND .NE. 0 ) THEN 4361 DEALLOCATE ( EQSTGE(I,J)%SIS , EQSTGE(I,J)%SJS , & 4362 EQSTGE(I,J)%SI1 , EQSTGE(I,J)%SI2 , & 4363 EQSTGE(I,J)%SIP , EQSTGE(I,J)%STG ) 4364 EQSTGE(I,J)%NSND = 0 4365 END IF 4366 ! 4367 IF ( NSND(J) .GT. 0 ) THEN 4368 ALLOCATE ( EQSTGE(I,J)%SIS(NSND(J)) , & 4369 EQSTGE(I,J)%SJS(NSND(J)) , & 4370 EQSTGE(I,J)%SI1(NSND(J)) , & 4371 EQSTGE(I,J)%SI2(NSND(J)) , & 4372 EQSTGE(I,J)%SIP(NSND(J)) , & 4373 EQSTGE(I,J)%STG(NSND(J)) ) 4374 EQSTGE(I,J)%NSND = NSND(J) 4375 END IF 4376 ! Page 80 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 4377 END DO 4378 ! 4379 ! 4.b Store data in EQSTGE 4380 ! 4.b.1 Grid I (JSEA and weight only) 4381 ! 4382 IF ( EQSTGE(I,I)%NREC .GT. 0 ) THEN 4383 NTL = 0 4384 DO IX=1, NX 4385 DO IY=1, NY 4386 IF ( MAP3D(IY,IX,0) .EQ. 0 ) CYCLE 4387 IF ( MAP3D(IY,IX,-4) .NE. IMPROC ) CYCLE 4388 NTL = NTL + 1 4389 EQSTGE(I,I)%ISEA(NTL) = MAP3D(IY,IX,-2) 4390 EQSTGE(I,I)%JSEA(NTL) = MAP3D(IY,IX,-3) 4391 EQSTGE(I,I)%WGHT(NTL) = WGT3D(IY,IX,0) 4392 END DO 4393 END DO 4394 END IF 4395 ! 4396 ! 4.b.2 All other grids, info for receiving 4397 ! 4398 DO J=1, NRGRD 4399 IF ( .NOT. SHRANK(I,J) ) CYCLE 4400 IF ( EQSTGE(I,J)%NREC .EQ. 0 ) CYCLE 4401 NTL = 0 4402 ! 4403 DO JJ=1, STORES(I,J)%NTOT 4404 IX = STORES(I,J)%IX(JJ) 4405 IY = STORES(I,J)%IY(JJ) 4406 IF ( MAP3D(IY,IX,J) .EQ. 0 ) CYCLE 4407 IF ( MAP3D(IY,IX,-4) .NE. IMPROC ) CYCLE 4408 NTL = NTL + 1 4409 EQSTGE(I,J)%ISEA(NTL) = MAP3D(IY,IX,-2) 4410 EQSTGE(I,J)%JSEA(NTL) = MAP3D(IY,IX,-3) 4411 EQSTGE(I,J)%WGHT(NTL) = WGT3D(IY,IX,J) 4412 NA = STORES(I,J)%NAV(JJ) 4413 EQSTGE(I,J)%NAVG(NTL) = NA 4414 EQSTGE(I,J)%WAVG(NTL,1:NA) = STORES(I,J)%AWG(JJ,1:NA) 4415 EQSTGE(I,J)%RIP (NTL,1:NA) = STORES(I,J)%IPS(JJ,1:NA) 4416 EQSTGE(I,J)%RTG (NTL,1:NA) = STORES(I,J)%ITG(JJ,1:NA) 4417 END DO 4418 ! 4419 END DO 4420 ! 4421 ! 4.b.3 All other grids, info for sending 4422 ! 4423 DO J=1, NRGRD 4424 IF ( .NOT. SHRANK(I,J) ) CYCLE 4425 IF ( EQSTGE(I,J)%NSND .EQ. 0 ) CYCLE 4426 NTPP = 0 4427 NTL = 0 4428 ! 4429 DO JJ=1, STORES(I,J)%NTOT 4430 IX = STORES(I,J)%IX(JJ) 4431 IY = STORES(I,J)%IY(JJ) 4432 IF ( MAP3D(IY,IX,J) .NE. 0 ) THEN 4433 NTPP(MAP3D(IY,IX,-4)) = NTPP(MAP3D(IY,IX,-4)) + 1 Page 81 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 4434 DO NA=1, STORES(I,J)%NAV(JJ) 4435 IF ( STORES(I,J)%IPS(JJ,NA) .EQ. IMPROC ) THEN 4436 NTL = NTL + 1 4437 EQSTGE(I,J)%SIS(NTL) = STORES(I,J)%ISS(JJ,NA) 4438 EQSTGE(I,J)%SJS(NTL) = STORES(I,J)%JSS(JJ,NA) 4439 EQSTGE(I,J)%SI1(NTL) = NTPP(MAP3D(IY,IX,-4)) 4440 EQSTGE(I,J)%SI2(NTL) = NA 4441 EQSTGE(I,J)%SIP(NTL) = MAP3D(IY,IX,-4) 4442 EQSTGE(I,J)%STG(NTL) = STORES(I,J)%ITG(JJ,NA) 4443 END IF 4444 END DO 4445 END IF 4446 END DO 4447 ! 4448 END DO 4449 ! 4450 ! 4.c Detailed test output 4451 ! 4452 ! ... End of loop started in 3.a 4453 ! 4454 DEALLOCATE ( MAP3D, WGT3D ) 4455 END DO 4456 ! 4457 ! -------------------------------------------------------------------- / 4458 ! 5. Generate GRDEQL 4459 ! 5.a Size of array 4460 ! 4461 NREC = 0 4462 ! 4463 DO I=1, NRGRD 4464 DO J=1, NRGRD 4465 IF ( I.EQ.J .OR. STORES(I,J)%NFIN.EQ.0 ) CYCLE 4466 NREC(I) = NREC(I) + 1 4467 END DO 4468 END DO 4469 ! 4470 NA = MAXVAL(NREC) 4471 ALLOCATE ( GRDEQL(NRGRD,0:NA) ) 4472 GRDEQL = 0 4473 ! 4474 ! 5.b Fill array 4475 ! 4476 DO I=1, NRGRD 4477 GRDEQL(I,0) = NREC(I) 4478 JJ = 0 4479 DO J=1, NRGRD 4480 IF ( I.EQ.J .OR. STORES(I,J)%NFIN.EQ.0 ) CYCLE 4481 JJ = JJ + 1 4482 GRDEQL(I,JJ) = J 4483 END DO 4484 END DO 4485 ! 4486 ! 5.c Resolution test 4487 ! 4488 4489 IF ( FLAGLL ) THEN 4490 FACTOR = 1. Page 82 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 4491 ELSE 4492 FACTOR = 1.E-3 4493 END IF 4494 ! 4495 ! notes: This resolution test, with FACMAX=2, is pretty strict, so 4496 ! it is not going to be appropriate for irregular grids. 4497 ! We'll just have to trust the judgement of the user in the 4498 ! case of irregular grids. But if we change our minds and do 4499 ! some kind of check for irregular grids, we could make 4500 ! a check against median(HPFAC) and median(HQFAC). 4501 4502 DO I=1, NRGRD 4503 CALL W3SETG ( I, MDSE, MDST ) 4504 IF ( GTYPE.EQ.RLGTYPE ) THEN 4505 DO JJ=1, GRDEQL(I,0) 4506 J = GRDEQL(I,JJ) 4507 IF ( GRIDS(J)%GTYPE.EQ.RLGTYPE ) THEN 4508 IF ( SX/GRIDS(J)%SX .GT. FACMAX .OR. & 4509 SX/GRIDS(J)%SX .LT. 1./FACMAX .OR. & 4510 SY/GRIDS(J)%SY .GT. FACMAX .OR. & 4511 SY/GRIDS(J)%SY .LT. 1./FACMAX ) THEN 4512 IF ( IMPROC.EQ.NMPERR ) WRITE(MDSE,1050) I, FACTOR*SX, & 4513 FACTOR*SY, J, FACTOR*GRIDS(J)%SX, FACTOR*GRIDS(J)%SY 4514 CALL EXTCDE ( 1050 ) 4515 END IF ! IF ( SX/GR ... 4516 END IF ! IF ( GRIDS(J)%GTYPE... 4517 END DO ! DO JJ=... 4518 END IF ! IF ( GTYPE.... 4519 END DO ! DO I=... 4520 ! 4521 ! 5.d Group number test 4522 ! 4523 DO I=1, NRGRD 4524 IF ( GRDEQL(I,0) .GE. 2 ) THEN 4525 TGRP = GRGRP(GRDEQL(I,1)) 4526 DO J=2, GRDEQL(I,0) 4527 IF ( GRGRP(GRDEQL(I,J)) .NE. TGRP ) THEN 4528 IF ( IMPROC .EQ. NMPERR ) WRITE(MDSE,1051) & 4529 GRDEQL(I,1), GRGRP(GRDEQL(I,1)), & 4530 GRDEQL(I,J), GRGRP(GRDEQL(I,J)) 4531 CALL EXTCDE ( 1051 ) 4532 END IF 4533 END DO 4534 END IF 4535 END DO 4536 ! 4537 ! -------------------------------------------------------------------- / 4538 ! 6. Final clean up 4539 ! 4540 DO I=1, NRGRD 4541 DO J=1, NRGRD 4542 IF ( STORES(I,J)%INIT ) DEALLOCATE & 4543 ( STORES(I,J)%IX , STORES(I,J)%IY , & 4544 STORES(I,J)%NAV , STORES(I,J)%FLA , & 4545 STORES(I,J)%ISS , STORES(I,J)%JSS , & 4546 STORES(I,J)%IPS , STORES(I,J)%ITG , & 4547 STORES(I,J)%AWG ) Page 83 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 4548 END DO 4549 END DO 4550 ! 4551 DEALLOCATE ( SHRANK, STORES, NREC, NSND, NTPP ) 4552 ! 4553 RETURN 4554 ! 4555 ! Formats 4556 ! 4557 1000 FORMAT (/' *** WAVEWATCH III ERROR IN WMGEQL : *** '/ & 4558 ' UNCOVERED EDGE POINTS FOR GRID',I4,' (',I6,')'/) 4559 1001 FORMAT ( ' GRID',I4,' POINT',2I5,' NOT COVERED (WMGEQL)') 4560 1002 FORMAT ( ' DIAGNOSTICS IX AND IY RANGE:',4I6) 4561 1003 FORMAT (/' SHOWING ',A/) 4562 1004 FORMAT (2X,65I2) 4563 1005 FORMAT (/' SHOWING IX RANGE ',2I6) 4564 1006 FORMAT ( ' (WILL NOT PRINT ANY MORE UNCOVERED POINTS)') 4565 ! 4566 1020 FORMAT (/' *** WAVEWATCH III WARNING WMGEQL : *** '/ & 4567 ' REMOVED BOUNDARY POINT FROM OPEN EDGE DISTANCE MAP'/ & 4568 ' GRID, IX, IY :',3I6) 4569 ! 4570 1050 FORMAT (/' *** WAVEWATCH III ERROR IN WMGEQL : *** '/ & 4571 ' GRID INCREMENTS TOO DIFFERENT '/ & 4572 ' GRID',I4,' INCREMENTS ',2F8.2/ & 4573 ' GRID',I4,' INCREMENTS ',2F8.2/) 4574 1051 FORMAT (/' *** WAVEWATCH III ERROR IN WMGEQL : *** '/ & 4575 ' OVERLAPPING GRIDS NEED TO BE IN SAME GROUP '/ & 4576 ' GRID',I4,' IN GROUP',I4/ & 4577 ' GRID',I4,' IN GROUP',I4/) 4578 ! 4579 !/ 4580 !/ End of WMGEQL ----------------------------------------------------- / 4581 !/ 4582 END SUBROUTINE WMGEQL Page 84 Source Listing WMGEQL 2014-09-16 16:48 Entry Points wmgridmd.f90 ENTRY POINTS Name wmgridmd_mp_wmgeql_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References 1000 Label 3481 3199 1001 Label 3483 3183 1002 Label 3484 3205 1003 Label 3485 3211,3215,3219,3224 1004 Label 3486 3213,3217,3221,3226 1005 Label 3487 3210 1006 Label 3488 3185 1020 Label 3490 1050 Label 3494 3436 1051 Label 3498 3452 ABS Func 2792 scalar 2792,2825,2827,2848,2868,3176 AWG Local 2570 R(4) 4 2 1 PTR 2684,2691,2781,2797,2801,3338,3471 CHANGE Local 2562 L(4) 4 scalar 2984,3033,3038 CLGTYPE Param 2638 I(4) 4 scalar 2638 CONSTANTS Module 2531 2531 CROOT Local 2779 I(4) 4 scalar 2779 CROOT Local 3097 I(4) 4 scalar PTR 3097 DERA Param 2597 R(4) 4 scalar 2597 DOGRID Local 2563 L(4) 4 1 1 ALC 2583,2625,3071 DTCFL Local 2889 R(4) 4 scalar PTR 2889 DTMAX Local 2828 R(4) 4 scalar PTR 2828,2830,2889,3003,3044,3101,3122 ,3222 EQSTGE Local 3242 RECORD 1432 2 1 ALC,TGT 3242,3243,3244,3245,3249,3250,3251 ,3252,3259,3261,3262,3263,3264,326 5,3266,3267,3272,3273,3274,3275,32 76,3277,3278,3279,3280,3281,3284,3 285,3286,3287,3288,3292,3293,3294, 3295,3296,3297,3298,3306,3313,3314 ,3315,3324,3333,3334,3335,3337,333 8,3339,3340,3349,3361,3362,3363,33 64,3365,3366 EXTCDE Subr 2537 2537,2636,2641,3231,3438,3455 EXTRA Local 2552 I(4) 4 scalar 3200,3201,3202,3203,3204 FACMAX Param 2560 R(4) 4 scalar 3432,3433,3434,3435 FACTOR Local 2555 R(4) 4 scalar 2597,2601,2998,2999,3414,3416,3436 ,3437 FLA Local 2571 L(4) 4 1 1 PTR 2681,2686,2793,2846,2849,2854,3468 FLAGLL Local 2596 L(4) 4 scalar 2596,2659,2702,3413 FLAGST Local 3055 L(4) 4 1 1 PTR 3055 FLGHG1 Local 3055 L(4) 4 scalar 3055 GRANK Local 2618 I(4) 4 1 1 ALC 2618 GRAV Param 2998 R(4) 4 scalar 2998,3000 GRDEQL Local 3395 I(4) 4 2 1 ALC 3395,3396,3401,3406,3429,3430,3448 ,3449,3450,3451,3453,3454 Page 85 Source Listing WMGEQL 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References GRGRP Local 3449 I(4) 4 1 1 ALC 3449,3451,3453,3454 GRIDS Local 2663 RECORD 4376 1 1 ALC,TGT 2663,2664,2670,2671,2697,2698,2703 ,2704,2706,2711,2721,2725,2733,273 7,2748,2752,2767,2771,2792,3103,31 04,3431,3432,3433,3434,3435,3437 GTYPE Local 2633 I(4) 4 scalar PTR 2633,2638,3428 GTYPE Local 3431 I(4) 4 scalar 3431 HPFAC Local 2999 R(4) 4 2 1 PTR 2999 HQFAC Local 2998 R(4) 4 2 1 PTR 2998 I Local 2547 I(4) 4 scalar 2587,2590,2591,2592,2609,2618,2619 ,2623,2625,2651,2679,2680,2681,268 2,2683,2684,2685,2686,2687,2688,26 89,2690,2691,2762,2763,2781,2782,2 783,2784,2785,2793,2797,2801,2804, 2811,2819,2820,2841,2842,2843,2844 ,2846,2847,2849,2850,2854,2857,307 0,3071,3073,3074,3075,3086,3089,30 90,3091,3092,3100,3102,3103,3104,3 112,3116,3133,3145,3146,3147,3148, 3150,3151,3163,3183,3199,3242,3243 ,3244,3245,3248,3249,3250,3251,325 2,3258,3259,3261,3262,3263,3264,32 65,3266,3267,3271,3272,3273,3274,3 275,3276,3277,3278,3279,3280,3281, 3284,3285,3286,3287,3288,3292,3293 ,3294,3295,3296,3297,3298,3306,331 3,3314,3315,3323,3324,3327,3328,33 29,3333,3334,3335,3336,3337,3338,3 339,3340,3348,3349,3353,3354,3355, 3358,3359,3361,3362,3363,3364,3365 ,3366,3387,3389,3390,3400,3401,340 4,3406,3426,3427,3429,3430,3436,34 47,3448,3449,3450,3451,3453,3454,3 464,3466,3467,3468,3469,3470,3471 ICLOSE Local 2891 I(4) 4 scalar PTR 2891 ICLOSE_NONE Param 2891 I(4) 4 scalar 2891 IMPROC Local 2634 I(4) 4 scalar 2634,2639,3132,3151,3180,3182,3184 ,3198,3311,3331,3359,3436,3452 INIT Local 2572 L(4) 4 scalar 2590,2679,3466 INT Func 2708 scalar 2708,2734,2889 IP Local 2552 I(4) 4 scalar 3207,3208 IPS Local 2569 I(4) 4 2 1 PTR 2683,2689,2784,3151,3339,3359,3470 ISEA Local 2551 I(4) 4 scalar 2771,2772,2776,2777,2782,2997,3052 ,3053,3054,3055 ISEA Local 3243 I(4) 4 1 1 PTR 3243,3249,3262,3273,3313,3333 ISPROC Local 2551 I(4) 4 scalar 2774,2777,2784 ISS Local 2568 I(4) 4 2 1 PTR 2682,2687,2782,3103,3104,3361,3469 ITAG Local 2551 I(4) 4 scalar 2603,2769,2785 ITG Local 2569 I(4) 4 2 1 PTR 2683,2690,2785,3340,3366,3470 IX Local 2547 I(4) 4 scalar 2700,2701,2762,2823,2825,2826,2827 ,2828,2830,2843,2845,2846,2848,285 1,2854,2856,2857,2866,2868,2869,28 70,2871,2872,2873,2874,2881,2883,2 903,2904,2907,2911,2912,2916,2917, 2919,2922,2925,2928,2931,2933,2938 Page 86 Source Listing WMGEQL 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References ,2940,2951,2952,2955,2959,2960,296 3,2964,2965,2969,2972,2975,2978,29 80,2986,2987,2990,2994,2995,2997,2 998,2999,3002,3004,3005,3006,3007, 3008,3009,3017,3021,3025,3029,3032 ,3041,3043,3044,3053,3055,3090,309 2,3093,3094,3095,3096,3097,3099,31 01,3105,3106,3108,3117,3119,3120,3 121,3122,3123,3124,3126,3128,3130, 3132,3135,3147,3149,3174,3176,3177 ,3178,3183,3186,3187,3190,3308,331 0,3311,3313,3314,3315,3328,3330,33 31,3333,3334,3335,3354,3356,3357,3 363,3365 IX Local 2568 I(4) 4 1 1 PTR 2680,2762,2843,3090,3147,3328,3354 ,3467 IXH Local 2547 I(4) 4 scalar 2661,2667,2676,2700,2893,2896,2903 ,2938,2951,2986,3209,3210,3213,321 7,3222,3226 IXL Local 2547 I(4) 4 scalar 2660,2666,2676,2700,2892,2895,2903 ,2938,2951,2986,3208,3209,3210,321 3,3217,3222,3226 IY Local 2547 I(4) 4 scalar 2731,2732,2763,2824,2825,2826,2827 ,2828,2830,2844,2845,2846,2848,285 1,2854,2856,2857,2867,2868,2869,28 70,2871,2872,2873,2874,2882,2883,2 915,2916,2917,2918,2919,2920,2921, 2922,2923,2924,2925,2926,2927,2928 ,2929,2930,2931,2932,2933,2939,294 0,2962,2963,2964,2965,2966,2967,29 68,2969,2970,2971,2972,2973,2974,2 975,2976,2977,2978,2979,2980,2985, 2997,2998,2999,3002,3004,3005,3006 ,3007,3008,3009,3010,3011,3012,301 3,3014,3015,3016,3017,3018,3019,30 20,3021,3022,3023,3024,3025,3026,3 027,3028,3029,3030,3031,3032,3042, 3043,3044,3054,3055,3091,3092,3093 ,3094,3095,3096,3097,3099,3101,310 5,3106,3108,3118,3119,3120,3121,31 22,3123,3124,3126,3128,3130,3132,3 135,3148,3149,3175,3176,3177,3178, 3183,3188,3189,3190,3212,3213,3216 ,3217,3220,3222,3225,3226,3309,331 0,3311,3313,3314,3315,3329,3330,33 31,3333,3334,3335,3355,3356,3357,3 363,3365 IY Local 2568 I(4) 4 1 1 PTR 2680,2763,2844,3091,3148,3329,3355 ,3467 IYH Local 2547 I(4) 4 scalar 2674,2676,2731 IYL Local 2547 I(4) 4 scalar 2673,2676,2731 J Local 2547 I(4) 4 scalar 2589,2590,2591,2592,2616,2618,2619 ,2649,2651,2663,2664,2670,2671,267 9,2680,2681,2682,2683,2684,2685,26 86,2687,2688,2689,2690,2691,2697,2 Page 87 Source Listing WMGEQL 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References 698,2703,2704,2706,2711,2721,2725, 2733,2737,2748,2752,2762,2763,2767 ,2771,2776,2778,2779,2781,2782,278 3,2784,2785,2792,2793,2797,2801,28 04,2811,2840,2841,2842,2843,2844,2 846,2847,2849,2850,2854,2857,2899, 3085,3086,3087,3089,3090,3091,3100 ,3101,3102,3103,3104,3105,3106,310 8,3112,3144,3145,3146,3147,3148,31 49,3150,3151,3152,3257,3258,3259,3 261,3262,3263,3264,3265,3266,3267, 3270,3271,3272,3273,3274,3275,3276 ,3277,3278,3279,3280,3281,3284,328 5,3286,3287,3288,3291,3292,3293,32 94,3295,3296,3297,3298,3322,3323,3 324,3327,3328,3329,3330,3333,3334, 3335,3336,3337,3338,3339,3340,3347 ,3348,3349,3353,3354,3355,3356,335 8,3359,3361,3362,3363,3364,3365,33 66,3388,3389,3403,3404,3406,3430,3 431,3432,3433,3434,3435,3437,3450, 3451,3454,3465,3466,3467,3468,3469 ,3470,3471 JJ Local 2550 I(4) 4 scalar 2842,2843,2844,2846,2847,2849,2850 ,2854,2857,3089,3090,3091,3100,310 2,3103,3104,3134,3135,3136,3146,31 47,3148,3150,3151,3327,3328,3329,3 336,3338,3339,3340,3353,3354,3355, 3358,3359,3361,3362,3366,3402,3405 ,3406,3429,3430 JSEA Local 2551 I(4) 4 scalar 2773,2776,2778,2783 JSEA Local 3243 I(4) 4 1 1 PTR 3243,3250,3262,3274,3314,3334 JSS Local 2569 I(4) 4 2 1 PTR 2682,2688,2783,3362,3469 JX Local 2548 I(4) 4 scalar 2765,2767,2770,2771,2790,2792,3103 ,3105,3106 JXH Local 2548 I(4) 4 scalar 2709,2711,2712,2716,2721,2725,2728 ,2765,2906,2909,2912,2920,2921,292 3,2930,2932,2954,2957,2960,2966,29 68,2970,2977,2979,2989,2992,2995,3 010,3011,3012,3016,3018,3019,3028, 3030,3031,3167,3187,3202,3205,3206 JXH2 Local 2548 I(4) 4 scalar 2725,2728,2790 JXL Local 2548 I(4) 4 scalar 2708,2709,2712,2715,2716,2721,2724 ,2727,2765,2770,2905,2908,2911,291 8,2924,2926,2927,2929,2953,2956,29 59,2967,2971,2973,2974,2976,2988,2 991,2994,3013,3014,3015,3020,3022, 3023,3024,3026,3027,3166,3186,3201 ,3205,3206,3208 JXL2 Local 2548 I(4) 4 scalar 2724,2727,2790 JY Local 2549 I(4) 4 scalar 2766,2767,2770,2771,2791,2792,3104 ,3105,3106 JYH Local 2549 I(4) 4 scalar 2735,2737,2738,2742,2745,2748,2752 ,2755,2766,3169,3189,3204,3205,321 2,3216,3220,3225 Page 88 Source Listing WMGEQL 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References JYH2 Local 2549 I(4) 4 scalar 2752,2755,2791 JYL Local 2549 I(4) 4 scalar 2734,2735,2738,2741,2742,2745,2748 ,2751,2754,2766,2770,3168,3188,320 3,3205,3212,3216,3220,3225 JYL2 Local 2549 I(4) 4 scalar 2751,2754,2791 MAP3D Local 2553 I(4) 4 3 1 ALC 3077,3078,3093,3094,3095,3096,3097 ,3108,3112,3119,3120,3121,3124,313 2,3135,3149,3158,3159,3178,3226,33 10,3311,3313,3314,3330,3331,3333,3 334,3356,3357,3363,3365,3378 MAPFS Local 2771 I(4) 4 2 1 PTR 2771 MAPFS Local 2997 I(4) 4 2 1 PTR 2997,3093 MAPODI Local 2819 R(4) 4 2 1 PTR 2819,2820,3087,3092,3116,3163 MAPODI Local 2820 R(4) 4 2 1 PTR 2820,2821,2826,2828,2830,2851,2857 ,2870,2871,2872,2873,2883,2916,291 7,2918,2919,2920,2921,2924,2927,29 30,2940,2963,2964,2965,2966,2967,2 968,2971,2974,2977,3004,3006,3007, 3009,3010,3012,3013,3015,3016,3019 ,3020,3023,3024,3027,3028,3031,303 2,3043,3044,3055,3087,3105,3106,31 16,3122,3163,3177,3222 MAPOUT Local 2554 I(4) 4 2 1 ALC 3171,3172,3190,3217,3234 MAPSF Local 3053 I(4) 4 2 1 PTR 3053,3054 MAPSF Local 3103 I(4) 4 2 1 PTR 3103,3104 MAPST2 Local 2856 I(4) 4 2 1 PTR 2856 MAPSTA Local 2767 I(4) 4 2 1 PTR 2767,2792 MAPSTA Local 2825 I(4) 4 2 1 PTR 2825,2827,2848,2856,2868,2922,2923 ,2925,2926,2928,2929,2931,2932,296 9,2970,2972,2973,2975,2976,2978,29 79,3017,3018,3021,3022,3025,3026,3 029,3030,3099,3172,3176,3213 MASKA Local 2564 L(4) 4 2 1 ALC 2837,2838,2846,2854,2869,2879 MASKI Local 2564 L(4) 4 2 1 ALC 2863,2864,2874,2883,2901,2933,2940 ,2949,2980,3002,3005,3008,3011,301 4,3048 MAX Func 2666 scalar 2666,2673,2724,2751,3187,3189,3201 ,3203 MAXVAL Func 3119 scalar 3119,3158,3271,3394 MDATAS Local 2779 RECORD 1360 1 1 ALC,TGT 2779,2819,2820,3087,3092,3116,3163 MDSE Local 2623 I(4) 4 scalar 2623,2634,2639,3073,3074,3075,3181 ,3183,3185,3199,3205,3210,3211,321 3,3215,3217,3219,3221,3224,3226,32 28,3427,3436,3452 MDST Local 2623 I(4) 4 scalar 2623,3073,3074,3075,3427 MIN Func 2667 scalar 2667,2674,2725,2752,3005,3008,3011 ,3014,3019,3023,3027,3031,3106,318 6,3188,3202,3204,3209 MOD Func 2703 scalar 2703,2710,2736 NA Local 2550 I(4) 4 scalar 2761,2768,2781,2782,2783,2784,2785 ,2797,2799,2804,3102,3103,3104,315 0,3151,3271,3272,3276,3278,3279,32 80,3336,3337,3338,3339,3340,3358,3 359,3361,3362,3364,3366,3394,3395 NAPROC Local 2776 I(4) 4 scalar 2776,2778 Page 89 Source Listing WMGEQL 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References NAPROC Local 3095 I(4) 4 scalar PTR 3095,3097 NAV Local 2568 I(4) 4 1 1 PTR 2681,2685,2804,2847,2850,2857,3100 ,3102,3150,3271,3336,3358,3468 NAVG Local 3264 I(4) 4 1 1 PTR 3264,3277,3337 NAVMAX Local 3267 I(4) 4 scalar 3267,3272 NEWVAL Local 2557 R(4) 4 scalar 3003,3005,3006,3008,3009,3011,3012 ,3014,3015,3018,3019,3022,3023,302 6,3027,3030,3031,3032 NFIN Local 2567 I(4) 4 scalar 2592,3112,3259,3389,3404 NG Local 2550 I(4) 4 scalar 3158 NINT Func 2666 scalar 2666,2667,2673,2674,3222 NIT Local 2550 I(4) 4 scalar 2889,2899 NMPERR Local 2634 I(4) 4 scalar 2634,2639,3180,3182,3184,3198,3436 ,3452 NMPROC Local 3068 I(4) 4 scalar 3068 NOUT Local 2550 I(4) 4 scalar 3164,3179,3180,3182,3184,3197,3199 NP Local 2552 I(4) 4 scalar 3206,3207 NR Local 2550 I(4) 4 scalar 2614,2620,2625,2629 NREC Local 2553 I(4) 4 1 1 ALC 3068,3080,3133,3136,3248,3249,3250 ,3251,3252,3270,3273,3274,3275,327 6,3277,3278,3279,3280,3281,3385,33 90,3394,3401,3475 NREC Local 3242 I(4) 4 scalar 3242,3245,3252,3261,3266,3281,3306 ,3324 NRGRD Local 2582 I(4) 4 scalar 2582,2583,2587,2589,2609,2616,2649 ,2840,3068,3070,3077,3085,3134,314 4,3257,3322,3347,3387,3388,3395,34 00,3403,3426,3447,3464,3465 NSEA Local 3052 I(4) 4 scalar PTR 3052 NSND Local 2553 I(4) 4 1 1 ALC 3068,3081,3152,3291,3292,3293,3294 ,3295,3296,3297,3298,3475 NSND Local 3284 I(4) 4 scalar 3284,3288,3298,3349 NSPEC Local 3276 I(4) 4 scalar 3276 NT Local 2550 I(4) 4 scalar 2676,2677,2680,2681,2682,2683,2684 ,2695,2760,2762,2763,2781,2782,278 3,2784,2785,2793,2797,2801,2804,28 11 NTL Local 2550 I(4) 4 scalar 3159,3307,3312,3313,3314,3315,3325 ,3332,3333,3334,3335,3337,3338,333 9,3340,3351,3360,3361,3362,3363,33 64,3365,3366 NTOT Local 2567 I(4) 4 scalar 2591,2811,2842,3089,3146,3271,3327 ,3353 NTOT Local 3259 I(4) 4 scalar 3259 NTPP Local 2554 I(4) 4 1 1 ALC 3068,3350,3357,3363,3475 NX Local 2661 I(4) 4 scalar PTR 2661,2667,2819,2823,2837,2845,2863 ,2866,2881,2893,2896,2905,2907,290 8,2953,2955,2956,2988,2990,2991,30 41,3077,3117,3166,3171,3174,3202,3 209,3308 NX Local 2664 I(4) 4 scalar 2664,2711,2721,2725 NY Local 2671 I(4) 4 scalar 2671,2737,2748,2752 NY Local 2674 I(4) 4 scalar PTR 2674,2819,2824,2837,2845,2863,2867 ,2882,2915,2939,2962,2985,3042,307 7,3118,3168,3171,3175,3204,3309 Page 90 Source Listing WMGEQL 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References ODIMAX Param 2559 R(4) 4 scalar 3003,3044,3101,3122 OUTPTS Local 2776 RECORD 5960 1 1 ALC,TGT 2776,2778 RADIUS Param 2597 R(4) 4 scalar 2597 REAL Func 2701 scalar 2701,2732 RIP Local 3265 I(4) 4 2 1 PTR 3265,3279,3339 RLGTYPE Param 3428 I(4) 4 scalar 3428,3431 RTG Local 3265 I(4) 4 2 1 PTR 3265,3280,3340 RX Local 2556 R(4) 4 1 2 2710,2711,2713,2715,2717,2719,2770 RY Local 2556 R(4) 4 1 2 2736,2737,2739,2741,2743,2745,2746 ,2770 SEQL Local 3263 R(4) 4 3 1 PTR 3263,3276 SGRDS Local 3276 RECORD 1080 1 1 ALC,TGT 3276 SHRANK Local 2563 L(4) 4 2 1 ALC 2582,2585,2619,2651,2841,3086,3145 ,3323,3348,3475 SI1 Local 3286 I(4) 4 1 1 PTR 3286,3294,3363 SI2 Local 3286 I(4) 4 1 1 PTR 3286,3295,3364 SIG Local 2828 R(4) 4 1 1 PTR 2828,2830,3003,3044,3101,3122,3222 SIP Local 3287 I(4) 4 1 1 PTR 3287,3296,3365 SIS Local 3285 I(4) 4 1 1 PTR 3285,3292,3361 SJS Local 3285 I(4) 4 1 1 PTR 3285,3293,3362 SQRT Func 3001 scalar 3001 STG Local 3287 I(4) 4 1 1 PTR 3287,3297,3366 STORE Type 2566 784 scalar 2573,2575 STORES Local 2575 RECORD 784 2 1 ALC 2582,2590,2591,2592,2679,2680,2681 ,2682,2683,2684,2685,2686,2687,268 8,2689,2690,2691,2762,2763,2781,27 82,2783,2784,2785,2793,2797,2801,2 804,2811,2842,2843,2844,2846,2847, 2849,2850,2854,2857,3089,3090,3091 ,3100,3102,3103,3104,3112,3146,314 7,3148,3150,3151,3259,3271,3327,33 28,3329,3336,3338,3339,3340,3353,3 354,3355,3358,3359,3361,3362,3366, 3389,3404,3466,3467,3468,3469,3470 ,3471,3475 STX Local 2556 R(4) 4 scalar 2999,3001,3012,3015 STXY Local 2557 R(4) 4 scalar 3001,3019,3023,3027,3031 STY Local 2556 R(4) 4 scalar 2998,3001,3006,3009 SUM Func 2797 scalar 2797,3112,3120,3126,3159 SX Local 2663 R(4) 4 scalar PTR 2663,2665,2697,2701,3432,3433,3436 SX Local 2664 R(4) 4 scalar 2664,2697,2704,2706,3432,3433,3437 SY Local 2670 R(4) 4 scalar PTR 2670,2672,2698,2732,3434,3435,3437 SY Local 2671 R(4) 4 scalar 2671,2698,2733,3434,3435,3437 TGRP Local 2551 I(4) 4 scalar 3449,3451 TODO Param 2558 R(4) 4 scalar 2826,2916,2963,3043 UNGTYPE Param 2633 I(4) 4 scalar 2633 W3ADATMD Module 2534 2534 W3GDATMD Module 2532 2532 W3ODATMD Module 2533 2533 W3SERVMD Module 2537 2537 W3SETG Subr 2623 2623,3073,3427 W3SETO Subr 3074 3074 WAVG Local 3264 R(4) 4 2 1 PTR 3264,3278,3338 WGHT Local 3244 R(4) 4 1 1 PTR 3244,3251,3263,3275,3315,3335 WGT3D Local 2561 R(4) 4 3 1 ALC 3077,3079,3092,3099,3101,3105,3106 Page 91 Source Listing WMGEQL 2014-09-16 16:48 Symbol Table wmgridmd.f90 Name Object Declared Type Bytes Dimen Elements Attributes References ,3108,3123,3126,3128,3130,3315,333 5,3378 WGTH Local 2557 R(4) 4 scalar 2770,2781,2797,2798,2801,3126,3127 ,3128 WMGEQL Subr 2447 WMMDATMD Module 2535 2535 WMSETM Subr 3075 3075 X0 Local 2663 R(4) 4 scalar PTR 2663,2664,2703,2706,2665,2701 XA Local 2555 R(4) 4 scalar 2701,2703,2706 XEXPND Local 2562 L(4) 4 scalar 2697,2723 XR Local 2556 R(4) 4 scalar 2703,2706,2708,2710 XSH Local 2555 R(4) 4 scalar 2664,2667 XSL Local 2555 R(4) 4 scalar 2663,2666 Y0 Local 2670 R(4) 4 scalar PTR 2670,2671,2733,2672,2732 YA Local 2555 R(4) 4 scalar 2732,2733 YEXPND Local 2562 L(4) 4 scalar 2698,2750 YR Local 2556 R(4) 4 scalar 2733,2734,2736 YSH Local 2555 R(4) 4 scalar 2671,2674 YSL Local 2555 R(4) 4 scalar 2670,2673 Page 92 Source Listing WMGEQL 2014-09-16 16:48 wmgridmd.f90 4583 !/ ------------------------------------------------------------------- / 4584 SUBROUTINE WMRSPC 4585 !/ 4586 !/ +-----------------------------------+ 4587 !/ | WAVEWATCH III NOAA/NCEP | 4588 !/ | H. L. Tolman | 4589 !/ | FORTRAN 90 | 4590 !/ | Last update : 30-Oct-2009 | 4591 !/ +-----------------------------------+ 4592 !/ 4593 !/ 22-Sep-2005 : Origination. ( version 3.08 ) 4594 !/ 25-Jul-2006 : Point output grid added. ( version 3.10 ) 4595 !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 ) 4596 !/ (W. E. Rogers & T. J. Campbell, NRL) 4597 !/ 4598 ! 1. Purpose : 4599 ! 4600 ! Generate map with flogs for need of spectral grid conversion 4601 ! between models. 4602 ! 4603 ! 2. Method : 4604 ! 4605 ! Test of parameters as introduced before in W3IOBC. 4606 ! 4607 ! 3. Parameters : 4608 ! 4609 ! 4. Subroutines used : 4610 ! 4611 ! Name Type Module Description 4612 ! ---------------------------------------------------------------- 4613 ! STRACE Sur. W3SERVMD Subroutine tracing. 4614 ! ---------------------------------------------------------------- 4615 ! 4616 ! 5. Called by : 4617 ! 4618 ! Name Type Module Description 4619 ! ---------------------------------------------------------------- 4620 ! WMINIT Subr WMINITMD Multi-grid model initialization. 4621 ! ---------------------------------------------------------------- 4622 ! 4623 ! 6. Error messages : 4624 ! 4625 ! 7. Remarks : 4626 ! 4627 ! 8. Structure : 4628 ! 4629 ! See source code. 4630 ! 4631 ! 9. Switches : 4632 ! 4633 ! !/S Enable subroutine tracing. 4634 ! !/T Enable test output 4635 ! 4636 ! 10. Source code : 4637 ! 4638 !/ ------------------------------------------------------------------- / 4639 ! Page 93 Source Listing WMRSPC 2014-09-16 16:48 wmgridmd.f90 4640 USE W3GDATMD 4641 USE W3ODATMD, ONLY: UNIPTS 4642 USE WMMDATMD 4643 ! 4644 IMPLICIT NONE 4645 !/ 4646 !/ ------------------------------------------------------------------- / 4647 !/ Parameter list 4648 !/ 4649 !/ ------------------------------------------------------------------- / 4650 !/ Local parameters 4651 !/ 4652 INTEGER :: I, J, LOW 4653 !/ 4654 ! 4655 ! -------------------------------------------------------------------- / 4656 ! 0. Initializations 4657 ! 4658 IF ( UNIPTS ) THEN 4659 LOW = 0 4660 ELSE 4661 LOW = 1 4662 END IF 4663 IF ( .NOT. ALLOCATED(RESPEC) ) & 4664 ALLOCATE ( RESPEC(LOW:NRGRD,LOW:NRGRD) ) 4665 RESPEC = .FALSE. 4666 ! 4667 ! -------------------------------------------------------------------- / 4668 ! 1. Fill map with flags 4669 ! 4670 DO I=LOW, NRGRD 4671 DO J=I+1, NRGRD 4672 RESPEC(I,J) = SGRDS(I)%NK .NE. SGRDS(J)%NK .OR. & 4673 SGRDS(I)%NTH .NE. SGRDS(J)%NTH .OR. & 4674 SGRDS(I)%XFR .NE. SGRDS(J)%XFR .OR. & 4675 SGRDS(I)%FR1 .NE. SGRDS(J)%FR1 .OR. & 4676 SGRDS(I)%TH(1) .NE. SGRDS(J)%TH(1) 4677 RESPEC(J,I) = RESPEC(I,J) 4678 END DO 4679 END DO 4680 ! 4681 ! -------------------------------------------------------------------- / 4682 ! 2. Test output 4683 ! 4684 RETURN 4685 ! 4686 ! Formats 4687 ! 4688 !/ 4689 !/ End of WMRSPC ----------------------------------------------------- / 4690 !/ 4691 END SUBROUTINE WMRSPC Page 94 Source Listing WMRSPC 2014-09-16 16:48 Entry Points wmgridmd.f90 ENTRY POINTS Name wmgridmd_mp_wmrspc_ SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References ALLOCATED Func 3587 scalar 3587 FR1 Local 3599 R(4) 4 scalar 3599 I Local 3576 I(4) 4 scalar 3594,3595,3596,3597,3598,3599,3600 ,3601 J Local 3576 I(4) 4 scalar 3595,3596,3597,3598,3599,3600,3601 LOW Local 3576 I(4) 4 scalar 3583,3585,3588,3594 NK Local 3596 I(4) 4 scalar 3596 NRGRD Local 3588 I(4) 4 scalar 3588,3594,3595 NTH Local 3597 I(4) 4 scalar 3597 RESPEC Local 3587 L(4) 4 2 1 ALC 3587,3588,3589,3596,3601 SGRDS Local 3596 RECORD 1080 1 1 ALC,TGT 3596,3597,3598,3599,3600 TH Local 3600 R(4) 4 1 1 PTR 3600 UNIPTS Local 3565 L(4) 4 scalar 3565,3582 W3GDATMD Module 3564 3564 W3ODATMD Module 3565 3565 WMMDATMD Module 3566 3566 WMRSPC Subr 3508 XFR Local 3598 R(4) 4 scalar 3598 Page 95 Source Listing WMRSPC 2014-09-16 16:48 wmgridmd.f90 4692 !/ 4693 !/ End of module WMGRIDMD -------------------------------------------- / 4694 !/ 4695 END MODULE WMGRIDMD SYMBOL CROSS REFERENCE Name Object Declared Type Bytes Dimen Elements Attributes References WMGRIDMD Module 2 Page 96 Source Listing WMRSPC 2014-09-16 16:48 Subprograms/Common Blocks wmgridmd.f90 SUBPROGRAMS/COMMON BLOCKS Name Object Declared Type Bytes Dimen Elements Attributes References MPIPRIV1 Common 532 28 MPIPRIV2 Common 534 24 MPIPRIVC Common 537 2 WMGEQL Subr 2447 WMGHGH Subr 826 WMGLOW Subr 110 WMGRIDMD Module 2 WMRSPC Subr 3508 COMPILER OPTIONS BEING USED -align nocommons -align nodcommons -align noqcommons -align records -align nosequence -align norec1byte -align norec2byte -align norec4byte -align norec8byte -align norec16byte -altparam -assume accuracy_sensitive -assume nobscc -assume nobuffered_io -assume byterecl -assume cc_omp -assume nocstring -assume nodummy_aliases -assume nofpe_summary -assume noieee_fpe_flags -assume nominus0 -assume noold_boz -assume old_unit_star -assume old_ldout_format -assume noold_logical_ldio -assume old_maxminloc -assume old_xor -assume protect_constants -assume noprotect_parens -assume split_common -assume source_include -assume nostd_intent_in -assume nostd_mod_proc_name -assume norealloc_lhs -assume underscore -assume no2underscores -auto no -auto_scalar no -bintext -ccdefault default -check noargs -check noarg_temp_created -check nobounds -check noformat -check nooutput_conversion -check nooverflow -check nopointers -check power -check noshape -check nounderflow -check nouninitialized -coarray-num-procs 0 no -coarray-config-file -convert big_endian -cross_reference -D __INTEL_COMPILER=1210 -D __unix__ -D __unix -D __linux__ -D __linux -D __gnu_linux__ -D unix -D linux -D __ELF__ -D __x86_64 -D __x86_64__ -D _MT -D __INTEL_COMPILER_BUILD_DATE=20120612 -D _OPENMP=201107 -D __pentium4 -D __pentium4__ -D __tune_pentium4__ -D __SSE2__ -D __SSE3__ -D __SSSE3__ -D __SSE4_1__ -D __SSE4_2__ -D __SSE__ -D __MMX__ -D __AVX__ Page 97 Source Listing WMRSPC 2014-09-16 16:48 wmgridmd.f90 -double_size 64 no -d_lines no -Qdyncom -error_limit 30 no -f66 no -f77rtl no -fast -fpscomp nofilesfromcmd -fpscomp nogeneral -fpscomp noioformat -fpscomp noldio_spacing -fpscomp nologicals no -fpconstant -fpe3 -fprm nearest no -ftz -fp_model noprecise -fp_model fast -fp_model nostrict -fp_model nosource -fp_model nodouble -fp_model noextended -fp_model novery_fast -fp_model noexcept -fp_model nono_except -heap_arrays 0 no -threadprivate_compat -free -g0 -iface nomixed_str_len_arg -iface nono_mixed_str_len_arg no -intconstant -integer_size 32 no -mixed_str_len_arg no -module -names lowercase no -noinclude -openmp -O2 no -pad_source -real_size 32 no -recursive -reentrancy threaded no -sharable_localsaves -vec=simd -show noinclude -show map -show options no -syntax_only no -threadcom no -U no -vms -w noall -w nonone -w alignments -w noargument_checking -w nodeclarations -w general -w noignore_bounds -w noignore_loc -w nointerfaces -w notruncated_source -w uncalled -w uninitialized -w nounused -w usage -includepath : /usrx/local/intel/composerxe/tbb/include/,/usr/include/,./,/usrx/local/intel/impi/4.0.3.008/intel64/include/, /usrx/local/intel/impi/4.0.3.008/intel64/include/,/usrx/local/intel/composerxe/mkl/include/,/usrx/local/intel/composerxe/tbb/include/, /gpfs/gp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/intel64/,/gpfs/gp1/usrx/local/intel/composer_xe_2011_sp1.11.339/compiler/include/, /usr/local/include/,/usr/lib/gcc/x86_64-redhat-linux/4.4.7/include/,/usr/include/,/usr/include/ -list filename : wmgridmd.lst -o filename : none COMPILER: Intel(R) Fortran 12.1-2100