New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
limcons.F90 in trunk/NEMO/LIM_SRC_3 – NEMO

source: trunk/NEMO/LIM_SRC_3/limcons.F90 @ 1156

Last change on this file since 1156 was 1156, checked in by rblod, 16 years ago

Update Id and licence information, see ticket #210
  • Property svn:keywords set to Id
File size: 8.2 KB
Line 
1MODULE limcons
2#if defined key_lim3
3   !!----------------------------------------------------------------------
4   !!   'key_lim3' :                                   LIM3 sea-ice model
5   !!----------------------------------------------------------------------
6   !!
7   !!======================================================================
8   !!                     ***  MODULE  limcons  ***
9   !!
10   !! This module checks whether
11   !!   Ice Total Energy
12   !!   Ice Total Mass
13   !!   Salt Mass
14   !! Are conserved !
15   !!
16   !!======================================================================
17   !!    lim_cons   :   checks whether energy/mass are conserved
18   !!----------------------------------------------------------------------
19   !!
20   !! * Modules used
21
22   USE par_ice
23   USE dom_oce
24   USE dom_ice
25   USE ice
26   USE ice_oce         ! ice variables
27   USE in_out_manager  ! I/O manager
28
29   IMPLICIT NONE
30   PRIVATE
31
32   !! * Accessibility
33   PUBLIC lim_column_sum
34   PUBLIC lim_column_sum_energy
35   PUBLIC lim_cons_check
36
37   !! * Module variables
38   !!----------------------------------------------------------------------
39   !!   LIM 3.0,  UCL-LOCEAN-IPSL (2005)
40   !! $Id$
41   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
42   !!----------------------------------------------------------------------
43
44   !!----------------------------------------------------------------------
45
46CONTAINS
47
48   !===============================================================================
49
50   SUBROUTINE lim_column_sum(nsum,xin,xout)
51      !     !!-------------------------------------------------------------------
52      !     !!               ***  ROUTINE lim_column_sum ***
53      !     !!
54      !     !! ** Purpose : Compute the sum of xin over nsum categories
55      !     !!
56      !     !! ** Method  : Arithmetics
57      !     !!
58      !     !! ** Action  : Gets xin(ji,jj,jl) and computes xout(ji,jj)
59      !     !!
60      !     !! History :
61      !     !!   author: William H. Lipscomb, LANL
62      !     !!   2.1  !  04-06  (M. Vancoppenolle)   Energy Conservation
63      !     !!---------------------------------------------------------------------
64      !     !! * Local variables
65      INTEGER, INTENT(in) ::     &
66         nsum                  ! number of categories/layers
67
68      REAL (wp), DIMENSION(jpi, jpj, jpl), INTENT(IN) ::   &
69         xin                   ! input field
70
71      REAL (wp), DIMENSION(jpi, jpj), INTENT(OUT) ::  &
72         xout                  ! output field
73      INTEGER ::                 &
74         ji, jj, jl         ! horizontal indices
75
76      !     !!---------------------------------------------------------------------
77      !     WRITE(numout,*) ' lim_column_sum '
78      !     WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
79
80      xout(:,:) = 0.00
81
82      DO jl = 1, nsum
83         DO jj = 1, jpj
84            DO ji = 1, jpi
85               xout(ji,jj) = xout(ji,jj) + xin(ji,jj,jl)
86            END DO ! ji
87         END DO  ! jj
88      END DO  ! jl
89
90   END SUBROUTINE lim_column_sum
91
92   !===============================================================================
93
94   SUBROUTINE lim_column_sum_energy(nsum,nlay,xin,xout)
95
96      !!-------------------------------------------------------------------
97      !!               ***  ROUTINE lim_column_sum_energy ***
98      !!
99      !! ** Purpose : Compute the sum of xin over nsum categories
100      !!              and nlay layers
101      !!
102      !! ** Method  : Arithmetics
103      !!
104      !! ** Action  : Gets xin(ji,jj,jl) and computes xout(ji,jj)
105      !!
106      !! History :
107      !!   author: William H. Lipscomb, LANL
108      !!   2.1  !  04-06  (M. Vancoppenolle)   Energy Conservation
109      !!---------------------------------------------------------------------
110      !! * Local variables
111      INTEGER, INTENT(in) ::  &
112         nsum,              &  !: number of categories
113         nlay                  !: number of vertical layers
114
115      REAL (wp), DIMENSION(jpi, jpj, jkmax, jpl), INTENT(IN) :: &
116         xin                   !: input field
117
118      REAL (wp), DIMENSION(jpi, jpj), INTENT(OUT) ::  &
119         xout                  !: output field
120
121      INTEGER ::              &
122         ji, jj,            &  !: horizontal indices
123         jk, jl                !: layer and category  indices
124      !!---------------------------------------------------------------------
125
126      !     WRITE(numout,*) ' lim_column_sum_energy '
127      !     WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~ '
128
129      xout(:,:) = 0.00
130
131      DO jl = 1, nsum
132         DO jk = 1, nlay 
133            DO jj = 1, jpj
134               DO ji = 1, jpi
135                  xout(ji,jj) = xout(ji,jj) + xin(ji,jj,jk,jl)
136               END DO ! ji
137            END DO  ! jj
138         END DO  ! jk
139      END DO ! jl
140
141   END SUBROUTINE lim_column_sum_energy
142
143   !===============================================================================
144
145   SUBROUTINE lim_cons_check(x1, x2, max_err, fieldid)
146      !!-------------------------------------------------------------------
147      !!               ***  ROUTINE lim_cons_check ***
148      !!
149      !! ** Purpose : Test the conservation of a certain variable
150      !!              For each physical grid cell, check that initial
151      !!              and final values
152      !!              of a conserved field are equal to within a small value.
153      !!
154      !! ** Method  :
155      !!
156      !! ** Action  : -
157      !! History :
158      !!   author: William H. Lipscomb, LANL
159      !!   2.1  !  04-06  (M. Vancoppenolle)   Energy Conservation
160      !!---------------------------------------------------------------------
161      !! * Local variables
162
163      REAL (wp), DIMENSION(jpi, jpj), INTENT(IN) ::   &
164         x1 (jpi,jpj) , & !: initial field
165         x2 (jpi,jpj)     !: final field
166
167      REAL (wp) , INTENT ( IN )                  ::   &
168         max_err          !: max allowed error
169
170      REAL (wp)                                  ::   &
171         mean_error       !: mean error on error points
172
173      INTEGER                                    ::   &
174         num_error        !: number of g.c where there is a cons. error
175
176      CHARACTER(len=15) , INTENT(IN)             ::   &
177         fieldid          !: field identifyer
178
179      INTEGER ::              &
180         ji, jj           !: horizontal indices     
181
182      LOGICAL ::              &
183         conserv_err      !: = .true. if conservation check failed
184
185      !!---------------------------------------------------------------------
186      WRITE(numout,*) ' lim_cons_check '
187      WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
188
189      conserv_err = .FALSE.
190      DO jj = 1, jpj
191         DO ji = 1, jpi
192            IF (ABS(x2(ji,jj) - x1(ji,jj)) .GT. max_err) THEN
193               conserv_err = .TRUE.
194            ENDIF
195         END DO
196      END DO
197
198      IF ( conserv_err ) THEN
199
200         num_error  = 0
201         mean_error = 0.0
202         DO jj = 1, jpj 
203            DO ji = 1, jpi
204               IF (ABS(x2(ji,jj) - x1(ji,jj)) .GT. max_err ) THEN
205                  num_error  = num_error + 1
206                  mean_error = mean_error + ABS(x2(ji,jj) - x1(ji,jj))
207
208                  WRITE (numout,*) ' ALERTE 99 '
209                  WRITE (numout,*) ' Conservation error: ', fieldid
210                  WRITE (numout,*) ' Point         : ', ji, jj 
211                  WRITE (numout,*) ' lat, lon      : ', gphit(ji,jj), & 
212                     glamt(ji,jj)
213                  WRITE (numout,*) ' Initial value : ', x1(ji,jj)
214                  WRITE (numout,*) ' Final value   : ', x2(ji,jj)
215                  WRITE (numout,*) ' Difference    : ', x2(ji,jj) - x1(ji,jj)
216
217               ENDIF
218            END DO
219         END DO
220
221         IF ( num_error .GT. 0 ) mean_error = mean_error / num_error
222         WRITE(numout,*) ' Conservation check for : ', fieldid
223         WRITE(numout,*) ' Number of error points : ', num_error
224         WRITE(numout,*) ' Mean error on these pts: ', mean_error
225
226      ENDIF ! conserv_err
227
228   END SUBROUTINE lim_cons_check
229
230#else
231   !!----------------------------------------------------------------------
232   !!   Default option         Empty module            NO LIM sea-ice model
233   !!----------------------------------------------------------------------
234#endif
235   !!======================================================================
236END MODULE limcons
Note: See TracBrowser for help on using the repository browser.