Scal xyb

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),                           &

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 

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

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)

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
 !

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)

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