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/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: trunk/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90 @ 2528

Last change on this file since 2528 was 2528, checked in by rblod, 13 years ago

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