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 @ 833

Last change on this file since 833 was 825, checked in by ctlod, 16 years ago

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