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

Last change on this file since 1 was 1, checked in by lfita, 11 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),'X') .GT. 0 ) THEN
5            ipf = MIN(ipe,ide)
6          ELSE
7            ipf = MIN(ipe,ide-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(ips:ipf,jms:jme) = p%rfield_2d(ips+px:ipf+px,jms:jme)
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(ips:ipf,jms:jme) = p%dfield_2d(ips+px:ipf+px,jms:jme)
18                ENDIF
19              ELSE IF ( TRIM(p%Type) .EQ. 'i' ) THEN
20                IF ( SIZE(p%ifield_2d,1)*SIZE(p%ifield_2d,2) .GT. 1 ) THEN
21                  p%ifield_2d(ips:ipf,jms:jme) = p%ifield_2d(ips+px:ipf+px,jms:jme)
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(ips:ipf,jms:jme) = p%lfield_2d(ips+px:ipf+px,jms:jme)
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(ips:ipf,:,jms:jme) = p%rfield_3d(ips+px:ipf+px,:,jms:jme)
34                ENDIF
35              ELSE IF ( p%Type .EQ. 'd' ) THEN
36                IF ( SIZE(p%dfield_3d,1)*SIZE(p%dfield_3d,3) .GT. 1 ) THEN
37                  p%dfield_3d(ips:ipf,:,jms:jme) = p%dfield_3d(ips+px:ipf+px,:,jms:jme)
38                ENDIF
39              ELSE IF ( p%Type .EQ. 'i' ) THEN
40                IF ( SIZE(p%ifield_3d,1)*SIZE(p%ifield_3d,3) .GT. 1 ) THEN
41                  p%ifield_3d(ips:ipf,:,jms:jme) = p%ifield_3d(ips+px:ipf+px,:,jms:jme)
42                ENDIF
43              ELSE IF ( p%Type .EQ. 'l' ) THEN
44                CALL wrf_error_fatal( '3D logical arrays cannot be shifted for moving nests' )
45              ENDIF
46            ELSE IF (  p%MemoryOrder(1:2) .EQ. 'XY' ) THEN
47              IF      ( p%Type .EQ. 'r' ) THEN
48                IF ( SIZE(p%rfield_3d,1)*SIZE(p%rfield_3d,2) .GT. 1 ) THEN
49                  p%rfield_3d(ips:ipf,jms:jme,:) = p%rfield_3d(ips+px:ipf+px,jms:jme,:)
50                ENDIF
51              ELSE IF ( p%Type .EQ. 'd' ) THEN
52                IF ( SIZE(p%dfield_3d,1)*SIZE(p%dfield_3d,2) .GT. 1 ) THEN
53                  p%dfield_3d(ips:ipf,jms:jme,:) = p%dfield_3d(ips+px:ipf+px,jms:jme,:)
54                ENDIF
55              ELSE IF ( p%Type .EQ. 'i' ) THEN
56                IF ( SIZE(p%ifield_3d,1)*SIZE(p%ifield_3d,2) .GT. 1 ) THEN
57                  p%ifield_3d(ips:ipf,jms:jme,:) = p%ifield_3d(ips+px:ipf+px,jms:jme,:)
58                ENDIF
59              ELSE IF ( p%Type .EQ. 'l' ) THEN
60                CALL wrf_error_fatal( '3D logical arrays cannot be shifted for moving nests' )
61              ENDIF
62            ENDIF
63          ELSE IF ( p%Ndim .EQ. 4 ) THEN
64            IF (      p%MemoryOrder(1:1) .EQ. 'X' .AND.  p%MemoryOrder(3:3) .EQ.  'Y' ) THEN
65              IF      ( p%Type .EQ. 'r' ) THEN
66                IF ( SIZE(p%rfield_4d,1)*SIZE(p%rfield_4d,3) .GT. 1 ) THEN
67                  DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
68                    p%rfield_4d(ips:ipf,:,jms:jme,itrace) = p%rfield_4d(ips+px:ipf+px,:,jms:jme,itrace)
69                  ENDDO
70                ENDIF
71              ELSE IF ( p%Type .EQ. 'd' ) THEN
72                IF ( SIZE(p%dfield_4d,1)*SIZE(p%dfield_4d,3) .GT. 1 ) THEN
73                  DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
74                    p%dfield_4d(ips:ipf,:,jms:jme,itrace) = p%dfield_4d(ips+px:ipf+px,:,jms:jme,itrace)
75                  ENDDO
76                ENDIF
77              ELSE IF ( p%Type .EQ. 'i' ) THEN
78                IF ( SIZE(p%ifield_4d,1)*SIZE(p%ifield_4d,3) .GT. 1 ) THEN
79                  DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
80                    p%ifield_4d(ips:ipf,:,jms:jme,itrace) = p%ifield_4d(ips+px:ipf+px,:,jms:jme,itrace)
81                  ENDDO
82                ENDIF
83              ELSE IF ( p%Type .EQ. 'l' ) THEN
84                CALL wrf_error_fatal( '4D logical arrays cannot be shifted for moving nests' )
85              ENDIF
86            ELSE IF (  p%MemoryOrder(1:2) .EQ. 'XY' ) THEN
87              IF      ( p%Type .EQ. 'r' ) THEN
88                IF ( SIZE(p%rfield_4d,1)*SIZE(p%rfield_4d,2) .GT. 1 ) THEN
89                  DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
90                    p%rfield_4d(ips:ipf,jms:jme,:,itrace) = p%rfield_4d(ips+px:ipf+px,jms:jme,:,itrace)
91                  ENDDO
92                ENDIF
93              ELSE IF ( p%Type .EQ. 'd' ) THEN
94                IF ( SIZE(p%dfield_4d,1)*SIZE(p%dfield_4d,2) .GT. 1 ) THEN
95                  DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
96                    p%dfield_4d(ips:ipf,jms:jme,:,itrace) = p%dfield_4d(ips+px:ipf+px,jms:jme,:,itrace)
97                  ENDDO
98                ENDIF
99              ELSE IF ( p%Type .EQ. 'i' ) THEN
100                IF ( SIZE(p%ifield_4d,1)*SIZE(p%ifield_4d,2) .GT. 1 ) THEN
101                  DO itrace = PARAM_FIRST_SCALAR , p%num_table(grid%id)
102                    p%ifield_4d(ips:ipf,jms:jme,:,itrace) = p%ifield_4d(ips+px:ipf+px,jms:jme,:,itrace)
103                  ENDDO
104                ENDIF
105              ELSE IF ( p%Type .EQ. 'l' ) THEN
106                CALL wrf_error_fatal( '4D logical arrays cannot be shifted for moving nests' )
107              ENDIF
108            ENDIF
109          ENDIF
110        ENDIF
111        p => p%next
112      ENDDO
Note: See TracBrowser for help on using the repository browser.