1 | MODULE limcons |
---|
2 | !!====================================================================== |
---|
3 | !! *** MODULE limcons *** |
---|
4 | !! LIM-3 Sea Ice : conservation check |
---|
5 | !!====================================================================== |
---|
6 | !! History : - ! Original code from William H. Lipscomb, LANL |
---|
7 | !! 3.0 ! 2004-06 (M. Vancoppenolle) Energy Conservation |
---|
8 | !! 4.0 ! 2011-02 (G. Madec) add mpp considerations |
---|
9 | !!---------------------------------------------------------------------- |
---|
10 | #if defined key_lim3 |
---|
11 | !!---------------------------------------------------------------------- |
---|
12 | !! 'key_lim3' : LIM3 sea-ice model |
---|
13 | !!---------------------------------------------------------------------- |
---|
14 | !! lim_cons : checks whether energy, mass and salt are conserved |
---|
15 | !!---------------------------------------------------------------------- |
---|
16 | USE par_ice ! LIM-3 parameter |
---|
17 | USE ice ! LIM-3 variables |
---|
18 | USE dom_ice ! LIM-3 domain |
---|
19 | USE dom_oce ! ocean domain |
---|
20 | USE in_out_manager ! I/O manager |
---|
21 | USE lib_mpp ! MPP library |
---|
22 | |
---|
23 | IMPLICIT NONE |
---|
24 | PRIVATE |
---|
25 | |
---|
26 | PUBLIC lim_column_sum |
---|
27 | PUBLIC lim_column_sum_energy |
---|
28 | PUBLIC lim_cons_check |
---|
29 | |
---|
30 | !!---------------------------------------------------------------------- |
---|
31 | !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) |
---|
32 | !! $Id$ |
---|
33 | !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) |
---|
34 | !!---------------------------------------------------------------------- |
---|
35 | CONTAINS |
---|
36 | |
---|
37 | SUBROUTINE lim_column_sum( ksum, pin, pout ) |
---|
38 | !!------------------------------------------------------------------- |
---|
39 | !! *** ROUTINE lim_column_sum *** |
---|
40 | !! |
---|
41 | !! ** Purpose : Compute the sum of xin over nsum categories |
---|
42 | !! |
---|
43 | !! ** Method : Arithmetics |
---|
44 | !! |
---|
45 | !! ** Action : Gets xin(ji,jj,jl) and computes xout(ji,jj) |
---|
46 | !!--------------------------------------------------------------------- |
---|
47 | INTEGER , INTENT(in ) :: ksum ! number of categories/layers |
---|
48 | REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pin ! input field |
---|
49 | REAL(wp), DIMENSION(:,:) , INTENT( out) :: pout ! output field |
---|
50 | ! |
---|
51 | INTEGER :: jl ! dummy loop indices |
---|
52 | !!--------------------------------------------------------------------- |
---|
53 | ! |
---|
54 | pout(:,:) = pin(:,:,1) |
---|
55 | DO jl = 2, ksum |
---|
56 | pout(:,:) = pout(:,:) + pin(:,:,jl) |
---|
57 | END DO |
---|
58 | ! |
---|
59 | END SUBROUTINE lim_column_sum |
---|
60 | |
---|
61 | |
---|
62 | SUBROUTINE lim_column_sum_energy( ksum, klay, pin, pout) |
---|
63 | !!------------------------------------------------------------------- |
---|
64 | !! *** ROUTINE lim_column_sum_energy *** |
---|
65 | !! |
---|
66 | !! ** Purpose : Compute the sum of xin over nsum categories |
---|
67 | !! and nlay layers |
---|
68 | !! |
---|
69 | !! ** Method : Arithmetics |
---|
70 | !!--------------------------------------------------------------------- |
---|
71 | INTEGER , INTENT(in ) :: ksum !: number of categories |
---|
72 | INTEGER , INTENT(in ) :: klay !: number of vertical layers |
---|
73 | REAL(wp), DIMENSION(jpi,jpj,jkmax,jpl), INTENT(in ) :: pin !: input field |
---|
74 | REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pout !: output field |
---|
75 | ! |
---|
76 | INTEGER :: jk, jl ! dummy loop indices |
---|
77 | !!--------------------------------------------------------------------- |
---|
78 | ! |
---|
79 | pout(:,:) = 0._wp |
---|
80 | DO jl = 1, ksum |
---|
81 | DO jk = 2, klay |
---|
82 | pout(:,:) = pout(:,:) + pin(:,:,jk,jl) |
---|
83 | END DO |
---|
84 | END DO |
---|
85 | ! |
---|
86 | END SUBROUTINE lim_column_sum_energy |
---|
87 | |
---|
88 | |
---|
89 | SUBROUTINE lim_cons_check( px1, px2, pmax_err, cd_fieldid ) |
---|
90 | !!------------------------------------------------------------------- |
---|
91 | !! *** ROUTINE lim_cons_check *** |
---|
92 | !! |
---|
93 | !! ** Purpose : Test the conservation of a certain variable |
---|
94 | !! For each physical grid cell, check that initial |
---|
95 | !! and final values |
---|
96 | !! of a conserved field are equal to within a small value. |
---|
97 | !! |
---|
98 | !! ** Method : |
---|
99 | !!--------------------------------------------------------------------- |
---|
100 | REAL(wp), DIMENSION(:,:), INTENT(in ) :: px1 !: initial field |
---|
101 | REAL(wp), DIMENSION(:,:), INTENT(in ) :: px2 !: final field |
---|
102 | REAL(wp) , INTENT(in ) :: pmax_err !: max allowed error |
---|
103 | CHARACTER(len=15) , INTENT(in ) :: cd_fieldid !: field identifyer |
---|
104 | ! |
---|
105 | INTEGER :: ji, jj ! dummy loop indices |
---|
106 | INTEGER :: inb_error ! number of g.c where there is a cons. error |
---|
107 | LOGICAL :: llconserv_err ! = .true. if conservation check failed |
---|
108 | REAL(wp) :: zmean_error ! mean error on error points |
---|
109 | !!--------------------------------------------------------------------- |
---|
110 | ! |
---|
111 | IF(lwp) WRITE(numout,*) ' lim_cons_check ' |
---|
112 | IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~ ' |
---|
113 | |
---|
114 | llconserv_err = .FALSE. |
---|
115 | inb_error = 0 |
---|
116 | zmean_error = 0._wp |
---|
117 | IF( MAXVAL( px2(:,:) - px1(:,:) ) > pmax_err ) llconserv_err = .TRUE. |
---|
118 | |
---|
119 | IF( llconserv_err ) THEN |
---|
120 | DO jj = 1, jpj |
---|
121 | DO ji = 1, jpi |
---|
122 | IF( ABS( px2(ji,jj) - px1(ji,jj) ) > pmax_err ) THEN |
---|
123 | inb_error = inb_error + 1 |
---|
124 | zmean_error = zmean_error + ABS( px2(ji,jj) - px1(ji,jj) ) |
---|
125 | ! |
---|
126 | IF(lwp) THEN |
---|
127 | WRITE (numout,*) ' ALERTE 99 ' |
---|
128 | WRITE (numout,*) ' Conservation error: ', cd_fieldid |
---|
129 | WRITE (numout,*) ' Point : ', ji, jj |
---|
130 | WRITE (numout,*) ' lat, lon : ', gphit(ji,jj), glamt(ji,jj) |
---|
131 | WRITE (numout,*) ' Initial value : ', px1(ji,jj) |
---|
132 | WRITE (numout,*) ' Final value : ', px2(ji,jj) |
---|
133 | WRITE (numout,*) ' Difference : ', px2(ji,jj) - px1(ji,jj) |
---|
134 | ENDIF |
---|
135 | ENDIF |
---|
136 | END DO |
---|
137 | END DO |
---|
138 | ! |
---|
139 | ENDIF |
---|
140 | IF(lk_mpp) CALL mpp_sum( inb_error ) |
---|
141 | IF(lk_mpp) CALL mpp_sum( zmean_error ) |
---|
142 | ! |
---|
143 | IF( inb_error > 0 .AND. lwp ) THEN |
---|
144 | zmean_error = zmean_error / REAL( inb_error, wp ) |
---|
145 | WRITE(numout,*) ' Conservation check for : ', cd_fieldid |
---|
146 | WRITE(numout,*) ' Number of error points : ', inb_error |
---|
147 | WRITE(numout,*) ' Mean error on these pts: ', zmean_error |
---|
148 | ENDIF |
---|
149 | ! |
---|
150 | END SUBROUTINE lim_cons_check |
---|
151 | |
---|
152 | #else |
---|
153 | !!---------------------------------------------------------------------- |
---|
154 | !! Default option Empty module NO LIM sea-ice model |
---|
155 | !!---------------------------------------------------------------------- |
---|
156 | #endif |
---|
157 | !!====================================================================== |
---|
158 | END MODULE limcons |
---|