source: lmdz_wrf/WRFV3/frame/loop_based_y_shift_code.h @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 5.8 KB
Line 
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                  DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
69                    p%rfield_4d(ims:ime,:,jps:jpf,itrace) = p%rfield_4d(ims:ime,:,jps+py:jpf+py,itrace)
70                  ENDDO
71                ENDIF
72              ELSE IF ( p%Type .EQ. 'd' ) THEN
73                IF ( SIZE(p%dfield_4d,1)*SIZE(p%dfield_4d,3) .GT. 1 ) THEN
74                  DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
75                    p%dfield_4d(ims:ime,:,jps:jpf,itrace) = p%dfield_4d(ims:ime,:,jps+py:jpf+py,itrace)
76                  ENDDO
77                ENDIF
78              ELSE IF ( p%Type .EQ. 'i' ) THEN
79                IF ( SIZE(p%ifield_4d,1)*SIZE(p%ifield_4d,3) .GT. 1 ) THEN
80                  DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
81                    p%ifield_4d(ims:ime,:,jps:jpf,itrace) = p%ifield_4d(ims:ime,:,jps+py:jpf+py,itrace)
82                  ENDDO
83                ENDIF
84              ELSE IF ( p%Type .EQ. 'l' ) THEN
85                CALL wrf_error_fatal( '4D logical arrays cannot be shifted for moving nests' )
86              ENDIF
87            ELSE IF (  p%MemoryOrder(1:2) .EQ. 'XY' ) THEN
88              IF      ( p%Type .EQ. 'r' ) THEN
89                IF ( SIZE(p%rfield_4d,1)*SIZE(p%rfield_4d,2) .GT. 1 ) THEN
90                  DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
91                    p%rfield_4d(ims:ime,jps:jpf,:,itrace) = p%rfield_4d(ims:ime,jps+py:jpf+py,:,itrace)
92                  ENDDO
93                ENDIF
94              ELSE IF ( p%Type .EQ. 'd' ) THEN
95                IF ( SIZE(p%dfield_4d,1)*SIZE(p%dfield_4d,2) .GT. 1 ) THEN
96                  DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
97                    p%dfield_4d(ims:ime,jps:jpf,:,itrace) = p%dfield_4d(ims:ime,jps+py:jpf+py,:,itrace)
98                  ENDDO
99                ENDIF
100              ELSE IF ( p%Type .EQ. 'i' ) THEN
101                IF ( SIZE(p%ifield_4d,1)*SIZE(p%ifield_4d,2) .GT. 1 ) THEN
102                  DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
103                    p%ifield_4d(ims:ime,jps:jpf,:,itrace) = p%ifield_4d(ims:ime,jps+py:jpf+py,:,itrace)
104                  ENDDO
105                ENDIF
106              ELSE IF ( p%Type .EQ. 'l' ) THEN
107                CALL wrf_error_fatal( '4D logical arrays cannot be shifted for moving nests' )
108              ENDIF
109            ENDIF
110          ENDIF
111        ENDIF
112        p => p%next
113      ENDDO
Note: See TracBrowser for help on using the repository browser.