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

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

CT : UPDATE057 : # General syntax, alignement, comments corrections

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