diff --git a/model/bin/build_utils.sh b/model/bin/build_utils.sh old mode 100644 new mode 100755 diff --git a/model/src/w3gdatmd.F90 b/model/src/w3gdatmd.F90 index 5c281eecb7..df55af7ff2 100644 --- a/model/src/w3gdatmd.F90 +++ b/model/src/w3gdatmd.F90 @@ -669,7 +669,7 @@ MODULE W3GDATMD REAL, POINTER :: CTRNX(:), CTRNY(:), CLATF(:) #endif REAL , POINTER :: SPCBAC(:,:), ANGARC(:) - REAL , POINTER :: XGRD(:,:), YGRD(:,:) ! X AND Y DEFINED ON IX,IY + DOUBLE PRECISION, POINTER :: XGRD(:,:), YGRD(:,:) ! X AND Y DEFINED ON IX,IY REAL , POINTER :: DXDP(:,:), DXDQ(:,:) ! DX/DP & DX/DQ DEFINED ON IX,IY REAL , POINTER :: DYDP(:,:), DYDQ(:,:) ! DY/DP & DY/DQ DEFINED ON IX,IY REAL , POINTER :: DPDX(:,:), DPDY(:,:) ! DP/DX & DP/DY DEFINED ON IX,IY @@ -727,7 +727,6 @@ MODULE W3GDATMD ! unstructured data ! INTEGER :: NTRI - DOUBLE PRECISION, POINTER :: XYB(:,:) INTEGER, POINTER :: TRIGP(:,:) #ifdef W3_PDLIB INTEGER :: NBND_MAP @@ -1078,9 +1077,6 @@ MODULE W3GDATMD ! INTEGER, POINTER :: NTRI,COUNTRI,COUNTOT,NNZ INTEGER :: optionCall = 3 ! take care all other options are basically wrong -! XYB may not be necessary now that we have XGRD and YGRD -! but these XGRD and YGRD should probably be double precision - DOUBLE PRECISION, POINTER :: XYB(:,:) INTEGER, POINTER :: TRIGP(:,:) #ifdef W3_PDLIB INTEGER, POINTER :: NBND_MAP @@ -1153,7 +1149,8 @@ MODULE W3GDATMD REAL, POINTER :: AnglD(:) LOGICAL, POINTER :: FLAGUNR #endif - REAL , POINTER :: ZB(:), CLATS(:) + REAL , POINTER :: ZB(:) + REAL , POINTER :: CLATS(:) REAL , POINTER :: CLATIS(:) ! INVERSE OF COS(LAT) DEFINED ON ISEA REAL , POINTER :: CTHG0S(:) ! TAN(Y)/R, DEFINED ON ISEA @@ -1162,7 +1159,7 @@ MODULE W3GDATMD REAL, POINTER :: CTRNX(:), CTRNY(:), CLATF(:) #endif REAL , POINTER :: SPCBAC(:,:), ANGARC(:) - REAL , POINTER :: XGRD(:,:), YGRD(:,:) ! X AND Y DEFINED ON IX,IY + DOUBLE PRECISION, POINTER :: XGRD(:,:), YGRD(:,:) ! X AND Y DEFINED ON IX,IY REAL , POINTER :: DXDP(:,:), DXDQ(:,:) ! DX/DP & DX/DQ DEFINED ON IX,IY REAL , POINTER :: DYDP(:,:), DYDQ(:,:) ! DY/DP & DY/DQ DEFINED ON IX,IY REAL , POINTER :: DPDX(:,:), DPDY(:,:) ! DP/DX & DP/DY DEFINED ON IX,IY @@ -1680,6 +1677,14 @@ SUBROUTINE W3DIMX ( IMOD, MX, MY, MSEA, NDSE, NDST & ! ! NB: Some array start at 0 because MAPFS(IY,IX)=0 for missing points ! + IF (GTYPE .NE. UNGTYPE) THEN + ALLOCATE ( GRIDS(IMOD)%ZB(MSEA), & + GRIDS(IMOD)%XGRD(MY,MX), & + GRIDS(IMOD)%YGRD(MY,MX), & + STAT=ISTAT ) + CHECK_ALLOC_STATUS ( ISTAT ) + ENDIF + ALLOCATE ( GRIDS(IMOD)%MAPSTA(MY,MX), & GRIDS(IMOD)%MAPST2(MY,MX), & GRIDS(IMOD)%MAPFS(MY,MX), & @@ -1688,14 +1693,11 @@ SUBROUTINE W3DIMX ( IMOD, MX, MY, MSEA, NDSE, NDST & #ifdef W3_RTD GRIDS(IMOD)%AnglD(MSEA), & #endif - GRIDS(IMOD)%ZB(MSEA), & GRIDS(IMOD)%CLATS(0:MSEA), & GRIDS(IMOD)%CLATIS(0:MSEA), & GRIDS(IMOD)%CTHG0S(0:MSEA), & GRIDS(IMOD)%TRNX(MY,MX), & GRIDS(IMOD)%TRNY(MY,MX), & - GRIDS(IMOD)%XGRD(MY,MX), & - GRIDS(IMOD)%YGRD(MY,MX), & GRIDS(IMOD)%DXDP(MY,MX), & GRIDS(IMOD)%DXDQ(MY,MX), & GRIDS(IMOD)%DYDP(MY,MX), & @@ -2350,7 +2352,6 @@ SUBROUTINE W3SETG ( IMOD, NDSE, NDST ) ! GNAME => GRIDS(IMOD)%GNAME FILEXT => GRIDS(IMOD)%FILEXT - XYB => GRIDS(IMOD)%XYB TRIGP => GRIDS(IMOD)%TRIGP #ifdef W3_PDLIB NBND_MAP => GRIDS(IMOD)%NBND_MAP @@ -2392,7 +2393,9 @@ SUBROUTINE W3SETG ( IMOD, NDSE, NDST ) MAXX => GRIDS(IMOD)%MAXX MAXY => GRIDS(IMOD)%MAXY DXYMAX => GRIDS(IMOD)%DXYMAX - + XGRD => GRIDS(IMOD)%XGRD + YGRD => GRIDS(IMOD)%YGRD + ZB => GRIDS(IMOD)%ZB ! IF ( GINIT ) THEN ! @@ -2405,15 +2408,12 @@ SUBROUTINE W3SETG ( IMOD, NDSE, NDST ) #ifdef W3_RTD AnglD => GRIDS(IMOD)%AnglD #endif - ZB => GRIDS(IMOD)%ZB CLATS => GRIDS(IMOD)%CLATS CLATIS => GRIDS(IMOD)%CLATIS CTHG0S => GRIDS(IMOD)%CTHG0S TRNX => GRIDS(IMOD)%TRNX TRNY => GRIDS(IMOD)%TRNY ! - XGRD => GRIDS(IMOD)%XGRD - YGRD => GRIDS(IMOD)%YGRD DXDP => GRIDS(IMOD)%DXDP DXDQ => GRIDS(IMOD)%DXDQ DYDP => GRIDS(IMOD)%DYDP @@ -2990,7 +2990,7 @@ SUBROUTINE W3GNTX ( IMOD, NDSE, NDST ) !!Li SMC grid shares the settings with rectilinear grid. JGLi12Oct2020 CASE ( RLGTYPE, SMCTYPE ) CALL W3CGDM( IJG, FLAGLL, ICLOSE, PTILED, QTILED, & - PRANGE, QRANGE, LBI, UBI, LBO, UBO, XGRD, YGRD, & + PRANGE, QRANGE, LBI, UBI, LBO, UBO, REAL(XGRD), REAL(YGRD), & NFD=NFD, SPHERE=SPHERE, DX=SX, DY=SY, & DXDP=DXDP, DYDP=DYDP, DXDQ=DXDQ, DYDQ=DYDQ, & DPDX=DPDX, DPDY=DPDY, DQDX=DQDX, DQDY=DQDY, & @@ -3005,7 +3005,7 @@ SUBROUTINE W3GNTX ( IMOD, NDSE, NDST ) END IF CASE ( CLGTYPE ) CALL W3CGDM( IJG, FLAGLL, ICLOSE, PTILED, QTILED, & - PRANGE, QRANGE, LBI, UBI, LBO, UBO, XGRD, YGRD, & + PRANGE, QRANGE, LBI, UBI, LBO, UBO, REAL(XGRD), REAL(YGRD), & NFD=NFD, SPHERE=SPHERE, & DXDP=DXDP, DYDP=DYDP, DXDQ=DXDQ, DYDQ=DYDQ, & DPDX=DPDX, DPDY=DPDY, DQDX=DQDX, DQDY=DQDY, & @@ -3191,8 +3191,10 @@ SUBROUTINE W3DIMUG ( IMOD, MTRI, MX, COUNTOTA, NNZ, NDSE, NDST ) ! 2. Allocate arrays ! ALLOCATE ( GRIDS(IMOD)%TRIGP(MTRI,3), & - GRIDS(IMOD)%XYB(MX,3), & GRIDS(IMOD)%SI(MX), & + GRIDS(IMOD)%XGRD(1,MX), & + GRIDS(IMOD)%YGRD(1,MX), & + GRIDS(IMOD)%ZB(MX), & GRIDS(IMOD)%TRIA(MTRI), & GRIDS(IMOD)%CROSSDIFF(6,MTRI), & GRIDS(IMOD)%IEN(MTRI,6), & diff --git a/model/src/w3gridmd.F90 b/model/src/w3gridmd.F90 index 63117b0138..1d45c35bff 100644 --- a/model/src/w3gridmd.F90 +++ b/model/src/w3gridmd.F90 @@ -3984,7 +3984,7 @@ SUBROUTINE W3GRID() ! CALL READMSH(NDSG,FNAME) ALLOCATE(ZBIN(NX, NY),OBSX(NX,NY),OBSY(NX,NY)) - ZBIN(:,1) = VSC*XYB(:,3) + ZBIN(:,1) = VSC * ZB(:) #ifdef W3_DEBUGSTP WRITE(740,*) 'VSC=', VSC WRITE(740,*) 'Printing ZBIN 1' @@ -4885,8 +4885,8 @@ SUBROUTINE W3GRID() X = FACTOR * ( XGRDIN(IX,IY) ) Y = FACTOR * ( YGRDIN(IX,IY) ) ELSE - X = FACTOR * XYB(IX,1) - Y = FACTOR * XYB(IX,2) + X = FACTOR * XGRD(1,IX) + Y = FACTOR * YGRD(1,IX) END IF IF ( TMPSTA(IY,IX).EQ.2 ) THEN IF ( FLAGLL ) THEN @@ -4949,15 +4949,7 @@ SUBROUTINE W3GRID() DEALLOCATE ( XGRDIN, YGRDIN ) CALL W3GNTX ( 1, 6, 6 ) ELSE -! -!FA: This distinction between structured and unstructured -! should be removed when XYB is replaced by XGRD and YGRD -! - DO IX=1, NX - XGRD(:,IX) = XYB(IX,1) - YGRD(:,IX) = XYB(IX,2) - END DO - END IF ! GTYPE + END IF ! GTYPE ! #ifdef W3_SMC !!Li Shelter MAPSTA LLG definition for SMC diff --git a/model/src/w3initmd.F90 b/model/src/w3initmd.F90 index 7b5ae4b453..4cd3e34e76 100644 --- a/model/src/w3initmd.F90 +++ b/model/src/w3initmd.F90 @@ -388,7 +388,7 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & USE W3GDATMD, ONLY: GTYPE, UNGTYPE #ifdef W3_PDLIB USE PDLIB_W3PROFSMD, ONLY : PDLIB_MAPSTA_INIT, VA_SETUP_IOBPD - USE PDLIB_W3PROFSMD, ONLY : BLOCK_SOLVER_INIT, PDLIB_STYLE_INIT + USE PDLIB_W3PROFSMD, ONLY : BLOCK_SOLVER_INIT, PDLIB_INIT use yowDatapool, only: istatus #endif #ifdef W3_SETUP @@ -720,23 +720,23 @@ SUBROUTINE W3INIT ( IMOD, IsMulti, FEXT, MDS, MTRACE, ODAT & #ifdef W3_PDLIB ELSE #ifdef W3_DEBUGINIT - WRITE(*,*) 'Before PDLIB_STYLE_INIT, IMOD=', IMOD + WRITE(*,*) 'Before PDLIB_INIT, IMOD=', IMOD #endif - CALL PDLIB_STYLE_INIT(IMOD) + CALL PDLIB_INIT(IMOD) #ifdef W3_DEBUGINIT WRITE(740+IAPROC,*) 'After set up of NSEAL, NSEALM=', NSEALM - WRITE(740+IAPROC,*) 'After PDLIB_STYLE_INIT' + WRITE(740+IAPROC,*) 'After PDLIB_INIT' WRITE(740+IAPROC,*) 'allocated(ISEA_TO_JSEA)=', allocated(ISEA_TO_JSEA) FLUSH(740+IAPROC) #endif #endif #ifdef W3_TIMINGS - CALL PRINT_MY_TIME("After PDLIB_STYLE_INIT") + CALL PRINT_MY_TIME("After PDLIB_INIT") #endif #ifdef W3_PDLIB #ifdef W3_DEBUGINIT - WRITE(*,*) 'After PDLIB_STYLE_INIT, IMOD=', IMOD + WRITE(*,*) 'After PDLIB_INIT, IMOD=', IMOD #endif CALL SYNCHRONIZE_IPGL_ETC_ARRAY(IMOD, IsMulti) END IF diff --git a/model/src/w3iogrmd.F90 b/model/src/w3iogrmd.F90 index f93b0c2279..2775bcfb43 100644 --- a/model/src/w3iogrmd.F90 +++ b/model/src/w3iogrmd.F90 @@ -318,6 +318,8 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) CHARACTER(LEN=35) :: IDTST CHARACTER(LEN=60) :: MESSAGE(5) LOGICAL :: GLOBAL + + REAL, ALLOCATABLE :: XGRD4(:,:), YGRD4(:,:) !/ !/ ------------------------------------------------------------------- / !/ @@ -731,7 +733,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) SX, SY, X0, Y0 CASE ( CLGTYPE ) WRITE (NDSM) & - XGRD, YGRD + REAL(XGRD), REAL(YGRD) CASE (UNGTYPE) WRITE (NDSM) & FSN, FSPSI,FSFCT,FSNIMP,FSTOTALIMP,FSTOTALEXP, & @@ -754,7 +756,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) !removed COUNTCON=0 WRITE (NDSM) & - X0, Y0, SX, SY, DXYMAX, XYB, TRIGP, TRIA, & + X0, Y0, SX, SY, DXYMAX, XGRD, YGRD, TRIGP, TRIA, & LEN, IEN, ANGLE0, ANGLE, SI, MAXX, MAXY, & DXYMAX, INDEX_CELL, CCON, COUNTCON, IE_CELL, & POS_CELL, IOBP, IOBPA, IOBDP, IOBPD, IAA, JAA, POSI @@ -836,14 +838,18 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & SX, SY, X0, Y0 DO IX=1,NX - XGRD(:,IX) = X0 + REAL(IX-1)*SX + XGRD(:,IX) = REAL(X0 + REAL(IX-1)*SX) END DO DO IY=1,NY - YGRD(IY,:) = Y0 + REAL(IY-1)*SY + YGRD(IY,:) = REAL(Y0 + REAL(IY-1)*SY) END DO CASE ( CLGTYPE ) + ALLOCATE(XGRD4(NY,NX),YGRD4(NY,NX)); XGRD4 = 0.; YGRD4 = 0. READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - XGRD, YGRD + XGRD4, YGRD4 + XGRD = XGRD4 + YGRD = YGRD4 + DEALLOCATE(XGRD4, YGRD4) !Set SX, SY, X0, Y0 to large values if curvilinear grid X0 = HUGE(X0); Y0 = HUGE(Y0) SX = HUGE(SX); SY = HUGE(SY) @@ -890,7 +896,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) FLUSH(740+IAPROC) #endif READ (NDSM,END=801,ERR=802,IOSTAT=IERR) & - X0, Y0, SX, SY, DXYMAX, XYB, TRIGP, TRIA, & + X0, Y0, SX, SY, DXYMAX, XGRD, YGRD, TRIGP, TRIA, & LEN, IEN, ANGLE0, ANGLE, SI, MAXX, MAXY, & DXYMAX, INDEX_CELL, CCON, COUNTCON, IE_CELL, & POS_CELL, IOBP, IOBPA, IOBDP, IOBPD, IAA, JAA, POSI @@ -905,8 +911,7 @@ SUBROUTINE W3IOGR ( INXOUT, NDSM, IMOD, FEXT ) call printMallInfo(IAPROC,mallInfos) #endif - XGRD(1,:)=XYB(:,1) - YGRD(1,:)=XYB(:,2) + #ifdef W3_DEBUGIOGR WRITE(740+IAPROC,*) 'W3IOGR, step 7.7' FLUSH(740+IAPROC) diff --git a/model/src/w3iopomd.F90 b/model/src/w3iopomd.F90 index b915682f4e..554dc3855c 100644 --- a/model/src/w3iopomd.F90 +++ b/model/src/w3iopomd.F90 @@ -214,7 +214,7 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD ) RLGTYPE, CLGTYPE, UNGTYPE, GTYPE, FLAGLL, & ICLOSE,ICLOSE_NONE,ICLOSE_SMPL,ICLOSE_TRPL, & MAPSTA, MAPFS, FILEXT, ZB, TRNX, TRNY - USE W3GDATMD, ONLY: XYB, TRIGP,MAXX, MAXY, DXYMAX + USE W3GDATMD, ONLY: TRIGP,MAXX, MAXY, DXYMAX #ifdef W3_RTD !! Use rotated N-Pole lat/lon and conversion sub. JGLi12Jun2012 USE W3GDATMD, ONLY: PoLat, PoLon, FLAGUNR @@ -330,7 +330,7 @@ SUBROUTINE W3IOPP ( NPT, XPT, YPT, PNAMES, IMOD ) IF (GTYPE .NE. UNGTYPE) THEN INGRID = W3GRMP( GSU, XPT(IPT), YPT(IPT), IX, IY, RD ) ELSE - CALL IS_IN_UNGRID(IMOD, XPT(IPT), YPT(IPT), itout, IX, IY, RD) + CALL IS_IN_UNGRID(IMOD, DBLE(XPT(IPT)), DBLE(YPT(IPT)), itout, IX, IY, RD) INGRID = (ITOUT.GT.0) END IF ! diff --git a/model/src/w3iotrmd.F90 b/model/src/w3iotrmd.F90 index b9d80d1b42..788da97257 100644 --- a/model/src/w3iotrmd.F90 +++ b/model/src/w3iotrmd.F90 @@ -193,7 +193,7 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) #ifdef W3_T USE W3GSRUMD, ONLY: W3GSUP #endif - USE W3GDATMD, ONLY: XYB, MAXX, MAXY, GTYPE, UNGTYPE + USE W3GDATMD, ONLY: MAXX, MAXY, GTYPE, UNGTYPE USE W3WDATMD, ONLY: TIME, UST USE W3ADATMD, ONLY: CG, DW, CX, CY, UA, UD, AS #ifdef W3_MPI @@ -530,9 +530,9 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) IX = IXX(J) IY = IYY(J) IF(GTYPE .EQ. UNGTYPE) THEN - X = XYB(IX,1) - Y = XYB(IX,2) - ENDIF + X = XGRD(1,IX) + Y = YGRD(1,IX) + ENDIF MASK1(IY,IX) = MASK1(IY,IX) .OR. FLAG1 MASK2(IY,IX) = MASK2(IY,IX) .OR. FLAG2 TRCKID(IY,IX) = TRCKT @@ -617,8 +617,8 @@ SUBROUTINE W3IOTR ( NDSINP, NDSOUT, A, IMOD ) IF ( MASK1(IY,IX) ) THEN ! IF(GTYPE .EQ. UNGTYPE) THEN - X = XYB(IX,1) - Y = XYB(IX,2) + X = XGRD(1,IX) + Y = YGRD(1,IX) ELSE X = XGRD(IY,IX) Y = YGRD(IY,IX) diff --git a/model/src/w3profsmd.F90 b/model/src/w3profsmd.F90 index 211d20af16..4707693ba1 100644 --- a/model/src/w3profsmd.F90 +++ b/model/src/w3profsmd.F90 @@ -343,7 +343,7 @@ SUBROUTINE W3CFLUG ( ISEA, NKCFL, FACX, FACY, DT, MAPFS, CFLXYMAX, & FLCX, FLCY, NK, NTH, DTH, XFR, & ECOS, ESIN, SIG, PFMOVE,IEN, INDEX_CELL, & NTRI, TRIGP, CCON , & - IE_CELL, POS_CELL, COUNTRI, SI, IOBP, XYB + IE_CELL, POS_CELL, COUNTRI, SI, IOBP USE W3ADATMD, ONLY: CG, CX, CY, ATRNX, ATRNY, ITIME, DW USE W3IDATMD, ONLY: FLCUR @@ -525,7 +525,7 @@ SUBROUTINE W3XYPFSN2 ( ISP, C, LCALC, RD10, RD20, DT, AC) !/ USE W3GDATMD, ONLY : NK, NTH, NTRI, NX, CCON, IE_CELL,POS_CELL, SI, & IEN, TRIGP, CLATS, MAPSF, IOBPD, IOBP, IOBDP, & - IOBPA, XYB, FSBCCFL + IOBPA, FSBCCFL #ifdef W3_REF1 USE W3GDATMD, ONLY : REFPARS #endif diff --git a/model/src/w3profsmd_pdlib.F90 b/model/src/w3profsmd_pdlib.F90 index 7813a1ce5f..a9fba9ad98 100644 --- a/model/src/w3profsmd_pdlib.F90 +++ b/model/src/w3profsmd_pdlib.F90 @@ -114,6 +114,8 @@ MODULE PDLIB_W3PROFSMD INTEGER, ALLOCATABLE :: IS0_pdlib(:) INTEGER :: FreqShiftMethod = 2 LOGICAL :: FSGEOADVECT + INTEGER :: POS_TRICK(3,2) + #ifdef W3_DEBUGSRC INTEGER :: TESTNODE = 1 #endif @@ -209,7 +211,7 @@ SUBROUTINE VA_SETUP_IOBPD END IF END SUBROUTINE !/ ------------------------------------------------------------------- / - SUBROUTINE PDLIB_STYLE_INIT(IMOD) + SUBROUTINE PDLIB_INIT(IMOD) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -259,8 +261,11 @@ SUBROUTINE PDLIB_STYLE_INIT(IMOD) #endif ! USE W3GDATMD, ONLY: FLCX, FLCY +#ifdef W3_MEMCHECK + USE MallocInfo_m +#endif USE CONSTANTS, ONLY : GRAV, TPI - USE W3GDATMD, ONLY: XYB, XGRD, YGRD, NX, NSEA, NTRI, TRIGP, NSPEC + USE W3GDATMD, ONLY: XGRD, YGRD, NX, NSEA, NTRI, TRIGP, NSPEC, ZB USE W3GDATMD, ONLY: MAPSTA, MAPFS, GRIDS, NTH USE W3GDATMD, ONLY: IOBP, IOBPD, IOBP_loc, IOBPD_loc, SIG, NK USE W3GDATMD, ONLY: TRIA, IEN, LEN, ANGLE, ANGLE0 @@ -307,22 +312,24 @@ SUBROUTINE PDLIB_STYLE_INIT(IMOD) REAL :: eSIG, eFR REAL, PARAMETER :: COEF4 = 5.0E-7 #ifdef W3_S - CALL STRACE (IENT, 'PDLIB_STYLE_INIT') + CALL STRACE (IENT, 'PDLIB_INIT') #endif #ifdef W3_DEBUGSOLVER - WRITE(740+IAPROC,*) 'PDLIB_STYLE_INIT, IMOD (no print)' + WRITE(740+IAPROC,*) 'PDLIB_INIT, IMOD (no print)' WRITE(740+IAPROC,*) 'NAPROC=', NAPROC WRITE(740+IAPROC,*) 'NTPROC=', NTPROC FLUSH(740+IAPROC) #endif - PDLIB_NSEAL=0 + + PDLIB_NSEAL = 0 + IF (IAPROC .le. NAPROC) THEN ALLOCATE(XP_IN(NX), YP_IN(NX), DEP_IN(NX), stat=istat) if(istat /= 0) CALL PDLIB_ABORT(1) DO I=1,NX - XP_IN(I)=XYB(I,1) - YP_IN(I)=XYB(I,2) - DEP_IN(I)=XYB(I,3) + XP_IN(I) = xgrd(1,I) + YP_IN(I) = ygrd(1,I) + DEP_IN(I) = ZB(I) END DO ALLOCATE(INE_IN(3,NTRI), stat=istat) if(istat /= 0) CALL PDLIB_ABORT(2) @@ -333,9 +340,9 @@ SUBROUTINE PDLIB_STYLE_INIT(IMOD) END DO CALL MPI_COMM_RANK(MPI_COMM_WCMP, myrank, ierr) #ifdef W3_DEBUGSOLVER - WRITE(740+IAPROC,*) 'PDLIB_STYLE_INIT, IAPROC=', IAPROC - WRITE(740+IAPROC,*) 'PDLIB_STYLE_INIT, NAPROC=', NAPROC - WRITE(740+IAPROC,*) 'PDLIB_STYLE_INIT, myrank=', myrank + WRITE(740+IAPROC,*) 'PDLIB_INIT, IAPROC=', IAPROC + WRITE(740+IAPROC,*) 'PDLIB_INIT, NAPROC=', NAPROC + WRITE(740+IAPROC,*) 'PDLIB_INIT, myrank=', myrank FLUSH(740+IAPROC) #endif ! @@ -403,9 +410,9 @@ SUBROUTINE PDLIB_STYLE_INIT(IMOD) FLUSH(740+IAPROC) #endif END IF - FSGEOADVECT=.FALSE. + FSGEOADVECT = .FALSE. IF ((FLCX .eqv. .TRUE.).and.(FLCY .eqv. .TRUE.)) THEN - FSGEOADVECT=.TRUE. + FSGEOADVECT =.TRUE. END IF ! ! Compute NSEALM @@ -419,7 +426,7 @@ SUBROUTINE PDLIB_STYLE_INIT(IMOD) NSEAL_arr(IPROC)=IScal(1) END DO PDLIB_NSEALM=maxval(NSEAL_arr) - deALLOCATE(NSEAL_arr) + DEALLOCATE(NSEAL_arr) ELSE IScal(1)=PDLIB_NSEAL CALL MPI_SEND(IScal,1,MPI_INT, 0, 23, MPI_COMM_WAVE, IERR_MPI) @@ -476,7 +483,7 @@ SUBROUTINE PDLIB_STYLE_INIT(IMOD) !/ !/ End of PDLIB_STYLE_INIT ------------------------------------------- / !/ - END SUBROUTINE PDLIB_STYLE_INIT + END SUBROUTINE PDLIB_INIT !/ ------------------------------------------------------------------- / SUBROUTINE PDLIB_MAPSTA_INIT(IMOD) !/ @@ -1374,6 +1381,7 @@ SUBROUTINE PDLIB_W3XYPFSPSI2 ( ISP, C, LCALC, RD10, RD20, DT, AC) END IF ST(NI) = ST(NI) + THETA_L ! the 2nd term are the theta values of each node ... END DO + DO IP = 1, npa IP_glob=iplg(IP) U(IP) = MAX(ZERO,U(IP)-DTSI(IP)*ST(IP)*(1-IOBPA(IP_glob)))*DBLE(IOBPD(ITH,IP_glob))*IOBDP(IP_glob) diff --git a/model/src/w3ref1md.F90 b/model/src/w3ref1md.F90 index 87a54d1a17..01fd0b93c2 100644 --- a/model/src/w3ref1md.F90 +++ b/model/src/w3ref1md.F90 @@ -151,7 +151,7 @@ SUBROUTINE W3SREF(A, CG, WN, EMEAN, FMEAN, DEPTH, CX1, CY1, REFLC, REFLD, & REFPARS, ECOS, ESIN, EC2, MAPTH, MAPWN, FLAGLL, & SIG2, DSII, IOBPD, GTYPE, UNGTYPE, MAPFS, & CLGTYPE, RLGTYPE, SMCTYPE - USE W3GDATMD, ONLY : XYB, CLATS, HPFAC, HQFAC, SX, SY, SI + USE W3GDATMD, ONLY : CLATS, HPFAC, HQFAC, SX, SY, SI #ifdef W3_IG1 USE W3GDATMD, ONLY : IGPARS USE W3GIG1MD diff --git a/model/src/w3triamd.F90 b/model/src/w3triamd.F90 index 34065fc3cc..e083d57a29 100644 --- a/model/src/w3triamd.F90 +++ b/model/src/w3triamd.F90 @@ -53,8 +53,8 @@ MODULE W3TRIAMD ! The only point index which is needed is IX and NX stands for the total number of grid point. ! IY and NY are not needed anymore, they are set to 1 in the unstructured case ! Some noticeable arrays are: -! XYB : give the 2D coordinates of all grid points -! TRIGP : give the vertices of each triangle +! XGRD, YGRD : give the 2D coordinates of all grid points +! TRIGP : give the vertices of each triangle ! 8. Structure : ! ! 9. Switches : @@ -164,7 +164,7 @@ SUBROUTINE READMSH(NDS,FNAME) ! The only point index which is needed is IX and NX stands for the total number of grid point. ! IY and NY are not needed anymore, they are set to 1 in the unstructured case ! Some noticeable arrays are: -! XYB : give the 2D coordinates of all grid points +! XGRD,YGRD : give the 2D coordinates of all grid points ! TRIGP : give the vertices of each triangle ! GMSH file gives too much information that is not necessarily required so data processing is needed (data sort and nesting). ! 8. Structure : @@ -175,7 +175,7 @@ SUBROUTINE READMSH(NDS,FNAME) ! !/ ------------------------------------------------------------------- / USE W3ODATMD, ONLY: NDSE, NDST, NDSO - USE W3GDATMD + USE W3GDATMD, ONLY: ZB, XGRD, YGRD, NTRI, NX, COUNTOT, TRIGP, NNZ, W3DIMUG USE W3SERVMD, ONLY: ITRACE, NEXTLN, EXTCDE USE CONSTANTS, only: LPDLIB USE W3ODATMD, ONLY: IAPROC @@ -325,15 +325,15 @@ SUBROUTINE READMSH(NDS,FNAME) ! fills arrays ! DO I = 1, NX - XYB(I,1) = XYBTMP2(I,1) - XYB(I,2) = XYBTMP2(I,2) - XYB(I,3) = XYBTMP2(I,3) + XGRD(1,I) = XYBTMP2(I,1) + YGRD(1,I) = XYBTMP2(I,2) + ZB(I) = XYBTMP2(I,3) END DO ! #ifdef W3_DEBUGSTP - WRITE(740,*) 'Writing XYB(:,3)' + WRITE(740,*) 'Writing ZB(:)' DO I=1,NX - WRITE(740,*) 'I,XYB(I,3)=', I, XYB(I,3) + WRITE(740,*) 'I, ZB(I) = ', I, ZB(I) END DO FLUSH(740) #endif @@ -780,7 +780,7 @@ SUBROUTINE SPATIAL_GRID I2 = TRIGP(K,2) I3 = TRIGP(K,3) - CALL FIX_PERIODCITY(I1,I2,I3,XYB,PT) + CALL FIX_PERIODCITY(I1,I2,I3,XGRD,YGRD,PT) ! ! cross product of edge-vector (orientated anticlockwise) ! @@ -800,8 +800,8 @@ SUBROUTINE SPATIAL_GRID I2 = TRIGP(K,2) I3 = TRIGP(K,3) TRIA(K) = -1.d0*TRIA(K) - WRITE(NDSE,*) 'WRONG TRIANGLE',TRIA(K),K,I1,I2,I3, XYB(I2,2)-XYB(I1,2), & - XYB(I1,1)-XYB(I3,1),XYB(I3,2)-XYB(I1,2), XYB(I2,1)-XYB(I1,1) + WRITE(NDSE,*) 'WRONG TRIANGLE',TRIA(K),K,I1,I2,I3, YGRD(1,I2)-YGRD(1,I1), & + XGRD(1,I1)-XGRD(1,I3),YGRD(1,I3)-YGRD(1,I1), XGRD(1,I2)-XGRD(1,I1) STOP END IF END DO @@ -863,6 +863,7 @@ SUBROUTINE NVECTRI ! INTEGER :: IP, IE INTEGER :: I1, I2, I3, I11, I22, I33 +! REAL*8 :: P1(2), P2(2), P3(2) REAL*8 :: R1(2), R2(2), R3(2) REAL*8 :: N1(2), N2(2), N3(2) @@ -876,8 +877,7 @@ SUBROUTINE NVECTRI #ifdef W3_S CALL STRACE (IENT, 'NVECTRI') #endif - - +! DO IE = 1, NTRI ! ! vertices @@ -886,7 +886,7 @@ SUBROUTINE NVECTRI I2 = TRIGP(IE,2) I3 = TRIGP(IE,3) - CALL FIX_PERIODCITY(I1,I2,I3,XYB,PT) + CALL FIX_PERIODCITY(I1,I2,I3,XGRD,YGRD,PT) P1(1) = PT(1,1) P1(2) = PT(1,2) @@ -924,7 +924,7 @@ SUBROUTINE NVECTRI IEN(IE,6) = N3(2) END DO - + END SUBROUTINE !/--------------------------------------------------------------------------- @@ -1092,13 +1092,13 @@ SUBROUTINE COORDMAX ! ! maximum of coordinates s ! - MAXX = MAXVAL(XYB(:,1)) - MAXY = MAXVAL(XYB(:,2)) + MAXX = MAXVAL(XGRD(1,:)) + MAXY = MAXVAL(YGRD(1,:)) ! ! minimum of coordinates ! - X0 = MINVAL(XYB(:,1)) - Y0 = MINVAL(XYB(:,2)) + X0 = MINVAL(XGRD(1,:)) + Y0 = MINVAL(YGRD(1,:)) ! !maximum and minimum length of edges ! @@ -1202,14 +1202,14 @@ SUBROUTINE AREA_SI(IMOD) SI(I1) = SI(I1) + TRIA03 SI(I2) = SI(I2) + TRIA03 SI(I3) = SI(I3) + TRIA03 - ENDDO + ENDDO CELLVERTEX(:,:,:) = 0 ! Stores for each node the Elementnumbers of the connected Elements - ! and the Position of the position of the Node in the Element Index + ! and the Position of the Node in the Element Index WRITE(*,'("+TRACE......",A)') 'COMPUTE CELLVERTEX' - CHILF = 0 + CHILF = 0 DO IE = 1, NTRI DO J=1,3 @@ -1225,7 +1225,6 @@ SUBROUTINE AREA_SI(IMOD) ! Second step in storage, the initial 3D array CELLVERTEX, is transformed in a 1D array ! the global index is J . From now, all the computation step based on these arrays must ! abide by the conservation of the 2 loop algorithm (points + connected triangles) -! AR: I will change this now to pointers in order to omit fix loop structure for the LTS stuff ... ! INDEX_CELL(1)=1 J = 0 @@ -1424,8 +1423,6 @@ SUBROUTINE IS_IN_UNGRID(IMOD, XTIN, YTIN, ITOUT, IS, JS, RW) ! ! 10. Source code : ! - - ! 2. Method : ! ! Using barycentric coordinates. Each coefficient depends on the mass of its related point in the interpolation. @@ -1471,7 +1468,7 @@ SUBROUTINE IS_IN_UNGRID(IMOD, XTIN, YTIN, ITOUT, IS, JS, RW) ! Parameter list INTEGER, INTENT(IN) :: IMOD - REAL , INTENT(IN) :: XTIN, YTIN + DOUBLE PRECISION, INTENT(IN) :: XTIN, YTIN INTEGER, INTENT(OUT) :: itout INTEGER, INTENT(OUT) :: IS(4), JS(4) REAL, INTENT(OUT) :: RW(4) @@ -1500,7 +1497,7 @@ SUBROUTINE IS_IN_UNGRID(IMOD, XTIN, YTIN, ITOUT, IS, JS, RW) I2=GRIDS(IMOD)%TRIGP(ITRI,2) I3=GRIDS(IMOD)%TRIGP(ITRI,3) - CALL FIX_PERIODCITY(I1,I2,I3,GRIDS(IMOD)%XYB,PT) + CALL FIX_PERIODCITY(I1,I2,I3,GRIDS(IMOD)%XGRD,GRIDS(IMOD)%YGRD,PT) ! coordinates of the first vertex A x1 = PT(1,1) y1 = PT(1,2) @@ -1649,7 +1646,7 @@ SUBROUTINE IS_IN_UNGRID2(IMOD, XTIN, YTIN, FORCE, ITOUT, IS, JS, RW) ! Parameter list INTEGER, INTENT(IN) :: IMOD, FORCE - REAL , INTENT(IN) :: XTIN, YTIN + DOUBLE PRECISION, INTENT(IN) :: XTIN, YTIN INTEGER, INTENT(OUT) :: itout INTEGER, INTENT(OUT) :: IS(4), JS(4) REAL, INTENT(OUT) :: RW(4) @@ -1681,14 +1678,14 @@ SUBROUTINE IS_IN_UNGRID2(IMOD, XTIN, YTIN, FORCE, ITOUT, IS, JS, RW) I2=GRIDS(IMOD)%TRIGP(ITRI,2) I3=GRIDS(IMOD)%TRIGP(ITRI,3) ! coordinates of the first vertex A - x1=GRIDS(IMOD)%XYB(I1,1) - y1=GRIDS(IMOD)%XYB(I1,2) + x1=GRIDS(IMOD)%XGRD(1,I1) + y1=GRIDS(IMOD)%YGRD(1,I1) ! coordinates of the 2nd vertex B - x2=GRIDS(IMOD)%XYB(I2,1) - y2=GRIDS(IMOD)%XYB(I2,2) + x2=GRIDS(IMOD)%XGRD(1,I2) + y2=GRIDS(IMOD)%XGRD(1,I2) !coordinates of the 3rd vertex C - x3=GRIDS(IMOD)%XYB(I3,1) - y3=GRIDS(IMOD)%XYB(I3,2) + x3=GRIDS(IMOD)%XGRD(1,I3) + y3=GRIDS(IMOD)%YGRD(1,I3) !with M = (XTIN,YTIN) the target point ... !vector product of AB and AC sg3=(y3-y1)*(x2-x1)-(x3-x1)*(y2-y1) @@ -1733,14 +1730,14 @@ SUBROUTINE IS_IN_UNGRID2(IMOD, XTIN, YTIN, FORCE, ITOUT, IS, JS, RW) I2=GRIDS(IMOD)%TRIGP(ITRI,2) I3=GRIDS(IMOD)%TRIGP(ITRI,3) ! coordinates of the first vertex A - x1=GRIDS(IMOD)%XYB(I1,1) - y1=GRIDS(IMOD)%XYB(I1,2) + x1=GRIDS(IMOD)%XGRD(1,I1) + y1=GRIDS(IMOD)%YGRD(1,I1) ! coordinates of the 2nd vertex B - x2=GRIDS(IMOD)%XYB(I2,1) - y2=GRIDS(IMOD)%XYB(I2,2) + x2=GRIDS(IMOD)%XGRD(1,I2) + y2=GRIDS(IMOD)%YGRD(1,I2) !coordinates of the 3rd vertex C - x3=GRIDS(IMOD)%XYB(I3,1) - y3=GRIDS(IMOD)%XYB(I3,2) + x3=GRIDS(IMOD)%XGRD(1,I3) + y3=GRIDS(IMOD)%YGRD(1,I3) D1=(XTIN-X1)**2+(YTIN-Y1)**2 D2=(XTIN-X2)**2+(YTIN-Y2)**2 D3=(XTIN-X3)**2+(YTIN-Y3)**2 @@ -1948,7 +1945,7 @@ SUBROUTINE W3NESTUG(DISTMIN,FLOK) #endif ! USE W3ODATMD, ONLY: NBI, NDSE, ISBPI, XBPI, YBPI - USE W3GDATMD, ONLY: NX, XYB, XGRD, YGRD, MAPSTA, MAPFS, MAPSF + USE W3GDATMD, ONLY: NX, XGRD, YGRD, MAPSTA, MAPFS, MAPSF REAL, INTENT(IN) :: DISTMIN @@ -1976,18 +1973,18 @@ SUBROUTINE W3NESTUG(DISTMIN,FLOK) #ifdef W3_T WRITE(NDSE ,*)'ADDING BOUNDARY POINT:',N,IX #endif - END IF - END DO + END IF + END DO ! !2. Matches the model grid points (where MAPSTA = 2) with the points in nest.ww3 ! For this, we use the nearest point in the nest file. -! +! DO I = 1, NBI !FA: This will not work with FLAGLL=.F. (XY grid) DIST0 = 360**2 IS=1 DO J = 1, N - DIST=(XBPI(I)-XYB(IX1(J),1))**2+(YBPI(I)-XYB(IX1(J),2))**2 + DIST = (XBPI(I) - XGRD(1,IX1(J)))**2 + (YBPI(I) - YGRD(1,IX1(J)))**2 IF (DIST.LT.DIST0) THEN IS = MAPFS(1,IX1(J)) DIST0=DIST @@ -2742,7 +2739,7 @@ SUBROUTINE SETUGIOBP ( ) ! 3. Defines directions pointing into land or sea ! IOBPD(:,:) = 0 - IOBPA(:) = 0 + IOBPA(:) = 0 ! DO IP=1,NX IF ((MAPSTA(1,IP).EQ.2).AND.(IOBP(IP).EQ.0)) IOBPA(IP)=1 @@ -2880,7 +2877,7 @@ SUBROUTINE SETUGIOBP ( ) END SUBROUTINE SETUGIOBP !/ ------------------------------------------------------------------- / - SUBROUTINE FIX_PERIODCITY(I1,I2,I3,XYB,PT) + SUBROUTINE FIX_PERIODCITY(I1,I2,I3,XGRD,YGRD,PT) !/ !/ +-----------------------------------+ !/ | WAVEWATCH III NOAA/NCEP | @@ -2909,8 +2906,8 @@ SUBROUTINE FIX_PERIODCITY(I1,I2,I3,XYB,PT) ! ---------------------------------------------------------------- IMPLICIT NONE INTEGER, INTENT(IN) :: I1, I2, I3 - DOUBLE PRECISION, INTENT(IN) :: XYB(:,:) - REAL*8, INTENT(OUT) :: PT(3,2) + DOUBLE PRECISION, INTENT(IN) :: XGRD(:,:), YGRD(:,:) + DOUBLE PRECISION, INTENT(OUT) :: PT(3,2) ! ---------------------------------------------------------------- ! ! Local variables. @@ -2944,12 +2941,12 @@ SUBROUTINE FIX_PERIODCITY(I1,I2,I3,XYB,PT) ! 10. Source code : !/ ------------------------------------------------------------------- / - PT(1,1) = XYB(I1,1) - PT(1,2) = XYB(I1,2) - PT(2,1) = XYB(I2,1) - PT(2,2) = XYB(I2,2) - PT(3,1) = XYB(I3,1) - PT(3,2) = XYB(I3,2) + PT(1,1) = XGRD(1,I1) + PT(1,2) = YGRD(1,I1) + PT(2,1) = XGRD(1,I2) + PT(2,2) = YGRD(1,I2) + PT(3,1) = XGRD(1,I3) + PT(3,2) = YGRD(1,I3) R1GT180 = MERGE(1, 0, ABS(PT(3,1)-PT(2,1)).GT.180) diff --git a/model/src/w3updtmd.F90 b/model/src/w3updtmd.F90 index 210a1002e6..6c0a263019 100644 --- a/model/src/w3updtmd.F90 +++ b/model/src/w3updtmd.F90 @@ -354,7 +354,7 @@ SUBROUTINE W3UCUR ( FLFRST ) ! VUF should only be updated in latitude changes significantly ... IX = MAPSF(ISEA,1) IY = MAPSF(ISEA,2) - CALL SETVUF_FAST(h,pp,s,p,enp,dh,dpp,ds,dp,dnp,tau,YGRD(IY,IX),FX,UX,VX) + CALL SETVUF_FAST(h,pp,s,p,enp,dh,dpp,ds,dp,dnp,tau,REAL(YGRD(IY,IX)),FX,UX,VX) WCURTIDEX = CXTIDE(IX,IY,1,1) WCURTIDEY = CYTIDE(IX,IY,1,1) @@ -377,7 +377,7 @@ SUBROUTINE W3UCUR ( FLFRST ) TIDE_PHG(1:NTIDE,2) =CYTIDE(IX,IY,1:NTIDE,2) WRITE(993,'(A,F20.2,13F8.3)') 'TEST ISEA 0:', & - d1,H,S,TAU,pp,s,p,enp,dh,dpp,ds,dp,dnp,YGRD(IY,IX) + d1,H,S,TAU,pp,s,p,enp,dh,dpp,ds,dp,dnp,REAL(YGRD(IY,IX)) DO J=1,TIDE_MF WRITE(993,'(A,4I9,F12.0,3F8.3,I4,X,A)') 'TEST ISEA 1:',IX,J,TIME,TIDE_HOUR, & @@ -2122,7 +2122,7 @@ SUBROUTINE W3ULEV ( A, VA ) #ifdef W3_TIDE IF (FLLEVTIDE) THEN ! VUF should be updated only if latitude changes significantly ... - CALL SETVUF_FAST(h,pp,s,p,enp,dh,dpp,ds,dp,dnp,tau,YGRD(IY,IX),FX,UX,VX) + CALL SETVUF_FAST(h,pp,s,p,enp,dh,dpp,ds,dp,dnp,tau,REAL(YGRD(IY,IX)),FX,UX,VX) WLEVTIDE = WLTIDE(IX,IY,1,1) !Verification ! IF (ISEA.EQ.1) THEN diff --git a/model/src/w3wavemd.F90 b/model/src/w3wavemd.F90 index 3de315a578..10f439b36e 100644 --- a/model/src/w3wavemd.F90 +++ b/model/src/w3wavemd.F90 @@ -85,6 +85,7 @@ MODULE W3WAVEMD !/ 22-Mar-2021 : Update TAUA, RHOA ( version 7.13 ) !/ 06-May-2021 : Use ARCTC and SMCTYPE options. JGLi ( version 7.13 ) !/ 19-Jul-2021 : Momentum and air density support ( version 7.14 ) +!/ 11-Nov-2021 : Remove XYB since it is obsolete ( version 7.xx ) !/ !/ Copyright 2009-2014 National Weather Service (NWS), !/ National Oceanic and Atmospheric Administration. All rights @@ -2030,7 +2031,7 @@ SUBROUTINE W3WAVE ( IMOD, ODAT, TEND, STAMP, NO_OUT & IX = MAPSF(ISEA,1) IF (JSEA.EQ.1) & WRITE(995,*) ' IP dtmax_exp(ip) x-coord y-coord z-coord' - WRITE(995,'(I10,F10.2,3F10.4)') IX, DTCFL1(JSEA), XYB(IX,1), XYB(IX,2), XYB(IX,3) + WRITE(995,'(I10,F10.2,3F10.4)') IX, DTCFL1(JSEA), xgrd(IX,1), ygrd(IX,2), zb(IX) END DO ! JSEA CLOSE(995) END IF diff --git a/model/src/wmesmfmd.F90 b/model/src/wmesmfmd.F90 index 7c7c4dbf31..3ddd294643 100644 --- a/model/src/wmesmfmd.F90 +++ b/model/src/wmesmfmd.F90 @@ -4115,7 +4115,11 @@ subroutine CreateImpMesh ( gcomp, rc ) do i = 1,NX do j = 1,2 pos=2*(i-1)+j - nodeCoords(pos)=XYB(i,j) + if (j == 1) then + nodeCoords(pos) = xgrd(1,i) + else + nodeCoords(pos) = ygrd(1,i) + endif enddo enddo #ifdef W3_PDLIB @@ -4127,7 +4131,11 @@ subroutine CreateImpMesh ( gcomp, rc ) do i = 1,npa do j = 1,2 pos=2*(i-1)+j - nodeCoords(pos)=XYB(iplg(i),j) + if ( j == 1) then + nodeCoords(pos) = xgrd(1,iplg(i)) + else + nodeCoords(pos) = ygrd(1,iplg(i)) + endif enddo enddo endif @@ -4517,7 +4525,11 @@ subroutine CreateExpMesh ( gcomp, rc ) do i = 1,NX do j = 1,2 pos=2*(i-1)+j - nodeCoords(pos)=XYB(i,j) + if (j == 1) then + nodeCoords(pos) = xgrd(1,i) + else + nodeCoords(pos) = ygrd(1,i) + endif enddo enddo #ifdef W3_PDLIB @@ -4529,7 +4541,11 @@ subroutine CreateExpMesh ( gcomp, rc ) do i = 1,npa do j = 1,2 pos=2*(i-1)+j - nodeCoords(pos)=XYB(iplg(i),j) + if ( j == 1) then + nodeCoords(pos) = xgrd(1,iplg(i)) + else + nodeCoords(pos) = ygrd(1,iplg(i)) + endif enddo enddo endif diff --git a/model/src/wmgridmd.F90 b/model/src/wmgridmd.F90 index 130b3d4555..418746d751 100644 --- a/model/src/wmgridmd.F90 +++ b/model/src/wmgridmd.F90 @@ -407,8 +407,8 @@ SUBROUTINE WMGLOW ( FLRBPI ) !notes : MAPSTA refers to GRIDS(I)%MAPSTA ...this is set in W3SETG IF ( ABS(MAPSTA(IY,IX)) .EQ. 2 ) THEN - XA = XGRD(IY,IX) !old code: X0 + REAL(IX-1)*SX - YA = YGRD(IY,IX) !old code: Y0 + REAL(IY-1)*SY + XA = REAL(XGRD(IY,IX)) !old code: X0 + REAL(IX-1)*SX + YA = REAL(YGRD(IY,IX)) !old code: Y0 + REAL(IY-1)*SY ! ! ... Loop over previous (lower ranked) grids, going in order from highest ! of lower ranked grids (I-1) to lowest of lower ranked grids (1) @@ -442,7 +442,8 @@ SUBROUTINE WMGLOW ( FLRBPI ) ! if not in grid, cycle (search next grid) ! IF (GRIDS(J)%GTYPE .EQ. UNGTYPE) THEN - CALL IS_IN_UNGRID(J, XA, YA, ITOUT, IVER, JVER, RW) +!AR: Here we need to take special care in the case that any problem occurs due to the XA, YA beeing 4 byte + CALL IS_IN_UNGRID(J, DBLE(XA), DBLE(YA), ITOUT, IVER, JVER, RW) IF (ITOUT.EQ.0) THEN INGRID=.FALSE. ELSE @@ -825,9 +826,9 @@ SUBROUTINE WMGLOW ( FLRBPI ) END IF IM1=GRIDS(I)%TRIGP(ITRI,IT) IM2=GRIDS(I)%TRIGP(ITRI,JT) - EDIST=W3DIST(FLAGLL, GRIDS(I)%XYB(IM1,1), & - GRIDS(I)%XYB(IM1,2), GRIDS(I)%XYB(IM2,1), & - GRIDS(I)%XYB(IM2,2)) + EDIST=W3DIST(FLAGLL, REAL(GRIDS(I)%XGRD(1,IM1)), & + REAL(GRIDS(I)%YGRD(1,IM1)), REAL(GRIDS(I)%XGRD(1,IM2)), & + REAL(GRIDS(I)%YGRD(1,IM2))) IF (ISFIRST.EQ.1) THEN DIST_MAX=EDIST DIST_MIN=EDIST @@ -875,9 +876,9 @@ SUBROUTINE WMGLOW ( FLRBPI ) END IF IM1=GRIDS(J)%TRIGP(ITRI,IT) IM2=GRIDS(J)%TRIGP(ITRI,JT) - EDIST=W3DIST(FLAGLL, GRIDS(J)%XYB(IM1,1), & - GRIDS(J)%XYB(IM1,2), GRIDS(J)%XYB(IM2,1), & - GRIDS(J)%XYB(IM2,2)) + EDIST=W3DIST(FLAGLL, REAL(GRIDS(J)%XGRD(1,IM1)), & + REAL(GRIDS(J)%YGRD(1,IM1)), REAL(GRIDS(J)%XGRD(1,IM2)), & + REAL(GRIDS(J)%YGRD(1,IM2))) IF (ISFIRST.EQ.1) THEN DIST_MAX=EDIST DIST_MIN=EDIST @@ -1673,9 +1674,9 @@ SUBROUTINE WMGHGH DO JDST=1, NY IF (ABS(MAPSTA(JDST,IDST)) .EQ. 1) THEN !....find distance to this boundary point. - DD=FACTOR*W3DIST(FLAGLL,XGRD(JDST,IDST), & - YGRD(JDST,IDST),XGRD(JBND,IBND), & - YGRD(JBND,IBND)) + DD=FACTOR*W3DIST(FLAGLL,REAL(XGRD(JDST,IDST)), & + REAL(YGRD(JDST,IDST)),REAL(XGRD(JBND,IBND)), & + REAL(YGRD(JBND,IBND))) ! Notes: The origin of "0.58 * GRAV" is to translate from distance (in meters) ! to time (in seconds) required for a wave to travel from the boundary to point @@ -2106,14 +2107,14 @@ SUBROUTINE WMGHGH DO JDST=1,NJDST DO IDST=1,NIDST KDST=(JDST-1)*NIDST+IDST - XDST=GRIDS(GDST)%XGRD(JDST,IDST) - YDST=GRIDS(GDST)%YGRD(JDST,IDST) + XDST=REAL(GRIDS(GDST)%XGRD(JDST,IDST)) + YDST=REAL(GRIDS(GDST)%YGRD(JDST,IDST)) DO IPNT=1,ALLWGTS(GSRC)%WGTDATA(KDST)%N KSRC=ALLWGTS(GSRC)%WGTDATA(KDST)%K(IPNT) JSRC=INT((KSRC-1)/NISRC)+1 ISRC=KSRC-(JSRC-1)*NISRC - XSRC=GRIDS(GSRC)%XGRD(JSRC,ISRC) - YSRC=GRIDS(GSRC)%YGRD(JSRC,ISRC) + XSRC=REAL(GRIDS(GSRC)%XGRD(JSRC,ISRC)) + YSRC=REAL(GRIDS(GSRC)%YGRD(JSRC,ISRC)) WXWY=ALLWGTS(GSRC)%WGTDATA(KDST)%W(IPNT) WRITE(MDST,'(5(1X,F12.5))')XDST,YDST,XSRC, & YSRC,WXWY @@ -2286,10 +2287,10 @@ SUBROUTINE WMGHGH ! offset by dx/2 dy/2, so we omit that sliver (thus we increase ! search area slightly). - XL=MINVAL(GRIDS(GSRC)%XGRD) - YL=MINVAL(GRIDS(GSRC)%YGRD) - XH=MAXVAL(GRIDS(GSRC)%XGRD) - YH=MAXVAL(GRIDS(GSRC)%YGRD) + XL=REAL(MINVAL(GRIDS(GSRC)%XGRD)) + YL=REAL(MINVAL(GRIDS(GSRC)%YGRD)) + XH=REAL(MAXVAL(GRIDS(GSRC)%XGRD)) + YH=REAL(MAXVAL(GRIDS(GSRC)%YGRD)) ELSE @@ -2387,9 +2388,9 @@ SUBROUTINE WMGHGH END IF IM1=GRIDS(GDST)%TRIGP(ITRI,IT) IM2=GRIDS(GDST)%TRIGP(ITRI,JT) - eDist=W3DIST(FLAGLL, GRIDS(GDST)%XYB(IM1,1), & - GRIDS(GDST)%XYB(IM1,2), & - GRIDS(GDST)%XYB(IM2,1), GRIDS(GDST)%XYB(IM2,2)) + eDist=W3DIST(FLAGLL, REAL(GRIDS(GDST)%XGRD(IM1,1)), & + REAL(GRIDS(GDST)%YGRD(IM1,1)), & + REAL(GRIDS(GDST)%XGRD(IM2,1)), REAL(GRIDS(GDST)%YGRD(IM2,1))) IF (IsFirst.eq.1) THEN DIST_MAX=eDist DIST_MIN=eDist @@ -2427,9 +2428,9 @@ SUBROUTINE WMGHGH END IF IM1=GRIDS(GSRC)%TRIGP(ITRI,IT) IM2=GRIDS(GSRC)%TRIGP(ITRI,JT) - eDist=W3DIST(FLAGLL, GRIDS(GSRC)%XYB(IM1,1), & - GRIDS(GSRC)%XYB(IM1,2), & - GRIDS(GSRC)%XYB(IM2,1), GRIDS(GSRC)%XYB(IM2,2)) + eDist=W3DIST(FLAGLL, REAL(GRIDS(GSRC)%XGRD(IM1,1)), & + REAL(GRIDS(GSRC)%YGRD(IM1,1)), & + REAL(GRIDS(GSRC)%XGRD(IM2,1)), REAL(GRIDS(GSRC)%YGRD(IM2,1))) IF (IsFirst.eq.1) THEN DIST_MAX=eDist DIST_MIN=eDist @@ -2555,8 +2556,8 @@ SUBROUTINE WMGHGH IF ( ABS(MAPSTA(JDST,IDST)) .NE. 1 ) CYCLE ! MAPTST: see Section 2.b.2 above IF ( MAPTST(JDST,IDST) .LT. 0 ) CYCLE - XA = XGRD(JDST,IDST) ! old code: X0 + REAL(IDST-1)*SX - YA = YGRD(JDST,IDST) ! old code: Y0 + REAL(JDST-1)*SY + XA = REAL(XGRD(JDST,IDST)) ! old code: X0 + REAL(IDST-1)*SX + YA = REAL(YGRD(JDST,IDST)) ! old code: Y0 + REAL(JDST-1)*SY !!HT: For each point in the target grid, loop over all relevant high-res !!HT: grid (JJ loop). @@ -5475,8 +5476,8 @@ SUBROUTINE WMSMCEQL IY = MAPSF(ISEA, 2) IF( ABS(MAPSTA(IY,IX)) .EQ. 2 ) THEN IXY = IXY + 1 - XLon (IXY) = XGRD(IY,IX) - YLat (IXY) = YGRD(IY,IX) + XLon (IXY) = REAL(XGRD(IY,IX)) + YLat (IXY) = REAL(YGRD(IY,IX)) IBPTS(IXY) = ISEA JBPTS(IXY) = 1 + (ISEA - 1)/NP IPBPT(IXY) = ICROOT-1 + ISEA-(JBPTS(IXY)-1)*NP diff --git a/model/src/wminitmd.F90 b/model/src/wminitmd.F90 index 5f8e41cfd5..7e881ebf5e 100644 --- a/model/src/wminitmd.F90 +++ b/model/src/wminitmd.F90 @@ -2592,9 +2592,9 @@ SUBROUTINE WMINIT ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & MPI_COMM_BCT, IERR_MPI ) CALL MPI_BCAST ( HPFAC, NX*NY, MPI_REAL, 0, & MPI_COMM_BCT, IERR_MPI ) - CALL MPI_BCAST ( XGRD, NX*NY, MPI_REAL, 0, & + CALL MPI_BCAST ( XGRD, NX*NY, MPI_DOUBLE_PRECISION, 0, & MPI_COMM_BCT, IERR_MPI ) - CALL MPI_BCAST ( YGRD, NX*NY, MPI_REAL, 0, & + CALL MPI_BCAST ( YGRD, NX*NY, MPI_DOUBLE_PRECISION, 0, & MPI_COMM_BCT, IERR_MPI ) IF ( MPI_COMM_GRD .EQ. MPI_COMM_NULL ) & GSU = W3GSUC( .FALSE., FLAGLL, ICLOSE, & @@ -5697,13 +5697,13 @@ SUBROUTINE WMINITNML ( IDSI, IDSO, IDSS, IDST, IDSE, IFNAME, & MPI_COMM_BCT, IERR_MPI ) CALL MPI_BCAST ( HPFAC, NX*NY, MPI_REAL, 0, & MPI_COMM_BCT, IERR_MPI ) - CALL MPI_BCAST ( XGRD, NX*NY, MPI_REAL, 0, & + CALL MPI_BCAST ( XGRD, NX*NY, MPI_DOUBLE_PRECISION, 0, & MPI_COMM_BCT, IERR_MPI ) - CALL MPI_BCAST ( YGRD, NX*NY, MPI_REAL, 0, & + CALL MPI_BCAST ( YGRD, NX*NY, MPI_DOUBLE_PRECISION, 0, & MPI_COMM_BCT, IERR_MPI ) IF ( MPI_COMM_GRD .EQ. MPI_COMM_NULL ) & GSU = W3GSUC( .FALSE., FLAGLL, ICLOSE, & - XGRD, YGRD ) + XGRD, YGRD) CALL MPI_BCAST ( DXDP, NX*NY, MPI_REAL, 0, & MPI_COMM_BCT, IERR_MPI ) CALL MPI_BCAST ( DXDQ, NX*NY, MPI_REAL, 0, & diff --git a/model/src/wmiopomd.F90 b/model/src/wmiopomd.F90 index 39e7fc1572..a5c5f1bab8 100644 --- a/model/src/wmiopomd.F90 +++ b/model/src/wmiopomd.F90 @@ -197,7 +197,7 @@ SUBROUTINE WMIOPP ( NPT, XPT, YPT, PNAMES ) USE W3GDATMD, ONLY: NX, NY, X0, Y0, SX, MAPSTA, GRIDS, & FLAGLL, ICLOSE, ICLOSE_NONE, GTYPE, UNGTYPE, & CLGTYPE, GSU - USE W3GDATMD, ONLY: XYB, TRIGP, MAXX, MAXY, DXYMAX ! unstructured grids + USE W3GDATMD, ONLY: TRIGP, MAXX, MAXY, DXYMAX ! unstructured grids USE W3ODATMD, ONLY: O2INIT, NOPTS, PTLOC, PTNME, GRDID, OUTPTS #ifdef W3_MPI USE W3ODATMD, ONLY: O2IRQI @@ -321,7 +321,7 @@ SUBROUTINE WMIOPP ( NPT, XPT, YPT, PNAMES ) CYCLE END IF ELSE - CALL IS_IN_UNGRID(J, XPT(IPT), YPT(IPT), itout, IX, IY, RD ) + CALL IS_IN_UNGRID(J, DBLE(XPT(IPT)), DBLE(YPT(IPT)), itout, IX, IY, RD ) IF (itout.eq.0) THEN INGRID(J,IPT)=.FALSE. END IF diff --git a/model/src/wmscrpmd.F90 b/model/src/wmscrpmd.F90 index c31f1cf447..b28a302f19 100644 --- a/model/src/wmscrpmd.F90 +++ b/model/src/wmscrpmd.F90 @@ -587,12 +587,12 @@ SUBROUTINE GET_SCRIP_INFO_UNSTRUCTURED (ID_GRD, & I1=GRIDS(ID_GRD)%TRIGP(IE,1) I2=GRIDS(ID_GRD)%TRIGP(IE,2) I3=GRIDS(ID_GRD)%TRIGP(IE,3) - ELON1=GRIDS(ID_GRD)%XYB(I1,1) - ELON2=GRIDS(ID_GRD)%XYB(I2,1) - ELON3=GRIDS(ID_GRD)%XYB(I3,1) - ELAT1=GRIDS(ID_GRD)%XYB(I1,2) - ELAT2=GRIDS(ID_GRD)%XYB(I2,2) - ELAT3=GRIDS(ID_GRD)%XYB(I3,2) + ELON1=GRIDS(ID_GRD)%XGRD(1,I1) + ELON2=GRIDS(ID_GRD)%XGRD(1,I2) + ELON3=GRIDS(ID_GRD)%XGRD(1,I3) + ELAT1=GRIDS(ID_GRD)%YGRD(1,I1) + ELAT2=GRIDS(ID_GRD)%YGRD(1,I2) + ELAT3=GRIDS(ID_GRD)%XGRD(1,I3) ELON=(ELON1 + ELON2 + ELON3)/3 ELAT=(ELAT1 + ELAT2 + ELAT3)/3 GRID_CENTER_LON(IE)=ELON @@ -672,12 +672,12 @@ SUBROUTINE GET_SCRIP_INFO_UNSTRUCTURED (ID_GRD, & IF (NEIGHBOR_NEXT(IP) .GT. 0) THEN IPNEXT=NEIGHBOR_NEXT(IP) IPPREV=NEIGHBOR_PREV(IP) - ELONIP=DBLE(GRIDS(ID_GRD)%XYB(IP,1)) - ELATIP=DBLE(GRIDS(ID_GRD)%XYB(IP,2)) - ELONNEXT=DBLE(GRIDS(ID_GRD)%XYB(IPNEXT,1)) - ELATNEXT=DBLE(GRIDS(ID_GRD)%XYB(IPNEXT,2)) - ELONPREV=DBLE(GRIDS(ID_GRD)%XYB(IPPREV,1)) - ELATPREV=DBLE(GRIDS(ID_GRD)%XYB(IPPREV,2)) + ELONIP=DBLE(GRIDS(ID_GRD)%XGRD(1,IP)) + ELATIP=DBLE(GRIDS(ID_GRD)%YGRD(1,IP)) + ELONNEXT=DBLE(GRIDS(ID_GRD)%XGRD(1,IPNEXT)) + ELATNEXT=DBLE(GRIDS(ID_GRD)%YGRD(1,IPNEXT)) + ELONPREV=DBLE(GRIDS(ID_GRD)%XGRD(1,IPPREV)) + ELATPREV=DBLE(GRIDS(ID_GRD)%YGRD(1,IPPREV)) ! Periodicity fix for corner node IF ( ABS(ELONIP - ELONNEXT) .GT. 180.0 ) THEN @@ -705,8 +705,8 @@ SUBROUTINE GET_SCRIP_INFO_UNSTRUCTURED (ID_GRD, & ! Compute centers DO IP=1,MNP - GRID_CENTER_LON(IP)=DBLE(GRIDS(ID_GRD)%XYB(IP,1)) - GRID_CENTER_LAT(IP)=DBLE(GRIDS(ID_GRD)%XYB(IP,2)) + GRID_CENTER_LON(IP)=DBLE(GRIDS(ID_GRD)%XGRD(1,IP)) + GRID_CENTER_LAT(IP)=DBLE(GRIDS(ID_GRD)%YGRD(1,IP)) END DO ! Check triangle node orientation @@ -718,12 +718,12 @@ SUBROUTINE GET_SCRIP_INFO_UNSTRUCTURED (ID_GRD, & I2=GRIDS(ID_GRD)%TRIGP(IE,2) I3=GRIDS(ID_GRD)%TRIGP(IE,3) - PT(1,1)=DBLE(GRIDS(ID_GRD)%XYB(I1,1)) - PT(2,1)=DBLE(GRIDS(ID_GRD)%XYB(I2,1)) - PT(3,1)=DBLE(GRIDS(ID_GRD)%XYB(I3,1)) - PT(1,2)=DBLE(GRIDS(ID_GRD)%XYB(I1,2)) - PT(2,2)=DBLE(GRIDS(ID_GRD)%XYB(I2,2)) - PT(3,2)=DBLE(GRIDS(ID_GRD)%XYB(I3,2)) + PT(1,1)=DBLE(GRIDS(ID_GRD)%XGRD(1,I1)) + PT(2,1)=DBLE(GRIDS(ID_GRD)%XGRD(1,I2)) + PT(3,1)=DBLE(GRIDS(ID_GRD)%XGRD(1,I3)) + PT(1,2)=DBLE(GRIDS(ID_GRD)%YGRD(1,I1)) + PT(2,2)=DBLE(GRIDS(ID_GRD)%YGRD(1,I2)) + PT(3,2)=DBLE(GRIDS(ID_GRD)%YGRD(1,I3)) CALL FIX_PERIODCITY(PT) diff --git a/model/src/wmupdtmd.F90 b/model/src/wmupdtmd.F90 index f849174f7f..545c994118 100644 --- a/model/src/wmupdtmd.F90 +++ b/model/src/wmupdtmd.F90 @@ -1375,8 +1375,8 @@ SUBROUTINE WMUPDV ( IMOD, VX, VY, JMOD, VXI, VYI, UNDEF, CONSTP ) INTEGER, POINTER :: NXI, NYI, MAP(:,:), MAPI(:,:) REAL, POINTER :: X0I, Y0I, SXI, SYI !RP , HPFACI, HQFACI - REAL, POINTER :: XGRDI(:,:), YGRDI(:,:), XGRDC(:,:), & - YGRDC(:,:), HPFACI(:,:), HQFACI(:,:) !RP + REAL, POINTER :: HPFACI(:,:), HQFACI(:,:) + DOUBLE PRECISION, POINTER :: XGRDI(:,:), YGRDI(:,:), XGRDC(:,:), YGRDC(:,:) INTEGER, POINTER :: ICLOSE REAL, ALLOCATABLE :: XGRTMP(:),YGRTMP(:) @@ -1500,7 +1500,7 @@ SUBROUTINE WMUPDV ( IMOD, VX, VY, JMOD, VXI, VYI, UNDEF, CONSTP ) IF ( GRIDS(IMOD)%GTYPE .EQ. CLGTYPE .OR. & GRIDS(JMOD)%GTYPE .EQ. CLGTYPE ) THEN - XGRDI => GRIDS(JMOD)%XGRD !LONS FOR INPUT FIELD + XGRDI => GRIDS(JMOD)%XGRD !LONS FOR INPUT FIELD YGRDI => GRIDS(JMOD)%YGRD !LATS FOR INPUT FIELD ! GETTING THE INFO FOR THE CURVILINEAR GRID @@ -1524,17 +1524,17 @@ SUBROUTINE WMUPDV ( IMOD, VX, VY, JMOD, VXI, VYI, UNDEF, CONSTP ) DTOLER = 1E-5 ! 2.a.1 running over the curvilinear grid ALLOCATE (XGRTMP(NXI),YGRTMP(NYI)) - XGRTMP=XGRDI(1,:) - YGRTMP=YGRDI(:,1) + XGRTMP=REAL(XGRDI(1,:)) + YGRTMP=REAL(YGRDI(:,1)) #ifdef W3_OMPH !$OMP PARALLEL DO PRIVATE(J,I,LONC,LATC,VALUEX,VALUEY) #endif DO J=1,NY DO I=1,NX - LONC=XGRDC(J,I) !LON FOR EVERY CURVL GRID POINT - LATC=YGRDC(J,I) !LAT FOR EVERY CURVL GRID POINT + LONC=REAL(XGRDC(J,I)) !LON FOR EVERY CURVL GRID POINT + LATC=REAL(YGRDC(J,I)) !LAT FOR EVERY CURVL GRID POINT - CALL INTERPOLATE2D(NXI,XGRTMP,NYI,YGRTMP, & + CALL INTERPOLATE2D(NXI,REAL(XGRTMP),NYI,REAL(YGRTMP), & VXI,VYI,LONC,LATC,DTOLER,VALUEX,VALUEY) VX(I,J)=VALUEX VY(I,J)=VALUEY @@ -2037,8 +2037,8 @@ SUBROUTINE WMUPDS ( IMOD, FD, JMOD, FDI, UNDEF ) ! INTEGER, POINTER :: NXI, NYI, MAP(:,:), MAPI(:,:) - REAL, POINTER :: XGRDI(:,:), YGRDI(:,:), XGRDC(:,:), & - YGRDC(:,:), HPFACI(:,:), HQFACI(:,:) !RP + DOUBLE PRECISION, POINTER :: XGRDI(:,:), YGRDI(:,:), XGRDC(:,:), YGRDC(:,:) + REAL, POINTER :: HPFACI(:,:), HQFACI(:,:) !RP REAL, POINTER :: X0I, Y0I, SXI, SYI !RPXXX , HPFACI, HQFACI INTEGER, POINTER :: ICLOSE @@ -2155,13 +2155,13 @@ SUBROUTINE WMUPDS ( IMOD, FD, JMOD, FDI, UNDEF ) GRIDS(JMOD)%GTYPE .EQ. CLGTYPE ) THEN ! 2.a.1 Getting the info for reg and curvi grids - XGRDI => GRIDS(JMOD)%XGRD !LONS FOR INPUT FIELD - YGRDI => GRIDS(JMOD)%YGRD !LATS FOR INPUT FIELD + XGRDI => GRIDS(JMOD)%XGRD !LONS FOR INPUT FIELD + YGRDI => GRIDS(JMOD)%YGRD !LATS FOR INPUT FIELD ! GETTING THE INFO FOR THE CURVILINEAR GRID XGRDC => GRIDS(IMOD)%XGRD !LONS FOR CURVI GRID YGRDC => GRIDS(IMOD)%YGRD !LATS FOR CURVI GRID - !HPFAC => GRIDS(IMOD)%HPFAC !DELTAS IN LON FOR CURVI GRID + !HPFAC => GRIDS(IMOD)%HPFAC !DELTAYGRDC(:,:)YGRDC(:,:)YGRDC(:,:)YGRDC(:,:)S IN LON FOR CURVI GRID !HQFAC => GRIDS(IMOD)%HQFAC !DELTAS IN LAT FOR CURVI GRID ! FOR NOW ONLY INTERPOLATION NOT AVERAGING THEN MXA=2 @@ -2179,12 +2179,12 @@ SUBROUTINE WMUPDS ( IMOD, FD, JMOD, FDI, UNDEF ) ! 2.a.2 running over the curvilinear grid DO J=1,NY DO I=1,NX - LONC=XGRDC(J,I) !LON FOR EVERY CURVL GRID POINT - LATC=YGRDC(J,I) !LAT FOR EVERY CURVL GRID POINT + LONC=REAL(XGRDC(J,I)) !LON FOR EVERY CURVL GRID POINT + LATC=REAL(YGRDC(J,I)) !LAT FOR EVERY CURVL GRID POINT !SXC =HPFAC(J,I) !DELTA IN LON FOR CURVI GRID !SYC =HQFAC(J,I) !DELTA IN LAT FOR CURVI GRID - VALUEINTER=INTERPOLATE(NXI,XGRDI(1,:),NYI,YGRDI(:,1), & + VALUEINTER=INTERPOLATE(NXI,REAL(XGRDI(1,:)),NYI,REAL(YGRDI(:,1)), & FDI,LONC,LATC,DTOLER) FD(I,J)=VALUEINTER END DO !END I diff --git a/model/src/ww3_bounc.F90 b/model/src/ww3_bounc.F90 index f4e3841135..46db4432bc 100644 --- a/model/src/ww3_bounc.F90 +++ b/model/src/ww3_bounc.F90 @@ -110,7 +110,7 @@ PROGRAM W3BOUNC USE W3GDATMD, ONLY: NK, NTH, XFR, FR1, DTH, TH, FACHFE, & GNAME, W3NMOD, W3SETG,& - NSEA, MAPSTA, XYB, GTYPE, XGRD, YGRD, X0, Y0, & + NSEA, MAPSTA, GTYPE, XGRD, YGRD, X0, Y0, & SX, SY, MAPSF, UNGTYPE, CLGTYPE, RLGTYPE, FLAGLL #ifdef W3_RTD USE W3GDATMD, ONLY : POLAT, POLON @@ -407,8 +407,8 @@ PROGRAM W3BOUNC XBPO(IBO)= XGRD(IY,IX) YBPO(IBO)= YGRD(IY,IX) CASE (UNGTYPE) - XBPO(IBO)= XYB(IX,1) - YBPO(IBO)= XYB(IX,2) + XBPO(IBO)= XGRD(1,IX) + YBPO(IBO)= YGRD(1,IX) END SELECT !GTYPE END IF END DO diff --git a/model/src/ww3_bound.F90 b/model/src/ww3_bound.F90 index e1c6d654ab..b687c73fe7 100644 --- a/model/src/ww3_bound.F90 +++ b/model/src/ww3_bound.F90 @@ -101,7 +101,7 @@ PROGRAM W3BOUND USE W3ODATMD, ONLY: W3NOUT, W3SETO, FLBPI USE W3GDATMD, ONLY: NK, NTH, XFR, FR1, GNAME, W3NMOD, W3SETG, & - NSEA, MAPSTA, XYB, GTYPE, XGRD, YGRD, X0, Y0, & + NSEA, MAPSTA, GTYPE, XGRD, YGRD, X0, Y0, & SX, SY, MAPSF, UNGTYPE, CLGTYPE, RLGTYPE #ifdef W3_RTD USE W3GDATMD, ONLY : POLAT, POLON @@ -335,8 +335,8 @@ PROGRAM W3BOUND XBPO(IBO)= XGRD(IY,IX) YBPO(IBO)= YGRD(IY,IX) CASE (UNGTYPE) - XBPO(IBO)= XYB(IX,1) - YBPO(IBO)= XYB(IX,2) + XBPO(IBO)= XGRD(1,IX) + YBPO(IBO)= YGRD(1,IX) END SELECT !GTYPE END IF END DO diff --git a/model/src/ww3_gint.F90 b/model/src/ww3_gint.F90 index 4db6b8e174..d20a8bcb05 100644 --- a/model/src/ww3_gint.F90 +++ b/model/src/ww3_gint.F90 @@ -350,7 +350,7 @@ PROGRAM W3GRID_INTERP !IF (ITOUT.GT.0) INGRID=.TRUE. END IF ELSE - IF ( W3GRMP ( GRIDS(IG)%GSU, XGRD(IY,IX), YGRD(IY,IX), IS, & + IF ( W3GRMP ( GRIDS(IG)%GSU, REAL(XGRD(IY,IX)), REAL(YGRD(IY,IX)), IS, & JS, RW ) ) INGRID=.TRUE. END IF IF (INGRID) THEN diff --git a/model/src/ww3_ounf.F90 b/model/src/ww3_ounf.F90 index 73da7347c7..bdd13beceb 100644 --- a/model/src/ww3_ounf.F90 +++ b/model/src/ww3_ounf.F90 @@ -914,7 +914,7 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & USE W3ARRYMD, ONLY : OUTA2I, PRTBLK USE W3GDATMD, ONLY : SIG, GTYPE, FLAGLL, MAPSTA, MAPST2 USE W3GDATMD, ONLY : NK, UNGTYPE, MAPSF, NTRI, CLGTYPE, RLGTYPE, & - XGRD, YGRD, SX, SY, X0, Y0, XYB, TRIGP, USSP_WN + XGRD, YGRD, SX, SY, X0, Y0, TRIGP, USSP_WN #ifdef W3_RTD ! Rotated pole data from the mod_def file USE W3GDATMD, ONLY : POLAT, POLON, FLAGUNR, AnglD @@ -2364,8 +2364,8 @@ SUBROUTINE W3EXNC ( NX, NY, IX1, IXN, IY1, IYN, NSEA, & ! If unstructured mesh IF (GTYPE.EQ.UNGTYPE) THEN - LON(:)=XYB(:,1) - LAT(:)=XYB(:,2) + LON(:)=XGRD(1,:) + LAT(:)=YGRD(1,:) IF (.NOT.ALLOCATED(TRIGP2)) ALLOCATE(TRIGP2(3,NTRI)) DIMLN(2)=NX DIMLN(3)=NTRI diff --git a/model/src/ww3_prep.F90 b/model/src/ww3_prep.F90 index 26cc22dfad..4bf6b1c250 100644 --- a/model/src/ww3_prep.F90 +++ b/model/src/ww3_prep.F90 @@ -608,7 +608,7 @@ PROGRAM W3PREP IF (GTYPE .NE. UNGTYPE) THEN DO IY=1,NY DO IX=1,NX - INGRID = W3GRMP( GSI, XGRD(IY,IX), YGRD(IY,IX), & + INGRID = W3GRMP( GSI, REAL(XGRD(IY,IX)), REAL(YGRD(IY,IX)), & IS, JS, RW ) IF ( .NOT.INGRID ) THEN @@ -652,8 +652,8 @@ PROGRAM W3PREP END DO ELSE DO IX=1, NX - X = XYB(IX,1) - Y = XYB(IX,2) + X = XGRD(1,IX) + Y = YGRD(1,IX) !AR: hmm NX? IX21(IX,1) = 1 + INT(MOD(360.+(X-X0I),360.)/SXI) ! @@ -876,13 +876,13 @@ PROGRAM W3PREP ! IF ( J .EQ. 1 ) THEN CALL W3FLDP ( NDSO, NDST, NDSE, IERR, FLAGLL, & - NX, NY, NX, NY, YGRD, XGRD, MAPOVR, ILAND, & + NX, NY, NX, NY, REAL(YGRD), REAL(XGRD), MAPOVR, ILAND, & NXJ(J), NYJ(J), NXJ(J), NYJ(J), CLO(J), ALA, ALO, & MASK, RD11, RD21, RD12, RD22, IX21, IX22, IY21, & IY22 ) ELSE CALL W3FLDP ( NDSO, NDST, NDSE, IERR, FLAGLL, & - NX, NY, NX, NY, YGRD, XGRD, MAPOVR, ILAND, & + NX, NY, NX, NY, REAL(YGRD), REAL(XGRD), MAPOVR, ILAND, & NXJ(J), NYJ(J), NXJ(J), NYJ(J), CLO(J), ALA, ALO, & MASK, XD11, XD21, XD12, XD22, JX21, JX22, JY21, & JY22 ) diff --git a/model/src/ww3_prnc.F90 b/model/src/ww3_prnc.F90 index 42d1423802..16d69cf0ee 100644 --- a/model/src/ww3_prnc.F90 +++ b/model/src/ww3_prnc.F90 @@ -999,7 +999,7 @@ PROGRAM W3PRNC IF (GTYPE .NE. UNGTYPE) THEN DO IY=1,NY DO IX=1,NX - INGRID = W3GRMP( GSI, XGRD(IY,IX), YGRD(IY,IX), & + INGRID = W3GRMP( GSI, REAL(XGRD(IY,IX)), REAL(YGRD(IY,IX)), & IS, JS, RW ) IF ( .NOT.INGRID ) THEN IF ( IAPROC .EQ. NAPOUT ) WRITE(NDSO,1042) IX, IY, XGRD(IY,IX), YGRD(IY,IX) @@ -1031,8 +1031,8 @@ PROGRAM W3PRNC END DO ELSE ! GTYPE .NE. UNGTYPE DO IX=1, NX - X = XYB(IX,1) - Y = XYB(IX,2) + X = XGRD(IX,1) + Y = YGRD(IX,1) IX21(IX,1) = 1 + INT(MOD(360.+(X-X0I),360.)/SXI) ! ! Manages the simple closure of the grid @@ -1274,13 +1274,13 @@ PROGRAM W3PRNC ! IF ( J .EQ. 1 ) THEN CALL W3FLDP ( NDSO, NDST, NDSE, IERR, FLAGLL, & - NX, NY, NX, NY, YGRD, XGRD, MAPOVR, ILAND, & + NX, NY, NX, NY, REAL(YGRD), REAL(XGRD), MAPOVR, ILAND, & NXJ(J), NYJ(J), NXJ(J), NYJ(J), CLO(J), ALA, ALO, & MASK, RD11, RD21, RD12, RD22, IX21, IX22, IY21, & IY22 ) ELSE CALL W3FLDP ( NDSO, NDST, NDSE, IERR, FLAGLL, & - NX, NY, NX, NY, YGRD, XGRD, MAPOVR, ILAND, & + NX, NY, NX, NY, REAL(YGRD), REAL(XGRD), MAPOVR, ILAND, & NXJ(J), NYJ(J), NXJ(J), NYJ(J), CLO(J), ALA, ALO, & MASK, XD11, XD21, XD12, XD22, JX21, JX22, JY21, & JY22 ) @@ -1604,7 +1604,7 @@ PROGRAM W3PRNC CALL SETVUF(TIDE_HOURS(I),TIDE_LAT,I) END DO TIDE_ITREND=0 - CALL flex_tidana_webpage(IX,IY,XGRD(IY,IX),TIDE_LAT,TIDE_DAYS(1),TIDE_DAYS(TIDE_NTI), & + CALL flex_tidana_webpage(IX,IY,REAL(XGRD(IY,IX)),TIDE_LAT,TIDE_DAYS(1),TIDE_DAYS(TIDE_NTI), & TIDE_NDEF, TIDE_ITREND, RES, SSQ, RMSR0, & SDEV0, RMSR, RESMAX, IMAX, 0) diff --git a/model/src/ww3_prtide.F90 b/model/src/ww3_prtide.F90 index 6813c77988..8a34a03640 100644 --- a/model/src/ww3_prtide.F90 +++ b/model/src/ww3_prtide.F90 @@ -620,7 +620,7 @@ PROGRAM W3PRTIDE #ifdef W3_SHRD DO IX=1,NX #endif - CALL SETVUF_FAST(h,pp,s,p,enp,dh,dpp,ds,dp,dnp,tau,YGRD(IY,IX),TIDE_FX,UX,VX) + CALL SETVUF_FAST(h,pp,s,p,enp,dh,dpp,ds,dp,dnp,tau,REAL(YGRD(IY,IX)),TIDE_FX,UX,VX) WCURTIDEX = 0. WCURTIDEY = 0. DO I=1,TIDE_PRMF @@ -707,7 +707,7 @@ PROGRAM W3PRTIDE #ifdef W3_SHRD DO IX=1,NX #endif - CALL SETVUF_FAST(h,pp,s,p,enp,dh,dpp,ds,dp,dnp,tau,YGRD(IY,IX),TIDE_FX,UX,VX) + CALL SETVUF_FAST(h,pp,s,p,enp,dh,dpp,ds,dp,dnp,tau,REAL(YGRD(IY,IX)),TIDE_FX,UX,VX) ! ! Removes unlikely values ... ! diff --git a/model/src/ww3_strt.F90 b/model/src/ww3_strt.F90 index 6da024019f..19e2548105 100644 --- a/model/src/ww3_strt.F90 +++ b/model/src/ww3_strt.F90 @@ -521,8 +521,8 @@ PROGRAM W3STRT #endif IF (GTYPE .EQ. UNGTYPE) THEN IX = MAPSF(ISEA,1) - X = XYB(IX,1) - Y = XYB(IX,2) + X = XGRD(1,IX) + Y = YGRD(1,IX) ELSE IX = MAPSF(ISEA,1) IY = MAPSF(ISEA,2) @@ -710,8 +710,8 @@ PROGRAM W3STRT #endif IF (GTYPE .EQ. UNGTYPE) THEN IX = MAPSF(ISEA,1) - X = XYB(IX,1) - Y = XYB(IX,2) + X = XGRD(1,IX) + Y = YGRD(1,IX) ELSE IX = MAPSF(ISEA,1) IY = MAPSF(ISEA,2) diff --git a/model/tools/ftn2src.sh b/model/tools/ftn2src.sh old mode 100644 new mode 100755