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.
limwri.F90 in trunk/NEMO/LIM_SRC – NEMO

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

Last change on this file since 107 was 107, checked in by opalod, 20 years ago

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