source: trunk/NEMO/LIM_SRC/limwri.F90 @ 352

Last change on this file since 352 was 352, checked in by opalod, 15 years ago

nemo_v1_update_033 : CT : Switch to IOIPSL-3-0 new library

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 11.7 KB
Line 
1MODULE limwri
2   !!======================================================================
3   !!                     ***  MODULE  limwri  ***
4   !!         Ice diagnostics :  write ice output files
5   !!======================================================================
6   !!----------------------------------------------------------------------
7   !!  LIM 2.0, UCL-LOCEAN-IPSL (2005)
8   !! $Header$
9   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
10   !!----------------------------------------------------------------------
11#if defined key_ice_lim
12   !!----------------------------------------------------------------------
13   !!   'key_ice_lim'                                     LIM sea-ice model
14   !!----------------------------------------------------------------------
15   !!   lim_wri      : write of the diagnostics variables in ouput file
16   !!   lim_wri_init : initialization and namelist read
17   !!----------------------------------------------------------------------
18   !! * Modules used
19   USE ioipsl
20   USE dianam    ! build name of file (routine)
21   USE phycst
22   USE dom_oce
23   USE daymod
24   USE in_out_manager
25   USE ice_oce         ! ice variables
26   USE flx_oce
27   USE dom_ice
28   USE ice
29   USE iceini
30   USE lbclnk
31
32   IMPLICIT NONE
33   PRIVATE
34
35   !! * Accessibility
36   PUBLIC lim_wri        ! routine called by lim_step.F90
37
38   !! * Module variables
39   INTEGER, PARAMETER ::   &  !:
40      jpnoumax = 40             !: maximum number of variable for ice output
41   INTEGER  ::                                &
42      noumef                                     ! number of fields
43   REAL(wp)           , DIMENSION(jpnoumax) ::  &
44      cmulti ,                                &  ! multiplicative constant
45      cadd                                       ! additive constant
46   CHARACTER(len = 35), DIMENSION(jpnoumax) ::  &
47      titn                                       ! title of the field
48   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::  &
49      nam                                        ! name of the field
50   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::  &
51      uni                                        ! unit of the field
52   INTEGER            , DIMENSION(jpnoumax) ::  &
53      nc                                         ! switch for saving field ( = 1 ) or not ( = 0 )
54
55   REAL(wp)  ::            &  ! constant values
56      epsi16 = 1.e-16   ,  &
57      zzero  = 0.e0     ,  &
58      zone   = 1.e0
59   !!-------------------------------------------------------------------
60
61CONTAINS
62#if defined key_dimgout
63
64# include "limwri_dimg.h90"
65
66#else
67
68   SUBROUTINE lim_wri
69      !!-------------------------------------------------------------------
70      !!  This routine computes the average of some variables and write it
71      !!  on the ouput files.
72      !!  ATTENTION cette routine n'est valable que si le pas de temps est
73      !!  egale a une fraction entiere de 1 jours.
74      !!  Diff 1-D 3-D : suppress common also included in etat
75      !!                 suppress cmoymo 11-18
76      !!  modif : 03/06/98
77      !!-------------------------------------------------------------------
78      !! * Local variables
79      REAL(wp),DIMENSION(1) ::   zdept
80     
81      REAL(wp) :: &
82         zsto, zsec, zjulian,zout, &
83         zindh,zinda,zindb,  &
84         ztmu
85      REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: &
86         zcmo
87      REAL(wp), DIMENSION(jpi,jpj) ::  &
88         zfield
89      INTEGER ::  ji, jj, jf   ! dummy loop indices
90
91      CHARACTER(len = 40)  :: &
92         clhstnam, clop
93
94      INTEGER , SAVE ::      &
95         nice, nhorid, ndim, niter, ndepid
96      INTEGER , DIMENSION( jpij ) , SAVE ::  &
97         ndex51 
98      !!-------------------------------------------------------------------
99     
100      IF ( numit == nstart ) THEN
101
102         CALL lim_wri_init 
103         
104         !---5----|----5----|----5----|----5----|----5----|----5----|----5----|72
105         !  1) INITIALIZATIONS.                                                 |
106         !-----------------------------------------------------------------------
107         
108         !-- essai NetCDF
109         
110         zsto     = rdt_ice
111!!Chris         clop     = "ave(only(x))"      !ibug  namelist parameter a ajouter
112         clop     = "ave(x)"
113         zout     = nwrite * rdt_ice / nfice
114         zsec     = 0.
115         niter    = 0
116         zdept(1) = 0.
117         
118         CALL ymds2ju ( nyear, nmonth, nday, zsec, zjulian )
119         CALL dia_nam ( clhstnam, nwrite, 'icemod' )
120         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, 0, zjulian, rdt_ice, nhorid, nice , domain_id=nidom)
121         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid)
122         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
123         
124         DO jf = 1, noumef
125            IF ( nc(jf) == 1 ) THEN
126               CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj   &
127                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout )
128            ENDIF
129         END DO
130         CALL histend(nice)
131         
132      ENDIF
133     
134      !---5----|----5----|----5----|----5----|----5----|----5----|----5----|72
135      !--2. Computation of instantaneous values                                         |
136      !-----------------------------------------------------------------------
137
138      IF(lwp) THEN
139         WRITE(numout,*)
140         WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit
141         WRITE(numout,*) '~~~~~~~ '
142      ENDIF
143
144      !-- calculs des valeurs instantanees
145     
146      zcmo(:,:, 1:jpnoumax ) = 0.e0 
147      DO jj = 2 , jpjm1
148         DO ji = 2 , jpim1
149            zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) )
150            zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
151            zindb  = zindh * zinda
152            ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
153            zcmo(ji,jj,1)  = hsnif (ji,jj)
154            zcmo(ji,jj,2)  = hicif (ji,jj)
155            zcmo(ji,jj,3)  = hicifp(ji,jj)
156            zcmo(ji,jj,4)  = frld  (ji,jj)
157            zcmo(ji,jj,5)  = sist  (ji,jj)
158            zcmo(ji,jj,6)  = fbif  (ji,jj)
159            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
160                                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
161                                  / ztmu 
162
163            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
164                                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
165                                  / ztmu
166            zcmo(ji,jj,9)  = sst_io(ji,jj)
167            zcmo(ji,jj,10) = sss_io(ji,jj)
168
169            zcmo(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj)
170            zcmo(ji,jj,12) = fsolar (ji,jj)
171            zcmo(ji,jj,13) = fnsolar(ji,jj)
172            ! See thersf for the coefficient
173            zcmo(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce
174            zcmo(ji,jj,15) = gtaux(ji,jj)
175            zcmo(ji,jj,16) = gtauy(ji,jj)
176            zcmo(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce (ji,jj)
177            zcmo(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(ji,jj)
178            zcmo(ji,jj,19) = sprecip(ji,jj)
179         END DO
180      END DO
181               
182      !
183      ! ecriture d'un fichier netcdf
184      !
185      niter = niter + 1
186      DO jf = 1 , noumef
187         DO jj = 1 , jpj
188            DO ji = 1 , jpi
189               zfield(ji,jj) = zcmo(ji,jj,jf) * cmulti(jf) + cadd(jf)
190            END DO
191         END DO
192         
193         IF ( jf == 7  .OR. jf == 8  .OR. jf == 11 .OR. jf == 12 .OR. jf == 15 .OR.   &
194            jf == 23 .OR. jf == 24 .OR. jf == 16 ) THEN
195            CALL lbc_lnk( zfield, 'T', -1. )
196         ELSE
197            CALL lbc_lnk( zfield, 'T',  1. )
198         ENDIF
199         
200         IF ( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 )
201         
202      END DO
203     
204      IF ( ( nfice * niter + nit000 - 1 ) >= nitend ) THEN
205         CALL histclo( nice ) 
206      ENDIF
207     
208   END SUBROUTINE lim_wri
209#endif
210   
211   SUBROUTINE lim_wri_init
212      !!-------------------------------------------------------------------
213      !!                    ***   ROUTINE lim_wri_init  ***
214      !!               
215      !! ** Purpose :   ???
216      !!
217      !! ** Method  : Read the namicewri namelist and check the parameter
218      !!       values called at the first timestep (nit000)
219      !!
220      !! ** input   :   Namelist namicewri
221      !!
222      !! history :
223      !!  8.5  ! 03-08 (C. Ethe) original code
224      !!-------------------------------------------------------------------
225      !! * Local declarations
226      INTEGER ::   nf      ! ???
227
228      TYPE FIELD 
229         CHARACTER(len = 35) :: ztitle 
230         CHARACTER(len = 8 ) :: zname         
231         CHARACTER(len = 8 ) :: zunit
232         INTEGER             :: znc   
233         REAL                :: zcmulti 
234         REAL                :: zcadd       
235      END TYPE FIELD
236
237      TYPE(FIELD) ::  &
238         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
239         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
240         field_13, field_14, field_15, field_16, field_17, field_18,   &
241         field_19
242
243      TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield
244
245      NAMELIST/namiceout/ noumef, &
246         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
247         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
248         field_13, field_14, field_15, field_16, field_17, field_18,   &
249         field_19
250      !!-------------------------------------------------------------------
251
252
253      ! Read Namelist namicewri
254      REWIND ( numnam_ice )
255      READ   ( numnam_ice  , namiceout )
256      zfield(1)  = field_1
257      zfield(2)  = field_2
258      zfield(3)  = field_3
259      zfield(4)  = field_4
260      zfield(5)  = field_5
261      zfield(6)  = field_6
262      zfield(7)  = field_7
263      zfield(8)  = field_8
264      zfield(9)  = field_9
265      zfield(10) = field_10
266      zfield(11) = field_11
267      zfield(12) = field_12
268      zfield(13) = field_13
269      zfield(14) = field_14
270      zfield(15) = field_15
271      zfield(16) = field_16
272      zfield(17) = field_17
273      zfield(18) = field_18
274      zfield(19) = field_19
275     
276      DO nf = 1, noumef
277         titn  (nf) = zfield(nf)%ztitle
278         nam   (nf) = zfield(nf)%zname
279         uni   (nf) = zfield(nf)%zunit
280         nc    (nf) = zfield(nf)%znc
281         cmulti(nf) = zfield(nf)%zcmulti
282         cadd  (nf) = zfield(nf)%zcadd
283      END DO
284
285      IF(lwp) THEN
286         WRITE(numout,*)
287         WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs'
288         WRITE(numout,*) '~~~~~~~~~~~~'
289         WRITE(numout,*) '    number of fields to be stored         noumef = ', noumef
290         WRITE(numout,*) '           title                            name     unit      Saving (1/0) ',   &
291            &            '    multiplicative constant       additive constant '
292         DO nf = 1 , noumef         
293            WRITE(numout,*) '   ', titn(nf), '   ', nam(nf),'      ', uni(nf),'  ', nc(nf),'        ', cmulti(nf),   &
294               '        ', cadd(nf)
295         END DO
296      ENDIF
297           
298   END SUBROUTINE lim_wri_init
299
300#else
301   !!----------------------------------------------------------------------
302   !!   Default option :         Empty module          NO LIM sea-ice model
303   !!----------------------------------------------------------------------
304CONTAINS
305   SUBROUTINE lim_wri          ! Empty routine
306   END SUBROUTINE lim_wri
307#endif
308
309   !!======================================================================
310END MODULE limwri
Note: See TracBrowser for help on using the repository browser.