frame/loop_based_y_shift_code.h

   1       p => grid%head_statevars%next
   2       DO WHILE ( ASSOCIATED( p ) )
   3         IF ( p%ProcOrient .NE. 'X' .AND. p%ProcOrient .NE. 'Y' ) THEN
   4           IF ( INDEX(TRIM(p%Stagger),'Y') .GT. 0 ) THEN
   5             jpf = MIN(jpe,jde)
   6           ELSE
   7             jpf = MIN(jpe,jde-1)
   8           ENDIF
   9           IF ( p%Ndim .EQ. 2 ) THEN
  10             IF (      p%MemoryOrder(1:1) .EQ. 'X' .AND.  p%MemoryOrder(2:2) .EQ.  'Y' ) THEN
  11               IF      ( p%Type .EQ. 'r' ) THEN
  12                 IF ( SIZE(p%rfield_2d,1)*SIZE(p%rfield_2d,2) .GT. 1 ) THEN
  13                   p%rfield_2d(ims:ime,jps:jpf) = p%rfield_2d(ims:ime,jps+py:jpf+py)
  14                 ENDIF
  15               ELSE IF ( p%Type .EQ. 'd' ) THEN
  16                 IF ( SIZE(p%dfield_2d,1)*SIZE(p%dfield_2d,2) .GT. 1 ) THEN
  17                   p%dfield_2d(ims:ime,jps:jpf) = p%dfield_2d(ims:ime,jps+py:jpf+py)
  18                 ENDIF
  19               ELSE IF ( p%Type .EQ. 'i' ) THEN
  20                 IF ( SIZE(p%ifield_2d,1)*SIZE(p%ifield_2d,2) .GT. 1 ) THEN
  21                   p%ifield_2d(ims:ime,jps:jpf) = p%ifield_2d(ims:ime,jps+py:jpf+py)
  22                 ENDIF
  23               ELSE IF ( p%Type .EQ. 'l' ) THEN
  24                 IF ( SIZE(p%lfield_2d,1)*SIZE(p%lfield_2d,2) .GT. 1 ) THEN
  25                   p%lfield_2d(ims:ime,jps:jpf) = p%lfield_2d(ims:ime,jps+py:jpf+py)
  26                 ENDIF
  27               ENDIF
  28             ENDIF
  29           ELSE IF ( p%Ndim .EQ. 3 ) THEN
  30             IF (      p%MemoryOrder(1:1) .EQ. 'X' .AND.  p%MemoryOrder(3:3) .EQ.  'Y' ) THEN
  31               IF      ( p%Type .EQ. 'r' ) THEN
  32                 IF ( SIZE(p%rfield_3d,1)*SIZE(p%rfield_3d,3) .GT. 1 ) THEN
  33                  p%rfield_3d(ims:ime,:,jps:jpf) = p%rfield_3d(ims:ime,:,jps+py:jpf+py)
  34
  35                 ENDIF
  36               ELSE IF ( p%Type .EQ. 'd' ) THEN
  37                 IF ( SIZE(p%dfield_3d,1)*SIZE(p%dfield_3d,3) .GT. 1 ) THEN
  38                   p%dfield_3d(ims:ime,:,jps:jpf) = p%dfield_3d(ims:ime,:,jps+py:jpf+py)
  39                 ENDIF
  40               ELSE IF ( p%Type .EQ. 'i' ) THEN
  41                 IF ( SIZE(p%ifield_3d,1)*SIZE(p%ifield_3d,3) .GT. 1 ) THEN
  42                   p%ifield_3d(ims:ime,:,jps:jpf) = p%ifield_3d(ims:ime,:,jps+py:jpf+py)
  43                 ENDIF
  44               ELSE IF ( p%Type .EQ. 'l' ) THEN
  45                 CALL wrf_error_fatal( '3D logical arrays cannot be shifted for moving nests' )
  46               ENDIF
  47             ELSE IF (  p%MemoryOrder(1:2) .EQ. 'XY' ) THEN
  48               IF      ( p%Type .EQ. 'r' ) THEN
  49                 IF ( SIZE(p%rfield_3d,1)*SIZE(p%rfield_3d,2) .GT. 1 ) THEN
  50                   p%rfield_3d(ims:ime,jps:jpf,:) = p%rfield_3d(ims:ime,jps+py:jpf+py,:)
  51                 ENDIF
  52               ELSE IF ( p%Type .EQ. 'd' ) THEN
  53                 IF ( SIZE(p%dfield_3d,1)*SIZE(p%dfield_3d,2) .GT. 1 ) THEN
  54                   p%dfield_3d(ims:ime,jps:jpf,:) = p%dfield_3d(ims:ime,jps+py:jpf+py,:)
  55                 ENDIF
  56               ELSE IF ( p%Type .EQ. 'i' ) THEN
  57                 IF ( SIZE(p%ifield_3d,1)*SIZE(p%ifield_3d,2) .GT. 1 ) THEN
  58                   p%ifield_3d(ims:ime,jps:jpf,:) = p%ifield_3d(ims:ime,jps+py:jpf+py,:)
  59                 ENDIF
  60               ELSE IF ( p%Type .EQ. 'l' ) THEN
  61                 CALL wrf_error_fatal( '3D logical arrays cannot be shifted for moving nests' )
  62               ENDIF
  63             ENDIF
  64           ELSE IF ( p%Ndim .EQ. 4 ) THEN
  65             IF (      p%MemoryOrder(1:1) .EQ. 'X' .AND.  p%MemoryOrder(3:3) .EQ.  'Y' ) THEN
  66               IF      ( p%Type .EQ. 'r' ) THEN
  67                 IF ( SIZE(p%rfield_4d,1)*SIZE(p%rfield_4d,3) .GT. 1 ) THEN
  68                   IF ( p%scalar_array ) THEN
  69                     DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
  70                       p%rfield_4d(ims:ime,:,jps:jpf,itrace) = p%rfield_4d(ims:ime,:,jps+py:jpf+py,itrace)
  71                     ENDDO
  72                   ELSE
  73                     p%rfield_4d(ims:ime,:,jps:jpf,:) = p%rfield_4d(ims:ime,:,jps+py:jpf+py,:)
  74                   ENDIF
  75                 ENDIF
  76               ELSE IF ( p%Type .EQ. 'd' ) THEN
  77                 IF ( SIZE(p%dfield_4d,1)*SIZE(p%dfield_4d,3) .GT. 1 ) THEN
  78                   IF ( p%scalar_array ) THEN
  79                     DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
  80                       p%dfield_4d(ims:ime,:,jps:jpf,itrace) = p%dfield_4d(ims:ime,:,jps+py:jpf+py,itrace)
  81                     ENDDO
  82                   ELSE
  83                     p%dfield_4d(ims:ime,:,jps:jpf,:) = p%dfield_4d(ims:ime,:,jps+py:jpf+py,:)
  84                   ENDIF
  85                 ENDIF
  86               ELSE IF ( p%Type .EQ. 'i' ) THEN
  87                 IF ( SIZE(p%ifield_4d,1)*SIZE(p%ifield_4d,3) .GT. 1 ) THEN
  88                   IF ( p%scalar_array ) THEN
  89                     DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
  90                       p%ifield_4d(ims:ime,:,jps:jpf,itrace) = p%ifield_4d(ims:ime,:,jps+py:jpf+py,itrace)
  91                     ENDDO
  92                   ELSE
  93                     p%ifield_4d(ims:ime,:,jps:jpf,:) = p%ifield_4d(ims:ime,:,jps+py:jpf+py,:)
  94                   ENDIF
  95                 ENDIF
  96               ELSE IF ( p%Type .EQ. 'l' ) THEN
  97                 CALL wrf_error_fatal( '4D logical arrays cannot be shifted for moving nests' )
  98               ENDIF
  99             ELSE IF (  p%MemoryOrder(1:2) .EQ. 'XY' ) THEN
 100               IF      ( p%Type .EQ. 'r' ) THEN
 101                 IF ( SIZE(p%rfield_4d,1)*SIZE(p%rfield_4d,2) .GT. 1 ) THEN
 102                   IF ( p%scalar_array ) THEN
 103                     DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
 104                       p%rfield_4d(ims:ime,jps:jpf,:,itrace) = p%rfield_4d(ims:ime,jps+py:jpf+py,:,itrace)
 105                     ENDDO
 106                   ELSE
 107                     p%rfield_4d(ims:ime,jps:jpf,:,:) = p%rfield_4d(ims:ime,jps+py:jpf+py,:,:)
 108                   ENDIF
 109                 ENDIF
 110               ELSE IF ( p%Type .EQ. 'd' ) THEN
 111                 IF ( SIZE(p%dfield_4d,1)*SIZE(p%dfield_4d,2) .GT. 1 ) THEN
 112                   IF ( p%scalar_array ) THEN
 113                     DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
 114                       p%dfield_4d(ims:ime,jps:jpf,:,itrace) = p%dfield_4d(ims:ime,jps+py:jpf+py,:,itrace)
 115                     ENDDO
 116                   ELSE
 117                     p%dfield_4d(ims:ime,jps:jpf,:,:) = p%dfield_4d(ims:ime,jps+py:jpf+py,:,:)
 118                   ENDIF
 119                 ENDIF
 120               ELSE IF ( p%Type .EQ. 'i' ) THEN
 121                 IF ( SIZE(p%ifield_4d,1)*SIZE(p%ifield_4d,2) .GT. 1 ) THEN
 122                   IF ( p%scalar_array ) THEN
 123                     DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
 124                       p%ifield_4d(ims:ime,jps:jpf,:,itrace) = p%ifield_4d(ims:ime,jps+py:jpf+py,:,itrace)
 125                     ENDDO
 126                   ELSE
 127                     p%ifield_4d(ims:ime,jps:jpf,:,:) = p%ifield_4d(ims:ime,jps+py:jpf+py,:,:)
 128                   ENDIF
 129                 ENDIF
 130               ELSE IF ( p%Type .EQ. 'l' ) THEN
 131                 CALL wrf_error_fatal( '4D logical arrays cannot be shifted for moving nests' )
 132               ENDIF
 133             ENDIF
 134           ENDIF
 135         ENDIF
 136         p => p%next
 137       ENDDO