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

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

Initial revision

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