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

Last change on this file since 913 was 834, checked in by ctlod, 16 years ago

Clean comments and useless lines, see ticket:#72

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