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.
limdia.F90 in branches/nemo_v3_3_beta/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/LIM_SRC_3/limdia.F90 @ 2313

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

Add lim_dia changes for mpp on the 3.3 beta (LIM3 only), see ticket #741

  • Property svn:keywords set to Id
File size: 29.7 KB
Line 
1MODULE limdia
2   !!======================================================================
3   !!                       ***  MODULE limdia   ***
4   !!                      diagnostics of ice model
5   !!======================================================================
6   !! To add a new field
7   !! 1) in lim_dia : add its definition for both hemispheres if wished
8   !! 2) add the new titles in lim_dia_init
9   !!----------------------------------------------------------------------
10#if defined key_lim3
11   !!----------------------------------------------------------------------
12   !!   'key_lim3' :                                   LIM3 sea-ice model
13   !!----------------------------------------------------------------------
14   !!   lim_dia      : computation of the time evolution of keys var.
15   !!   lim_dia_init : initialization and namelist read
16   !!----------------------------------------------------------------------
17   !! * Modules used
18   USE phycst
19   USE in_out_manager
20   USE par_ice         ! ice parameters
21   USE sbc_ice         ! ice variables
22   USE daymod
23   USE dom_ice
24   USE ice
25   USE iceini
26   USE limistate
27   USE dom_oce
28   USE sbc_oce         ! Surface boundary condition: ocean fields
29   USE dom_oce
30   USE lib_mpp
31
32   IMPLICIT NONE
33   PRIVATE
34
35   !! * Routine accessibility
36   PUBLIC lim_dia       ! called by ice_step
37
38   !! * Shared module variables
39   INTEGER, PUBLIC  ::  &
40      ntmoy   = 1 ,     &  !: instantaneous values of ice evolution or averaging ntmoy
41      ninfo   = 1          !: frequency of ouputs on file ice_evolu in case of averaging
42
43   !! * Module variables
44   INTEGER, PARAMETER ::   &  ! Parameters for outputs to files "evolu"
45      jpinfmx = 100         ,    &  ! maximum number of key variables
46      jpchinf = 5           ,    &  ! ???
47      jpchsep = jpchinf + 2         ! ???
48
49   INTEGER          ::  &
50      nfrinf  = 4    ,  &  ! number of variables written in one line
51      nferme ,          &  ! last time step at which the var. are written on file
52      nvinfo ,          &  ! number of total variables
53      nbvt   ,          &  ! number of time variables
54      naveg                ! number of step for accumulation before averaging
55
56   CHARACTER(len=8) ::  &
57      fmtinf  = '1PE13.5 ' ! format of the output values 
58
59   CHARACTER(len=30) :: &
60      fmtw  ,           &  ! formats
61      fmtr  ,           &  ! ???
62      fmtitr               ! ???
63
64   CHARACTER(len=jpchsep), DIMENSION(jpinfmx) ::   &
65      titvar               ! title of key variables
66
67   REAL(wp), DIMENSION(jpinfmx) ::  &
68      vinfom               ! temporary working space
69   REAL(wp) :: &
70      epsi06 = 1.e-06
71   REAL(wp), DIMENSION(jpi,jpj) ::   &
72      aire                 ! masked grid cell area
73
74   !! * Substitutions
75#  include "vectopt_loop_substitute.h90"
76   !!----------------------------------------------------------------------
77   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
78   !! $Id$
79   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
80   !!----------------------------------------------------------------------
81
82
83CONTAINS
84
85   SUBROUTINE lim_dia
86      !!--------------------------------------------------------------------
87      !!                  ***  ROUTINE lim_dia  ***
88      !!   
89      !! ** Purpose : Computation and outputs on file ice.evolu
90      !!      the temporal evolution of some key variables
91      !!
92      !! History :
93      !!   8.0  !  97-06  (Louvain-La-Neuve)  Original code
94      !!   8.5  !  02-09  (C. Ethe , G. Madec )  F90: Free form and module
95      !!   9.0  !  05-06  (M. Vancoppenolle LLN) Rehabilitation and fixing a few bugs
96      !!           01-07  (M. Vancoppenolle LLN) added new fields + fram strait
97      !!                                         export
98      !!-------------------------------------------------------------------
99      !! * Local variables
100      INTEGER  ::   jv,ji,jj,jl ! dummy loop indices
101      REAL(wp), DIMENSION(jpinfmx) ::  & 
102         vinfor           ! temporary working space
103      REAL(wp) ::    &
104         zshift_date   , & ! date from the minimum ice extent
105         zday, zday_min, & ! current day, day of minimum extent
106         zafy, zamy,     & ! temporary area of fy and my ice
107         zindb
108      !!-------------------------------------------------------------------
109
110      ! 0) date from the minimum of ice extent
111      !---------------------------------------
112      zday_min = 273.0        ! zday_min = date of minimum extent, here September 30th
113      zday = FLOAT(numit-nit000) * rdt_ice / ( 86400.0 * FLOAT(nn_fsbc) )
114      IF (zday.GT.zday_min) THEN
115         zshift_date  =  zday - zday_min
116      ELSE
117         zshift_date  =  zday - (365.0 - zday_min)
118      ENDIF
119
120      IF( numit == nstart )   CALL lim_dia_init   ! initialisation of ice_evolu file     
121
122      ! temporal diagnostics
123      vinfor(1) = REAL(numit)
124      vinfor(2) = nyear
125
126      ! put everything to zero
127      DO jv = nbvt + 1, nvinfo
128         vinfor(jv) = 0.0
129      END DO
130
131      !!-------------------------------------------------------------------
132      !! 1) Northern hemisphere
133      !!-------------------------------------------------------------------
134      !! 1.1) Diagnostics independent on age
135      !!------------------------------------
136      DO jj = njeq, jpjm1
137         DO ji = fs_2, fs_jpim1   ! vector opt.
138            IF( tms(ji,jj) == 1 ) THEN
139               vinfor(3)  = vinfor(3)  + at_i(ji,jj)*aire(ji,jj) / 1.0e12 !ice area
140               IF (at_i(ji,jj).GT.0.15) vinfor(5) = vinfor(5) + aire(ji,jj) / 1.0e12 !ice extent
141               vinfor(7)  = vinfor(7)  + vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !ice volume
142               vinfor(9)  = vinfor(9)  + vt_s(ji,jj)*aire(ji,jj) / 1.0e12 !snow volume
143               vinfor(15) = vinfor(15) + ot_i(ji,jj) *vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !mean age
144               vinfor(29) = vinfor(29) + smt_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !mean salinity
145               ! the computation of this diagnostic is not reliable
146               vinfor(31) = vinfor(31) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + & 
147                  v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12 
148               vinfor(53) = vinfor(53) + emps(ji,jj)*aire(ji,jj) / 1.0e12 !salt flux
149               vinfor(55) = vinfor(55) + fsbri(ji,jj)*aire(ji,jj) / 1.0e12 !brine drainage flux
150               vinfor(57) = vinfor(57) + fseqv(ji,jj)*aire(ji,jj) / 1.0e12 !equivalent salt flux
151               vinfor(59) = vinfor(59) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SST
152               vinfor(61) = vinfor(61) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SSS
153               vinfor(65) = vinfor(65) + et_s(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12  ! snow temperature
154               vinfor(67) = vinfor(67) + et_i(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12       ! ice heat content
155               vinfor(69) = vinfor(69) + v_i(ji,jj,1)*aire(ji,jj) / 1.0e12 !ice volume
156               vinfor(71) = vinfor(71) + v_i(ji,jj,2)*aire(ji,jj) / 1.0e12 !ice volume
157               vinfor(73) = vinfor(73) + v_i(ji,jj,3)*aire(ji,jj) / 1.0e12 !ice volume
158               vinfor(75) = vinfor(75) + v_i(ji,jj,4)*aire(ji,jj) / 1.0e12 !ice volume
159               vinfor(77) = vinfor(77) + v_i(ji,jj,5)*aire(ji,jj) / 1.0e12 !ice volume
160               vinfor(79) = 0.0
161               vinfor(81) = vinfor(81) + emp(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux
162            ENDIF
163         END DO
164      END DO
165
166      DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)
167         DO jj = njeq, jpjm1
168            DO ji = fs_2, fs_jpim1   ! vector opt.
169               IF( tms(ji,jj) == 1 ) THEN
170                  vinfor(11) = vinfor(11) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !undef def ice volume
171               ENDIF
172            END DO
173         END DO
174      END DO
175
176      vinfor(13) = 0.0
177
178      vinfor(15) = vinfor(15) / MAX(vinfor(7),epsi06) ! these have to be divided by total ice volume to have the
179      vinfor(29) = vinfor(29) / MAX(vinfor(7),epsi06) ! right value
180      vinfor(31) = SQRT( vinfor(31) / MAX( vinfor(7) , epsi06 ) )
181      vinfor(67) = vinfor(67) / MAX(vinfor(7),epsi06)
182
183      vinfor(53) = vinfor(53) / MAX(vinfor(5),epsi06) ! these have to be divided by total ice extent to have the
184      vinfor(55) = vinfor(55) / MAX(vinfor(5),epsi06) ! right value
185      vinfor(57) = vinfor(57) / MAX(vinfor(5),epsi06) !
186      vinfor(79) = vinfor(79) / MAX(vinfor(5),epsi06) !
187
188      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(3))) !
189      vinfor(59) = zindb*vinfor(59) / MAX(vinfor(3),epsi06) ! divide by ice area
190      vinfor(61) = zindb*vinfor(61) / MAX(vinfor(3),epsi06) !
191
192      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(9))) !
193      vinfor(65) = zindb*vinfor(65) / MAX(vinfor(9),epsi06) ! divide it by snow volume
194
195
196      DO jl = 1, jpl
197         DO jj = njeq, jpjm1
198            DO ji = fs_2, fs_jpim1   ! vector opt.
199               IF( tms(ji,jj) == 1 ) THEN
200                  vinfor(33) = vinfor(33) + d_v_i_trp(ji,jj,jl)*aire(ji,jj) / 1.0e12 !ice volume
201                  vinfor(35) = vinfor(35) + d_v_i_thd(ji,jj,jl)*aire(ji,jj) / 1.0e12 !ice volume
202               ENDIF
203            END DO
204         END DO
205      END DO
206
207      DO jj = njeq, jpjm1
208         DO ji = fs_2, fs_jpim1   ! vector opt.
209            IF( tms(ji,jj) == 1 ) THEN
210               vinfor(37) = vinfor(37) + diag_sni_gr(ji,jj)*aire(ji,jj) / 1.0e12 !th growth rates
211               vinfor(39) = vinfor(39) + diag_lat_gr(ji,jj)*aire(ji,jj) / 1.0e12 
212               vinfor(41) = vinfor(41) + diag_bot_gr(ji,jj)*aire(ji,jj) / 1.0e12
213               vinfor(43) = vinfor(43) + diag_dyn_gr(ji,jj)*aire(ji,jj) / 1.0e12 
214               vinfor(45) = vinfor(45) + dv_dt_thd(ji,jj,5)*aire(ji,jj) / 1.0e12
215               vinfor(47) = vinfor(47) + v_newice(ji,jj) *aire(ji,jj) / 1.0e12 / rdt_ice ! volume acc in OW
216            ENDIF
217         END DO
218      END DO
219
220      DO jl = 1, jpl
221         DO jj = njeq, jpjm1
222            DO ji = fs_2, fs_jpim1   ! vector opt.
223               IF( tms(ji,jj) == 1 ) THEN
224                  vinfor(63) = vinfor(63) + t_su(ji,jj,jl)*a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12
225               ENDIF
226            END DO
227         END DO
228      END DO
229      vinfor(63) = vinfor(63) / MAX(vinfor(3),epsi06) ! these have to be divided by total ice area
230
231      !! 1.2) Diagnostics dependent on age
232      !!------------------------------------
233      DO jj = njeq, jpjm1
234         DO ji = fs_2, fs_jpim1   ! vector opt.
235            IF( tms(ji,jj) == 1 ) THEN
236               zafy = 0.0
237               zamy = 0.0
238               DO jl = 1, jpl
239                  IF ((o_i(ji,jj,jl) - zshift_date).LT.0.0) THEN
240                     vinfor(17) = vinfor(17) + a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 ! FY ice area
241                     vinfor(25) = vinfor(25) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 ! FY ice volume
242                     vinfor(49) = vinfor(49) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !FY ice salinity
243                     zafy = zafy + a_i(ji,jj,jl)
244                  ENDIF
245                  IF ((o_i(ji,jj,jl) - zshift_date).GT.0.0) THEN
246                     vinfor(19) = vinfor(19) + a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12    ! MY ice area
247                     vinfor(27) = vinfor(27) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 ! MY ice volume
248                     vinfor(51) = vinfor(51) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !MY ice salinity
249                     zamy = zamy + a_i(ji,jj,jl)
250                  ENDIF
251               END DO
252               IF ((at_i(ji,jj).GT.0.15).AND.(zafy.GT.zamy)) THEN
253                  vinfor(21) = vinfor(21) + aire(ji,jj) / 1.0e12 ! Seasonal ice extent
254               ENDIF
255               IF ((at_i(ji,jj).GT.0.15).AND.(zafy.LE.zamy)) THEN
256                  vinfor(23) = vinfor(23) + aire(ji,jj) / 1.0e12 ! Perennial ice extent
257               ENDIF
258            ENDIF
259         END DO
260      END DO
261      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(25))) !=0 if no multiyear ice 1 if yes
262      vinfor(49) = zindb*vinfor(49) / MAX(vinfor(25),epsi06)
263      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(27))) !=0 if no multiyear ice 1 if yes
264      vinfor(51) = zindb*vinfor(51) / MAX(vinfor(27),epsi06)
265
266      !! Fram Strait Export
267      !! 83 = area export
268      !! 84 = volume export
269      !! Fram strait in ORCA2 = 5 points
270      !! export = -v_ice*e1t*ddtb*at_i or -v_ice*e1t*ddtb*at_i*h_i
271      jj = 136 ! C grid
272      vinfor(83) = 0.0
273      vinfor(84) = 0.0
274      DO ji = 134, 138
275         vinfor(83) = vinfor(83) - v_ice(ji,jj) * & 
276            e1t(ji,jj)*at_i(ji,jj)*rdt_ice / 1.0e12
277         vinfor(84) = vinfor(84) - v_ice(ji,jj) * & 
278            e1t(ji,jj)*vt_i(ji,jj)*rdt_ice / 1.0e12
279      END DO
280
281      !!-------------------------------------------------------------------
282      !! 2) Southern hemisphere
283      !!-------------------------------------------------------------------
284      !! 2.1) Diagnostics independent on age
285      !!------------------------------------
286      DO jj = 2, njeqm1
287         DO ji = fs_2, fs_jpim1   ! vector opt.
288            IF( tms(ji,jj) == 1 ) THEN
289               vinfor(4)  = vinfor(4)  + at_i(ji,jj)*aire(ji,jj) / 1.0e12 !ice area
290               IF (at_i(ji,jj).GT.0.15) vinfor(6) = vinfor(6) + aire(ji,jj) / 1.0e12 !ice extent
291               vinfor(8)  = vinfor(8)  + vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !ice volume
292               vinfor(10) = vinfor(10) + vt_s(ji,jj)*aire(ji,jj) / 1.0e12 !snow volume
293               vinfor(16) = vinfor(16) + ot_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !mean age
294               vinfor(30) = vinfor(30) + smt_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) / 1.0e12 !mean salinity
295               ! this diagnostic is not well computed (weighted by vol instead
296               ! of area)
297               vinfor(32) = vinfor(32) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + & 
298                  v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12 !ice vel
299               vinfor(54) = vinfor(54) + at_i(ji,jj)*emps(ji,jj)*aire(ji,jj) / 1.0e12 ! Total salt flux
300               vinfor(56) = vinfor(56) + at_i(ji,jj)*fsbri(ji,jj)*aire(ji,jj) / 1.0e12 ! Brine drainage salt flux
301               vinfor(58) = vinfor(58) + at_i(ji,jj)*fseqv(ji,jj)*aire(ji,jj) / 1.0e12 ! Equivalent salt flux
302               vinfor(60) = vinfor(60) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SST
303               vinfor(62) = vinfor(62) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) / 1.0e12  !SSS
304               vinfor(66) = vinfor(66) + et_s(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12 ! snow temperature
305               vinfor(68) = vinfor(68) + et_i(ji,jj)/1.0e9*aire(ji,jj) / 1.0e12 ! ice enthalpy
306               vinfor(70) = vinfor(70) + v_i(ji,jj,1)*aire(ji,jj) / 1.0e12 !ice volume
307               vinfor(72) = vinfor(72) + v_i(ji,jj,2)*aire(ji,jj) / 1.0e12 !ice volume
308               vinfor(74) = vinfor(74) + v_i(ji,jj,3)*aire(ji,jj) / 1.0e12 !ice volume
309               vinfor(76) = vinfor(76) + v_i(ji,jj,4)*aire(ji,jj) / 1.0e12 !ice volume
310               vinfor(78) = vinfor(78) + v_i(ji,jj,5)*aire(ji,jj) / 1.0e12 !ice volume
311               vinfor(80) = 0.0
312               vinfor(82) = vinfor(82) + emp(ji,jj)*aire(ji,jj) / 1.0e12 ! mass flux
313            ENDIF
314         END DO
315      END DO
316
317      DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)
318         DO jj = 2, njeqm1
319            DO ji = fs_2, fs_jpim1   ! vector opt.
320               vinfor(12) = vinfor(12) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !undef def ice volume
321            END DO
322         END DO
323      END DO
324
325      vinfor(14) = 0.0
326
327      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(8))) 
328      vinfor(16) = zindb * vinfor(16) / MAX(vinfor(8),epsi06) ! these have to be divided by ice vol
329      vinfor(30) = zindb * vinfor(30) / MAX(vinfor(8),epsi06) !
330      vinfor(32) = zindb * SQRT( vinfor(32) / MAX( vinfor(8) , epsi06 ) )
331      vinfor(68) = zindb * vinfor(68) / MAX(vinfor(8),epsi06) !
332
333      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(6))) 
334      vinfor(54) = zindb * vinfor(54) / MAX(vinfor(6),epsi06) ! these have to be divided by ice extt
335      vinfor(56) = zindb * vinfor(56) / MAX(vinfor(6),epsi06) !
336      vinfor(58) = zindb * vinfor(58) / MAX(vinfor(6),epsi06) !
337      vinfor(80) = zindb * vinfor(80) / MAX(vinfor(6),epsi06) !
338      !      vinfor(84) = vinfor(84) / vinfor(6) !
339
340      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(4))) !
341      vinfor(60) = zindb*vinfor(60) / ( MAX(vinfor(4), epsi06) ) ! divide by ice area
342      vinfor(62) = zindb*vinfor(62) / ( MAX(vinfor(4), epsi06) ) !
343
344      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(10))) !
345      vinfor(66) = zindb*vinfor(66) / MAX(vinfor(10),epsi06) ! divide it by snow volume
346
347      DO jl = 1, jpl
348         DO jj = 2, njeqm1
349            DO ji = fs_2, fs_jpim1   ! vector opt.
350               IF( tms(ji,jj) == 1 ) THEN
351                  vinfor(34) = vinfor(34) + d_v_i_trp(ji,jj,jl)*aire(ji,jj) / 1.0e12 !ice volume
352                  vinfor(36) = vinfor(36) + d_v_i_thd(ji,jj,jl)*aire(ji,jj) / 1.0e12 !ice volume
353               ENDIF
354            END DO
355         END DO
356      END DO
357
358      DO jj = 2, njeqm1
359         DO ji = fs_2, fs_jpim1   ! vector opt.
360            IF( tms(ji,jj) == 1 ) THEN
361               vinfor(38) = vinfor(38) + diag_sni_gr(ji,jj)*aire(ji,jj) / 1.0e12 !th growth rates
362               vinfor(40) = vinfor(40) + diag_lat_gr(ji,jj)*aire(ji,jj) / 1.0e12 
363               vinfor(42) = vinfor(42) + diag_bot_gr(ji,jj)*aire(ji,jj) / 1.0e12
364               vinfor(44) = vinfor(44) + diag_dyn_gr(ji,jj)*aire(ji,jj) / 1.0e12 
365               vinfor(46) = vinfor(46) + dv_dt_thd(ji,jj,5)*aire(ji,jj) / 1.0e12
366               vinfor(48) = vinfor(48) + v_newice(ji,jj) *aire(ji,jj) / 1.0e12 / rdt_ice ! volume acc in OW
367            ENDIF
368         END DO
369      END DO
370
371
372      DO jl = 1, jpl
373         DO jj = 2, njeqm1
374            DO ji = fs_2, fs_jpim1   ! vector opt.
375               IF( tms(ji,jj) == 1 ) THEN
376                  vinfor(64) = vinfor(64) + t_su(ji,jj,jl)*a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12
377               ENDIF
378            END DO
379         END DO
380      END DO
381      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(4))) !
382      vinfor(64) = zindb * vinfor(64) / MAX(vinfor(4),epsi06) ! divide by ice extt
383      !! 2.2) Diagnostics dependent on age
384      !!------------------------------------
385      DO jj = 2, njeqm1
386         DO ji = fs_2, fs_jpim1   ! vector opt.
387            IF( tms(ji,jj) == 1 ) THEN
388               zafy = 0.0
389               zamy = 0.0
390               DO jl = 1, jpl
391                  IF ((o_i(ji,jj,jl) - zshift_date).LT.0.0) THEN
392                     vinfor(18) = vinfor(18) + a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 ! FY ice area
393                     vinfor(26) = vinfor(26) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 ! FY ice volume
394                     zafy = zafy + a_i(ji,jj,jl)
395                     vinfor(50) = vinfor(50) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !FY ice salinity
396                  ENDIF
397                  IF ((o_i(ji,jj,jl) - zshift_date).GT.0.0) THEN
398                     vinfor(20) = vinfor(20) + a_i(ji,jj,jl)*aire(ji,jj) / 1.0e12    ! MY ice area
399                     vinfor(28) = vinfor(28) + v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12
400                     vinfor(52) = vinfor(52) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) / 1.0e12 !FY ice salinity
401                     zamy = zamy + a_i(ji,jj,jl)
402                  ENDIF
403               END DO ! jl
404               IF ((at_i(ji,jj).GT.0.15).AND.(zafy.GT.zamy)) THEN
405                  vinfor(22) = vinfor(22) + aire(ji,jj) / 1.0e12 ! Seasonal ice extent
406               ENDIF
407               IF ((at_i(ji,jj).GT.0.15).AND.(zafy.LE.zamy)) THEN
408                  vinfor(24) = vinfor(24) + aire(ji,jj) / 1.0e12 ! Perennial ice extent
409               ENDIF
410            ENDIF ! tms
411         END DO ! jj
412      END DO ! ji
413      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(26))) !=0 if no multiyear ice 1 if yes
414      vinfor(50) = zindb*vinfor(50) / MAX(vinfor(26),epsi06)
415      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(28))) !=0 if no multiyear ice 1 if yes
416      vinfor(52) = zindb*vinfor(52) / MAX(vinfor(28),epsi06)
417
418      !  Accumulation before averaging
419      DO jv = 1, nvinfo
420         vinfom(jv) = vinfom(jv) + vinfor(jv)
421      END DO
422      naveg = naveg + 1 
423
424      ! oututs on file ice_evolu   
425      !MV      IF( MOD( numit , ninfo ) == 0 ) THEN
426      WRITE(numevo_ice,fmtw) ( titvar(jv), vinfom(jv)/naveg, jv = 1, nvinfo )
427      naveg = 0
428      DO jv = 1, nvinfo
429         vinfom(jv)=0.0
430      END DO
431      !MV      ENDIF
432
433   END SUBROUTINE lim_dia
434
435   SUBROUTINE lim_dia_init
436      !!-------------------------------------------------------------------
437      !!                  ***  ROUTINE lim_dia_init  ***
438      !!             
439      !! ** Purpose : Preparation of the file ice_evolu for the output of
440      !!      the temporal evolution of key variables
441      !!
442      !! ** input   : Namelist namicedia
443      !!
444      !! history :
445      !!  8.5  ! 03-08 (C. Ethe) original code
446      !!  9.0  ! 08-03 (M. Vancoppenolle) LIM3
447      !!-------------------------------------------------------------------
448      NAMELIST/namicedia/fmtinf, nfrinf, ninfo, ntmoy
449
450      INTEGER  ::   jv   ,     &  ! dummy loop indice
451         &          ntot ,     &
452         &          ndeb ,     &
453         &          irecl
454
455      REAL(wp) ::   zxx0, zxx1    ! temporary scalars
456
457      CHARACTER(len=jpchinf) ::   titinf
458      CHARACTER(len=50)      ::   clname
459      !!-------------------------------------------------------------------
460
461
462      ! Read Namelist namicedia
463      REWIND ( numnam_ice )
464      READ   ( numnam_ice  , namicedia )
465      IF(lwp) THEN
466         WRITE(numout,*)
467         WRITE(numout,*) 'lim_dia_init : ice parameters for ice diagnostics '
468         WRITE(numout,*) '~~~~~~~~~~~~'
469         WRITE(numout,*) '   format of the output values                                 fmtinf = ', fmtinf
470         WRITE(numout,*) '   number of variables written in one line                     nfrinf = ', nfrinf 
471         WRITE(numout,*) '   Instantaneous values of ice evolution or averaging          ntmoy  = ', ntmoy
472         WRITE(numout,*) '   frequency of ouputs on file ice_evolu in case of averaging  ninfo  = ', ninfo
473      ENDIF
474
475      ! masked grid cell area
476      aire(:,:) = area(:,:) * tms(:,:)
477
478      ! Titles of ice key variables :
479      titvar(1) = 'NoIt'  ! iteration number
480      titvar(2) = 'T yr'  ! time step in years
481      nbvt = 2            ! number of time variables
482
483      titvar(3) = 'AI_N'  ! sea ice area in the northern Hemisp.(10^12 km2)
484      titvar(4) = 'AI_S'  ! sea ice area in the southern Hemisp.(10^12 km2)
485      titvar(5) = 'EI_N'  ! sea ice extent (15%) in the northern Hemisp.(10^12 km2)
486      titvar(6) = 'EI_S'  ! sea ice extent (15%) in the southern Hemisp.(10^12 km2)
487      titvar(7) = 'VI_N'  ! sea ice volume in the northern Hemisp.(10^3 km3)
488      titvar(8) = 'VI_S'  ! sea ice volume in the southern Hemisp.(10^3 km3)
489      titvar(9) = 'VS_N'  ! snow volume over sea ice in the northern Hemisp.(10^3 km3)
490      titvar(10)= 'VS_S'  ! snow volume over sea ice in the northern Hemisp.(10^3 km3)
491      titvar(11)= 'VuIN'  ! undeformed sea ice volume in the northern Hemisp.(10^3 km3)
492      titvar(12)= 'VuIS'  ! undeformed sea ice volume in the southern Hemisp.(10^3 km3)
493      titvar(13)= 'VdIN'  ! deformed sea ice volume in the northern Hemisp.(10^3 km3)
494      titvar(14)= 'VdIS'  ! deformed sea ice volume in the southern Hemisp.(10^3 km3)
495      titvar(15)= 'OI_N'  ! sea ice mean age in the northern Hemisp.(years)
496      titvar(16)= 'OI_S'  ! sea ice mean age in the southern Hemisp.(years)
497      titvar(17)= 'AFYN'  ! total FY ice area northern Hemisp.(10^12 km2)
498      titvar(18)= 'AFYS'  ! total FY ice area southern Hemisp.(10^12 km2)
499      titvar(19)= 'AMYN'  ! total MY ice area northern Hemisp.(10^12 km2)
500      titvar(20)= 'AMYS'  ! total MY ice area southern Hemisp.(10^12 km2)
501      titvar(21)= 'EFYN'  ! total FY ice extent northern Hemisp.(10^12 km2) (with more 50% FY ice)
502      titvar(22)= 'EFYS'  ! total FY ice extent southern Hemisp.(10^12 km2) (with more 50% FY ice)
503      titvar(23)= 'EMYN'  ! total MY ice extent northern Hemisp.(10^12 km2) (with more 50% MY ice)
504      titvar(24)= 'EMYS'  ! total MY ice extent southern Hemisp.(10^12 km2) (with more 50% MY ice)
505      titvar(25)= 'VFYN'  ! total undeformed FY ice volume northern Hemisp.(10^3 km3)
506      titvar(26)= 'VFYS'  ! total undeformed FY ice volume southern Hemisp.(10^3 km3)
507      titvar(27)= 'VMYN'  ! total undeformed MY ice volume northern Hemisp.(10^3 km3)
508      titvar(28)= 'VMYS'  ! total undeformed MY ice volume southern Hemisp.(10^3 km3)
509      titvar(29)= 'IS_N'  ! sea ice mean salinity in the northern hemisphere (ppt) 
510      titvar(30)= 'IS_S'  ! sea ice mean salinity in the southern hemisphere (ppt) 
511      titvar(31)= 'IVeN'  ! sea ice mean velocity in the northern hemisphere (m/s)
512      titvar(32)= 'IVeS'  ! sea ice mean velocity in the southern hemisphere (m/s)
513      titvar(33)= 'DVDN'  ! variation of sea ice volume due to dynamics in the northern hemisphere
514      titvar(34)= 'DVDS'  ! variation of sea ice volume due to dynamics in the southern hemisphere
515      titvar(35)= 'DVTN'  ! variation of sea ice volume due to thermo in the   northern hemisphere
516      titvar(36)= 'DVTS'  ! variation of sea ice volume due to thermo in the   southern hemisphere
517      titvar(37)= 'TG1N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 1 
518      titvar(38)= 'TG1S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 1 
519      titvar(39)= 'TG2N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 2 
520      titvar(40)= 'TG2S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 2 
521      titvar(41)= 'TG3N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 3 
522      titvar(42)= 'TG3S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 3 
523      titvar(43)= 'TG4N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 4 
524      titvar(44)= 'TG4S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 4 
525      titvar(45)= 'TG5N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 5 
526      titvar(46)= 'TG5S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 5 
527      titvar(47)= 'LA_N'  ! lateral accretion growth rate, northern hemisphere
528      titvar(48)= 'LA_S'  ! lateral accretion growth rate, southern hemisphere
529      titvar(49)= 'SF_N'  ! Salinity FY, NH
530      titvar(50)= 'SF_S'  ! Salinity FY, SH
531      titvar(51)= 'SF_N'  ! Salinity MY, NH
532      titvar(52)= 'SF_S'  ! Salinity MY, SH
533      titvar(53)= 'Fs_N'  ! Total salt flux NH
534      titvar(54)= 'Fs_S'  ! Total salt flux SH
535      titvar(55)= 'FsbN'  ! Salt - brine drainage flux NH
536      titvar(56)= 'FsbS'  ! Salt - brine drainage flux SH
537      titvar(57)= 'FseN'  ! Salt - Equivalent salt flux NH
538      titvar(58)= 'FseS'  ! Salt - Equivalent salt flux SH
539      titvar(59)= 'SSTN'  ! SST, NH
540      titvar(60)= 'SSTS'  ! SST, SH
541      titvar(61)= 'SSSN'  ! SSS, NH
542      titvar(62)= 'SSSS'  ! SSS, SH
543      titvar(63)= 'TsuN'  ! Tsu, NH
544      titvar(64)= 'TsuS'  ! Tsu, SH
545      titvar(65)= 'TsnN'  ! Tsn, NH
546      titvar(66)= 'TsnS'  ! Tsn, SH
547      titvar(67)= 'ei_N'  ! ei, NH
548      titvar(68)= 'ei_S'  ! ei, SH
549      titvar(69)= 'vi1N'  ! vi1, NH
550      titvar(70)= 'vi1S'  ! vi1, SH
551      titvar(71)= 'vi2N'  ! vi2, NH
552      titvar(72)= 'vi2S'  ! vi2, SH
553      titvar(73)= 'vi3N'  ! vi3, NH
554      titvar(74)= 'vi3S'  ! vi3, SH
555      titvar(75)= 'vi4N'  ! vi4, NH
556      titvar(76)= 'vi4S'  ! vi4, SH
557      titvar(77)= 'vi5N'  ! vi5, NH
558      titvar(78)= 'vi5S'  ! vi5, SH
559      titvar(79)= 'vi6N'  ! vi6, NH
560      titvar(80)= 'vi6S'  ! vi6, SH
561      titvar(81)= 'fmaN'  ! mass flux in the ocean, NH
562      titvar(82)= 'fmaS'  ! mass flux in the ocean, SH
563      titvar(83)= 'AFSE'  ! Fram Strait Area export
564      titvar(84)= 'VFSE'  ! Fram Strait Volume export
565      nvinfo = 84
566
567      ! Definition et Ecriture de l'entete : nombre d'enregistrements
568      ndeb   = ( nstart - 1 ) / ninfo
569      IF( nstart == 1 ) ndeb = -1
570
571      nferme = ( nstart - 1 + nitrun) / ninfo
572      ntot   = nferme - ndeb
573      ndeb   = ninfo * ( 1 + ndeb )
574      nferme = ninfo * nferme
575
576      ! definition of formats
577      WRITE( fmtw  , '(A,I3,A2,I1,A)' )  '(', nfrinf, '(A', jpchsep, ','//fmtinf//'))'
578      WRITE( fmtr  , '(A,I3,A,I1,A)'  )  '(', nfrinf, '(', jpchsep, 'X,'//fmtinf//'))'
579      WRITE( fmtitr, '(A,I3,A,I1,A)'  )  '(', nvinfo, 'A', jpchinf, ')'
580
581      ! opening  "ice_evolu" file
582      IF ( lk_mpp ) THEN
583         WRITE(clname,FMT="('ice.evolu_',I4.4)") narea-1
584      ELSE
585         clname = 'ice.evolu'
586      END IF
587      irecl = ( jpchinf + 1 ) * nvinfo 
588      CALL ctl_opn( numevo_ice, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',    &
589         &         irecl, numout, .TRUE., narea )
590
591      !- ecriture de 2 lignes d''entete :
592      WRITE(numevo_ice,1000) fmtr, fmtw, fmtitr, nvinfo, ntot, 0, nfrinf
593      zxx0 = 0.001 * REAL(ninfo)
594      zxx1 = 0.001 * REAL(ndeb)
595      WRITE(numevo_ice,1111) REAL(jpchinf), 0., zxx1, zxx0, 0., 0., 0
596
597      !- ecriture de 2 lignes de titre :
598      WRITE(numevo_ice,'(A,I8,A,I8,A,I5)')                                      &
599         'Evolution chronologique - Experience '//cexper   &
600         //'   de', ndeb, ' a', nferme, ' pas', ninfo
601      WRITE(numevo_ice,fmtitr) ( titvar(jv), jv = 1, nvinfo )
602
603
604      !--preparation de "titvar" pour l''ecriture parmi les valeurs numeriques :
605      DO  jv = 2 , nvinfo
606         titinf     = titvar(jv)(:jpchinf)
607         titvar(jv) = '  '//titinf
608      END DO
609
610      !--Initialisation of the arrays for the accumulation
611      DO  jv = 1, nvinfo
612         vinfom(jv) = 0.
613      END DO
614      naveg = 0
615
6161000  FORMAT( 3(A20),4(1x,I6) )
6171111  FORMAT( 3(F7.1,1X,F7.3,1X),I3,A ) 
618
619   END SUBROUTINE lim_dia_init
620
621#else
622   !!----------------------------------------------------------------------
623   !!   Default option :                               NO LIM sea-ice model
624   !!----------------------------------------------------------------------
625CONTAINS
626   SUBROUTINE lim_dia         ! Empty routine
627   END SUBROUTINE lim_dia
628#endif
629
630   !!======================================================================
631END MODULE limdia
Note: See TracBrowser for help on using the repository browser.