source: LMDZ5/branches/IPSLCM5A2.1/tools/Max_diff_nc_with_lib/NR_util/swap.f90

Last change on this file was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 3.0 KB
Line 
1MODULE swap_m
2
3  IMPLICIT NONE
4
5  INTERFACE swap
6     MODULE PROCEDURE swap_i,swap_r,swap_rv,swap_c, &
7          swap_cv,swap_cm,swap_z,swap_zv,swap_zm, &
8          masked_swap_rs,masked_swap_rv,masked_swap_rm
9  END INTERFACE
10
11  private
12  public swap
13
14CONTAINS
15
16  SUBROUTINE swap_i(a,b)
17    INTEGER, INTENT(INOUT) :: a,b
18    INTEGER :: dum
19    dum=a
20    a=b
21    b=dum
22  END SUBROUTINE swap_i
23
24  !************************************************
25
26  SUBROUTINE swap_r(a,b)
27    REAL, INTENT(INOUT) :: a,b
28    REAL :: dum
29    dum=a
30    a=b
31    b=dum
32  END SUBROUTINE swap_r
33
34  !************************************************
35
36  SUBROUTINE swap_rv(a,b)
37    REAL, DIMENSION(:), INTENT(INOUT) :: a,b
38    REAL, DIMENSION(SIZE(a)) :: dum
39    dum=a
40    a=b
41    b=dum
42  END SUBROUTINE swap_rv
43
44  !************************************************
45
46  SUBROUTINE swap_c(a,b)
47    COMPLEX, INTENT(INOUT) :: a,b
48    COMPLEX :: dum
49    dum=a
50    a=b
51    b=dum
52  END SUBROUTINE swap_c
53
54  !************************************************
55
56  SUBROUTINE swap_cv(a,b)
57    COMPLEX, DIMENSION(:), INTENT(INOUT) :: a,b
58    COMPLEX, DIMENSION(SIZE(a)) :: dum
59    dum=a
60    a=b
61    b=dum
62  END SUBROUTINE swap_cv
63
64  !************************************************
65
66  SUBROUTINE swap_cm(a,b)
67    COMPLEX, DIMENSION(:,:), INTENT(INOUT) :: a,b
68    COMPLEX, DIMENSION(size(a,1),size(a,2)) :: dum
69    dum=a
70    a=b
71    b=dum
72  END SUBROUTINE swap_cm
73
74  !************************************************
75
76  SUBROUTINE swap_z(a,b)
77    COMPLEX(KIND(0D0)), INTENT(INOUT) :: a,b
78    COMPLEX(KIND(0D0)) :: dum
79    dum=a
80    a=b
81    b=dum
82  END SUBROUTINE swap_z
83
84  !************************************************
85
86  SUBROUTINE swap_zv(a,b)
87    COMPLEX(KIND(0D0)), DIMENSION(:), INTENT(INOUT) :: a,b
88    COMPLEX(KIND(0D0)), DIMENSION(SIZE(a)) :: dum
89    dum=a
90    a=b
91    b=dum
92  END SUBROUTINE swap_zv
93
94  !************************************************
95
96  SUBROUTINE swap_zm(a,b)
97    COMPLEX(KIND(0D0)), DIMENSION(:,:), INTENT(INOUT) :: a,b
98    COMPLEX(KIND(0D0)), DIMENSION(size(a,1),size(a,2)) :: dum
99    dum=a
100    a=b
101    b=dum
102  END SUBROUTINE swap_zm
103
104  !************************************************
105
106  SUBROUTINE masked_swap_rs(a,b,mask)
107    REAL, INTENT(INOUT) :: a,b
108    LOGICAL, INTENT(IN) :: mask
109    REAL :: swp
110    if (mask) then
111       swp=a
112       a=b
113       b=swp
114    end if
115  END SUBROUTINE masked_swap_rs
116
117  !************************************************
118
119  SUBROUTINE masked_swap_rv(a,b,mask)
120    REAL, DIMENSION(:), INTENT(INOUT) :: a,b
121    LOGICAL, DIMENSION(:), INTENT(IN) :: mask
122    REAL, DIMENSION(size(a)) :: swp
123    where (mask)
124       swp=a
125       a=b
126       b=swp
127    end where
128  END SUBROUTINE masked_swap_rv
129
130  !************************************************
131
132  SUBROUTINE masked_swap_rm(a,b,mask)
133    REAL, DIMENSION(:,:), INTENT(INOUT) :: a,b
134    LOGICAL, DIMENSION(:,:), INTENT(IN) :: mask
135    REAL, DIMENSION(size(a,1),size(a,2)) :: swp
136    where (mask)
137       swp=a
138       a=b
139       b=swp
140    end where
141  END SUBROUTINE masked_swap_rm
142
143END MODULE swap_m
Note: See TracBrowser for help on using the repository browser.