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_2.F90 in trunk/NEMO/LIM_SRC_2 – NEMO

source: trunk/NEMO/LIM_SRC_2/limwri_2.F90 @ 1310

Last change on this file since 1310 was 1310, checked in by smasson, 15 years ago

set origin of outputs calendar, continue changeset:1309, see ticket:335

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 11.7 KB
Line 
1MODULE limwri_2
2   !!======================================================================
3   !!                     ***  MODULE  limwri_2  ***
4   !!         Ice diagnostics :  write ice output files
5   !!======================================================================
6   !! history :  2.0  ! 03-08  (C. Ethe) original code
7   !!            2.0  ! 04-10  (C. Ethe )  1D configuration
8   !!-------------------------------------------------------------------
9#if defined key_lim2
10   !!----------------------------------------------------------------------
11   !!   'key_lim2'                                    LIM 2.0 sea-ice model
12   !!----------------------------------------------------------------------
13   !!----------------------------------------------------------------------
14   !!   lim_wri_2      : write of the diagnostics variables in ouput file
15   !!   lim_wri_init_2 : initialization and namelist read
16   !!----------------------------------------------------------------------
17   USE phycst
18   USE dom_oce
19   USE daymod
20   USE ice_oce         ! ice variables
21   USE sbc_oce
22   USE sbc_ice
23   USE dom_ice_2
24   USE ice_2
25
26   USE lbclnk
27   USE dianam          ! build name of file (routine)
28   USE in_out_manager
29   USE ioipsl
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC   lim_wri_2      ! routine called by sbc_ice_lim_2
35
36   INTEGER, PARAMETER                       ::   jpnoumax = 40   ! maximum number of variable for ice output
37   INTEGER                                  ::   noumef          ! number of fields
38   REAL(wp)           , DIMENSION(jpnoumax) ::   cmulti ,     &  ! multiplicative constant
39      &                                          cadd            ! additive constant
40   CHARACTER(len = 35), DIMENSION(jpnoumax) ::   titn            ! title of the field
41   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   nam             ! name of the field
42   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   uni             ! unit of the field
43   INTEGER            , DIMENSION(jpnoumax) ::   nc              ! switch for saving field ( = 1 ) or not ( = 0 )
44
45   INTEGER ::   nice, nhorid, ndim, niter, ndepid       ! ????
46   INTEGER , DIMENSION( jpij ) ::   ndex51              ! ????
47
48   REAL(wp)  ::            &  ! constant values
49      epsi16 = 1.e-16   ,  &
50      zzero  = 0.e0     ,  &
51      zone   = 1.e0
52
53   !! * Substitutions
54#   include "vectopt_loop_substitute.h90"
55   !!----------------------------------------------------------------------
56   !!  LIM 2.0, UCL-LOCEAN-IPSL (2006)
57   !! $Id$
58   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
59   !!----------------------------------------------------------------------
60
61CONTAINS
62
63#if defined key_dimgout
64   !!----------------------------------------------------------------------
65   !!   'key_dimgout'                                    Direct Access file
66   !!----------------------------------------------------------------------
67# include "limwri_dimg_2.h90"
68#else
69   !!----------------------------------------------------------------------
70   !!   Default option                                          NetCDF file
71   !!----------------------------------------------------------------------
72
73   SUBROUTINE lim_wri_2( kt )
74      !!-------------------------------------------------------------------
75      !!                    ***   ROUTINE lim_wri_2  ***
76      !!               
77      !! ** Purpose :   write the sea-ice output file in NetCDF
78      !!
79      !! ** Method  :   computes the average of some variables and write
80      !!      it in the NetCDF ouput files
81      !!      CAUTION: the sea-ice time-step must be an integer fraction
82      !!      of a day
83      !!-------------------------------------------------------------------
84      INTEGER, INTENT(in) ::   kt     ! number of iteration
85      !!
86      INTEGER  ::   ji, jj, jf                      ! dummy loop indices
87      CHARACTER(len = 40)  ::   clhstnam, clop
88      REAL(wp) ::   zsto, zjulian, zout,   &  ! temporary scalars
89         &          zindh, zinda, zindb, ztmu
90      REAL(wp), DIMENSION(1)                ::   zdept
91      REAL(wp), DIMENSION(jpi,jpj)          ::   zfield
92      REAL(wp), DIMENSION(jpi,jpj,jpnoumax) ::   zcmo
93      !!-------------------------------------------------------------------
94
95      !                                          !--------------------!
96      IF( kt == nit000 ) THEN                    !   Initialisation   !
97         !                                       !--------------------!
98         CALL lim_wri_init_2 
99                           
100         zsto     = rdt_ice
101!!Chris         clop     = "ave(only(x))"      !ibug  namelist parameter a ajouter
102         clop     = "ave(x)"
103         zout     = nwrite * rdt_ice / nn_fsbc
104         niter    = 0
105         zdept(1) = 0.
106         
107         CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian )
108         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
109         CALL dia_nam ( clhstnam, nwrite, 'icemod' )
110         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit,    &
111            &           1, jpi, 1, jpj, 0, zjulian, rdt_ice, nhorid, nice , domain_id=nidom)
112         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid)
113         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
114         
115         DO jf = 1, noumef
116            IF( nc(jf) == 1 )   CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj   &
117               &                                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout )
118         END DO
119         CALL histend( nice )
120         !
121      ENDIF
122      !                                          !--------------------!
123      !                                          !   Cumulate at kt   !
124      !                                          !--------------------!
125
126      !-- Store instantaneous values in zcmo
127     
128      zcmo(:,:, 1:jpnoumax ) = 0.e0 
129      DO jj = 2 , jpjm1
130         DO ji = fs_2 , fs_jpim1
131            zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) )
132            zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
133            zindb  = zindh * zinda
134            ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
135            zcmo(ji,jj,1)  = hsnif (ji,jj)
136            zcmo(ji,jj,2)  = hicif (ji,jj)
137            zcmo(ji,jj,3)  = hicifp(ji,jj)
138            zcmo(ji,jj,4)  = frld  (ji,jj)
139            zcmo(ji,jj,5)  = sist  (ji,jj)
140            zcmo(ji,jj,6)  = fbif  (ji,jj)
141            zcmo(ji,jj,7)  = zindb * (  ui_ice(ji,jj  ) * tmu(ji,jj  ) + ui_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
142                                      + ui_ice(ji,jj+1) * tmu(ji,jj+1) + ui_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
143                                  / ztmu 
144
145            zcmo(ji,jj,8)  = zindb * (  vi_ice(ji,jj  ) * tmu(ji,jj  ) + vi_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
146                                      + vi_ice(ji,jj+1) * tmu(ji,jj+1) + vi_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
147                                  / ztmu
148            zcmo(ji,jj,9)  = sst_m(ji,jj)
149            zcmo(ji,jj,10) = sss_m(ji,jj)
150            zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
151            zcmo(ji,jj,12) = qsr(ji,jj)
152            zcmo(ji,jj,13) = qns(ji,jj)
153            ! See thersf for the coefficient
154            zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce    !!gm ???
155            zcmo(ji,jj,15) = utaui_ice(ji,jj)
156            zcmo(ji,jj,16) = vtaui_ice(ji,jj)
157            zcmo(ji,jj,17) = qsr_ice(ji,jj)
158            zcmo(ji,jj,18) = qns_ice(ji,jj)
159            zcmo(ji,jj,19) = sprecip(ji,jj)
160         END DO
161      END DO
162      !
163      ! Write the netcdf file
164      !
165      niter = niter + 1
166      DO jf = 1 , noumef
167         DO jj = 1 , jpj
168            DO ji = 1 , jpi
169               zfield(ji,jj) = zcmo(ji,jj,jf) * cmulti(jf) + cadd(jf)
170            END DO
171         END DO
172         
173         IF( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN
174            CALL lbc_lnk( zfield, 'T', -1. )
175         ELSE
176            CALL lbc_lnk( zfield, 'T',  1. )
177         ENDIF
178         
179         IF( nc(jf) == 1 )   CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 )
180         
181      END DO
182     
183      IF( ( nn_fsbc * niter + nit000 - 1 ) >= nitend )   CALL histclo( nice ) 
184      !
185   END SUBROUTINE lim_wri_2
186   
187#endif
188   
189   SUBROUTINE lim_wri_init_2
190      !!-------------------------------------------------------------------
191      !!                    ***   ROUTINE lim_wri_init_2  ***
192      !!               
193      !! ** Purpose :   intialisation of LIM sea-ice output
194      !!
195      !! ** Method  : Read the namicewri namelist and check the parameter
196      !!       values called at the first timestep (nit000)
197      !!
198      !! ** input   :   Namelist namicewri
199      !!-------------------------------------------------------------------
200      INTEGER ::   nf      ! ???
201      TYPE FIELD 
202         CHARACTER(len = 35) :: ztitle 
203         CHARACTER(len = 8 ) :: zname         
204         CHARACTER(len = 8 ) :: zunit
205         INTEGER             :: znc   
206         REAL                :: zcmulti 
207         REAL                :: zcadd       
208      END TYPE FIELD
209      TYPE(FIELD) ::  &
210         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
211         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
212         field_13, field_14, field_15, field_16, field_17, field_18,   &
213         field_19
214      TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield
215
216      NAMELIST/namiceout/ noumef, &
217         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
218         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
219         field_13, field_14, field_15, field_16, field_17, field_18,   &
220         field_19
221      !!-------------------------------------------------------------------
222
223      REWIND ( numnam_ice )                ! Read Namelist namicewri
224      READ   ( numnam_ice  , namiceout )
225     
226      zfield( 1) = field_1
227      zfield( 2) = field_2
228      zfield( 3) = field_3
229      zfield( 4) = field_4
230      zfield( 5) = field_5
231      zfield( 6) = field_6
232      zfield( 7) = field_7
233      zfield( 8) = field_8
234      zfield( 9) = field_9
235      zfield(10) = field_10
236      zfield(11) = field_11
237      zfield(12) = field_12
238      zfield(13) = field_13
239      zfield(14) = field_14
240      zfield(15) = field_15
241      zfield(16) = field_16
242      zfield(17) = field_17
243      zfield(18) = field_18
244      zfield(19) = field_19
245     
246      DO nf = 1, noumef
247         titn  (nf) = zfield(nf)%ztitle
248         nam   (nf) = zfield(nf)%zname
249         uni   (nf) = zfield(nf)%zunit
250         nc    (nf) = zfield(nf)%znc
251         cmulti(nf) = zfield(nf)%zcmulti
252         cadd  (nf) = zfield(nf)%zcadd
253      END DO
254
255      IF(lwp) THEN
256         WRITE(numout,*)
257         WRITE(numout,*) 'lim_wri_init_2 : Ice parameters for outputs'
258         WRITE(numout,*) '~~~~~~~~~~~~~~'
259         WRITE(numout,*) '    number of fields to be stored         noumef = ', noumef
260         WRITE(numout,*) '           title                            name     unit      Saving (1/0) ',   &
261            &            '    multiplicative constant       additive constant '
262         DO nf = 1 , noumef         
263            WRITE(numout,*) '   ', titn(nf), '   ', nam(nf),'      ', uni(nf),'  ', nc(nf),'        ', cmulti(nf),   &
264               &       '        ', cadd(nf)
265         END DO
266      ENDIF
267      !   
268   END SUBROUTINE lim_wri_init_2
269
270#else
271   !!----------------------------------------------------------------------
272   !!   Default option :         Empty module      NO LIM 2.0 sea-ice model
273   !!----------------------------------------------------------------------
274CONTAINS
275   SUBROUTINE lim_wri_2          ! Empty routine
276   END SUBROUTINE lim_wri_2
277#endif
278
279   !!======================================================================
280END MODULE limwri_2
Note: See TracBrowser for help on using the repository browser.